diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## 0.3.0.0 + +* Add `Repository` and `ComponentIdentifier` in `Security.Advisories.Core.Advisory` + +## 0.2.1.0 + +* Introduce `isVersionAffectedBy` and `isVersionRangeAffectedBy` in `Security.Advisories.Core` + ## 0.2.0.2 * Update `osv` dependency bounds diff --git a/hsec-core.cabal b/hsec-core.cabal --- a/hsec-core.cabal +++ b/hsec-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hsec-core -version: 0.2.0.2 +version: 0.3.0.0 -- A short (one-line) description of the package. synopsis: Core package representing Haskell advisories @@ -32,8 +32,9 @@ build-depends: , base >=4.14 && <5 , Cabal-syntax >=3.8.1.0 && <3.15 - , cvss >= 0.2 && < 0.3 - , osv >= 0.1 && < 0.3 + , cvss >=0.2 && <0.3 + , network-uri >=2.6.3.0 && <2.8 + , osv >=0.1 && <0.3 , pandoc-types >=1.22 && <2 , safe >=0.3 && <0.4 , text >=1.2 && <3 @@ -48,8 +49,11 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs + other-modules: + Spec.QueriesSpec build-depends: , base + , Cabal-syntax , cvss , hsec-core , tasty <2 diff --git a/src/Security/Advisories/Core/Advisory.hs b/src/Security/Advisories/Core/Advisory.hs --- a/src/Security/Advisories/Core/Advisory.hs +++ b/src/Security/Advisories/Core/Advisory.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DerivingVia, OverloadedStrings #-} +{-# LANGUAGE DerivingVia, OverloadedStrings, QuasiQuotes #-} module Security.Advisories.Core.Advisory ( Advisory(..) @@ -12,15 +12,28 @@ , Keyword(..) , ComponentIdentifier(..) , GHCComponent(..) + , RepositoryURL(..) + , RepositoryName(..) + , PackageName + , mkPackageName + , unPackageName , ghcComponentToText , ghcComponentFromText + , hackage + -- * Queries + , isVersionAffectedBy + , isVersionRangeAffectedBy ) where import Data.Text (Text) import Data.Time (UTCTime) +import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) import Distribution.Types.Version (Version) -import Distribution.Types.VersionRange (VersionRange) +import Distribution.Types.VersionInterval (asVersionIntervals) +import Distribution.Types.VersionRange (VersionRange, anyVersion, earlierVersion, intersectVersionRanges, noVersion, orLaterVersion, unionVersionRanges, withinRange) +import Network.URI (URI) +import Network.URI.Static (uri) import Text.Pandoc.Definition (Pandoc) @@ -48,9 +61,25 @@ } deriving stock (Show) -data ComponentIdentifier = Hackage Text | GHC GHCComponent +data ComponentIdentifier + = Repository RepositoryURL RepositoryName PackageName + | GHC GHCComponent deriving stock (Show, Eq) +hackage :: PackageName -> ComponentIdentifier +hackage = + Repository + (RepositoryURL [uri|https://hackage.haskell.org|]) + (RepositoryName "hackage") + +newtype RepositoryURL + = RepositoryURL { unRepositoryURL :: URI } + deriving stock (Eq, Ord, Show) + +newtype RepositoryName + = RepositoryName { unRepositoryName :: Text } + deriving stock (Eq, Ord, Show) + -- Keep this list in sync with the 'ghcComponentFromText' below data GHCComponent = GHCCompiler | GHCi | GHCRTS | GHCPkg | RunGHC | IServ | HP2PS | HPC | HSC2HS | Haddock deriving stock (Show, Eq, Enum, Bounded) @@ -147,3 +176,42 @@ affectedVersionRangeFixed :: Maybe Version } deriving stock (Eq, Show) + +-- * Queries + +-- | Check whether a component and a version is concerned by an advisory +-- +-- Since @0.2.1.0@ +isVersionAffectedBy :: ComponentIdentifier -> Version -> Advisory -> Bool +isVersionAffectedBy = isAffectedByHelper withinRange + +-- | Check whether a component and a version range is concerned by an advisory +-- +-- Since @0.2.1.0@ +isVersionRangeAffectedBy :: ComponentIdentifier -> VersionRange -> Advisory -> Bool +isVersionRangeAffectedBy = isAffectedByHelper $ + \queryVersionRange affectedVersionRange -> + isSomeVersion (affectedVersionRange `intersectVersionRanges` queryVersionRange) + where + isSomeVersion :: VersionRange -> Bool + isSomeVersion range + | [] <- asVersionIntervals range = False + | otherwise = True + +-- | Helper function for 'isVersionAffectedBy' and 'isVersionRangeAffectedBy' +isAffectedByHelper :: (a -> VersionRange -> Bool) -> ComponentIdentifier -> a -> Advisory -> Bool +isAffectedByHelper checkWithRange queryComponent queryVersionish = + any checkAffected . advisoryAffected + where + checkAffected :: Affected -> Bool + checkAffected affected = + affectedComponentIdentifier affected == queryComponent && checkWithRange queryVersionish (fromAffected affected) + + fromAffected :: Affected -> VersionRange + fromAffected = foldr (unionVersionRanges . fromAffectedVersionRange) noVersion . affectedVersions + + fromAffectedVersionRange :: AffectedVersionRange -> VersionRange + fromAffectedVersionRange avr = intersectVersionRanges + (orLaterVersion (affectedVersionRangeIntroduced avr)) + (maybe anyVersion earlierVersion (affectedVersionRangeFixed avr)) + diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,10 +1,11 @@ module Main where import Test.Tasty +import qualified Spec.QueriesSpec as QueriesSpec main :: IO () main = defaultMain $ testGroup "Tests" - [] + [QueriesSpec.spec] diff --git a/test/Spec/QueriesSpec.hs b/test/Spec/QueriesSpec.hs new file mode 100644 --- /dev/null +++ b/test/Spec/QueriesSpec.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Spec.QueriesSpec (spec) where + +import Data.Bifunctor (first) +import Data.Either (fromRight) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Distribution.Parsec (eitherParsec) +import Distribution.Types.Version (version0, alterVersion) +import Distribution.Types.VersionRange (VersionRange, VersionRangeF(..), anyVersion, projectVersionRange) +import Test.Tasty +import Test.Tasty.HUnit + +import Security.CVSS (parseCVSS) +import Security.Advisories.Core.Advisory +import Security.Advisories.Core.HsecId + +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 = [ "CVE-2022-XXXX" ] + , advisoryRelated = [ "CVE-2022-YYYY" , "CVE-2022-ZZZZ" ] + , 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)