hsec-core 0.2.0.2 → 0.3.0.0

raw patch · 5 files changed

+281/−7 lines, 5 filesdep +network-uridep ~Cabal-syntaxPVP ok

version bump matches the API change (PVP)

Dependencies added: network-uri

Dependency ranges changed: Cabal-syntax

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• hsec-core.cabal +7/−3
• src/Security/Advisories/Core/Advisory.hs +71/−3
• test/Spec.hs +2/−1
• test/Spec/QueriesSpec.hs +193/−0

@@ -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

@@ -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

@@ -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))+

@@ -1,10 +1,11 @@ module Main where  import Test.Tasty+import qualified Spec.QueriesSpec as QueriesSpec  main :: IO () main =   defaultMain $     testGroup       "Tests"-      []+      [QueriesSpec.spec]

@@ -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)