QueriesSpec.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Spec.QueriesSpec (spec) where

import Data.Bifunctor (first)
import Data.Either (fromRight)
import Data.Maybe (fromMaybe)
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Distribution.Parsec (eitherParsec)
import Distribution.Types.Version (alterVersion, version0)
import Distribution.Types.VersionRange (VersionRange, VersionRangeF (..), anyVersion, projectVersionRange)
import Security.Advisories.Core.Advisory
import Security.Advisories.Core.HsecId
import Security.Advisories.Core.OsvId (parseOsvId)
import Security.CVSS (parseCVSS)
import Test.Tasty
import Test.Tasty.HUnit

spec :: TestTree
spec =
  testGroup
    "Queries"
    [ testGroup "isAffectedBy" $
        flip concatMap cases $
          map $ \(actual, query, expected) ->
            let title x y =
                  if expected
                    then show x <> " is vulnerable to " <> show y
                    else show x <> " is not vulnerable to " <> show y
                versionRange x =
                  either (\e -> error $ "Cannot parse version range " <> show x <> " : " <> show e) id $
                    parseVersionRange $
                      if x == ""
                        then Nothing
                        else Just x
             in testCase (title actual query) $
                  let query' = versionRange query
                      affectedVersion' = versionRange actual
                   in isVersionRangeAffectedBy component query' (mkAdvisory affectedVersion')
                        @?= expected
    ]

cases :: [[(Text, Text, Bool)]]
cases =
  [ reversible ("", "", True),
    reversible ("", "==1", True),
    reversible ("==1.1", "<=2", True),
    reversible ("==1.1", ">1", True),
    reversible ("==1", "==1", True),
    reversible ("==2||==1", "==1", True),
    reversible ("==1.1", "<=2&&>1", True),
    reversible ("^>=1", ">1&&<1.2", True),
    reversible (">=1", "==2", True),
    reversible (">=1", "==1", True),
    reversible ("==2", ">=2", True),
    reversible ("==2", ">1", True),
    reversible (">5", ">=2", True),
    reversible (">5", ">2", True),
    reversible ("==5", ">=2", True),
    reversible ("==5", ">2", True),
    reversible (">=5", ">2", True),
    reversible ("<=5", ">2", True),
    reversible ("<=5", "<=2", True),
    reversible ("<5", ">=2", True),
    reversible (">=2", "==5", True),
    reversible (">2", "==5", True),
    reversible (">5", ">=5", True),
    reversible ("^>=1.1", ">1", True),
    reversible ("^>=1.1", "<2", True),
    reversible ("^>=1.1", "<=1.2", True),
    reversible ("^>=1.1", ">1.1", True),
    reversible ("^>=1.1", ">=1.1.5", True),
    reversible ("^>=1.1", ">=1", True),
    reversible ("==1.1", "<1", False),
    reversible ("==2.1", "<=2", False),
    reversible ("==1", ">1.1", False),
    reversible ("==2", "==1", False),
    reversible ("==2||==1", ">3", False),
    notReversible ("<=2&&>1", "==3", True),
    reversible (">=2", "==1.1", False),
    reversible (">=1.1", "==1", False),
    reversible ("==2", ">=2.1", False),
    notReversible (">1", "==1", False),
    reversible ("<2", ">=2", False),
    reversible ("==2", ">=5", False),
    reversible ("==2", ">5", False),
    reversible ("<=2", ">5", False),
    reversible ("<=2", ">5", False),
    reversible ("<2", ">=5", False),
    reversible (">=2", "==1.1", False),
    reversible ("<2", "==5", False),
    reversible ("<5", ">=5", False),
    reversible ("^>=1.1", "<1", False),
    reversible ("^>=1.1", "<1.1", False),
    reversible ("^>=1.1", ">=1.2", False),
    reversible ("^>=1.1", "<=1", False),
    reversible ("^>=1.1", ">2", False),
    reversible ("^>=1", ">=2", False)
  ]
  where
    reversible (query, affectedVersion, expected) = [(query, affectedVersion, expected), (query, affectedVersion, expected)]
    notReversible (query, affectedVersion, expected) = [(query, affectedVersion, expected), (affectedVersion, query, not expected)]

mkAdvisory :: VersionRange -> Advisory
mkAdvisory versionRange =
  Advisory
    { advisoryId = fromMaybe (error "Cannot mkHsecId") $ mkHsecId 2023 42,
      advisoryModified = read "2023-01-01T00:00:00",
      advisoryPublished = read "2023-01-01T00:00:00",
      advisoryCAPECs = [],
      advisoryCWEs = [],
      advisoryKeywords = [],
      advisoryAliases = Maybe.fromJust . traverse parseOsvId $ ["CVE-2022-1234"],
      advisoryRelated = Maybe.fromJust . traverse parseOsvId $ ["CVE-2022-5678", "CVE-2022-9012"],
      advisoryAffected =
        [ Affected
            { affectedComponentIdentifier = component,
              affectedCVSS = cvss,
              affectedVersions = mkAffectedVersions versionRange,
              affectedArchitectures = Nothing,
              affectedOS = Nothing,
              affectedDeclarations = []
            }
        ],
      advisoryReferences = [],
      advisoryPandoc = mempty,
      advisoryHtml = "",
      advisorySummary = "",
      advisoryDetails = ""
    }
  where
    cvss = fromRight (error "Cannot parseCVSS") (parseCVSS "CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:H/I:H/A:H")

mkAffectedVersions :: VersionRange -> [AffectedVersionRange]
mkAffectedVersions vr =
  let fixed from to =
        AffectedVersionRange
          { affectedVersionRangeIntroduced = from,
            affectedVersionRangeFixed = Just to
          }
      onlyFixed to =
        AffectedVersionRange
          { affectedVersionRangeIntroduced = version0,
            affectedVersionRangeFixed = Just to
          }
      vulnerable from =
        AffectedVersionRange
          { affectedVersionRangeIntroduced = from,
            affectedVersionRangeFixed = Nothing
          }
      nextMinor =
        \case
          [] -> [1]
          [x] -> [x, 1]
          [x, y] -> [x, y, 1]
          [x, y, z] -> [x, y, z, 1]
          [w, x, y, z] -> [w, x, y, z + 1]
          xs -> xs ++ [1]
      previousMinor =
        \case
          [] -> [0]
          [x] -> [x - 1, 99]
          [x, y] -> [x, y - 1, 99]
          [x, y, z] -> [x, y, z - 1, 99]
          [w, x, y, z] -> [w, x, y, z - 1]
          _ -> error "TODO"
      mkMajorBoundVersion =
        \case
          [] -> [0]
          [x] -> [x, 1]
          (x : y : _) -> [x, y + 1]
   in case projectVersionRange vr of
        ThisVersionF x -> [fixed x $ alterVersion (<> [0, 0, 1]) x]
        LaterVersionF x -> [vulnerable $ alterVersion nextMinor x]
        OrLaterVersionF x -> [vulnerable x]
        EarlierVersionF x -> [onlyFixed $ alterVersion previousMinor x]
        OrEarlierVersionF x -> [onlyFixed x]
        MajorBoundVersionF x -> [fixed x $ alterVersion mkMajorBoundVersion x]
        UnionVersionRangesF x y -> mkAffectedVersions x <> mkAffectedVersions y
        IntersectVersionRangesF x y ->
          [ low {affectedVersionRangeFixed = affectedVersionRangeFixed high}
            | low <- mkAffectedVersions x,
              high <- mkAffectedVersions y
          ]

component :: ComponentIdentifier
component = hackage $ mkPackageName "package-name"

-- | Parse 'VersionRange' as given to the CLI
parseVersionRange :: Maybe Text -> Either Text VersionRange
parseVersionRange = maybe (return anyVersion) (first T.pack . eitherParsec . T.unpack)