refactoring: move isVersionAffectedBy and isVersionRangeAffectedBy to Security.Advisories.Core (hsec-core) (#253)

Author: blackheaven

code/hsec-core/hsec-core.cabal

@@ -48,8 +48,11 @@ test-suite spec
   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

code/hsec-core/src/Security/Advisories/Core/Advisory.hs

@@ -14,13 +14,17 @@ module Security.Advisories.Core.Advisory
   , GHCComponent(..)
   , ghcComponentToText
   , ghcComponentFromText
+    -- * Queries
+  , isVersionAffectedBy
+  , isVersionRangeAffectedBy
   )
   where
 
 import Data.Text (Text)
 import Data.Time (UTCTime)
 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 Text.Pandoc.Definition (Pandoc)
 
@@ -147,3 +151,42 @@ data AffectedVersionRange = AffectedVersionRange
     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))
+

code/hsec-core/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]

code/hsec-tools/test/Spec/QueriesSpec.hs renamed to code/hsec-core/test/Spec/QueriesSpec.hs

@@ -17,7 +17,6 @@ import Test.Tasty.HUnit
 import Security.CVSS (parseCVSS)
 import Security.Advisories.Core.Advisory
 import Security.Advisories.Core.HsecId
-import Security.Advisories.Queries
 
 spec :: TestTree
 spec =
@@ -37,7 +36,7 @@ spec =
          in testCase (title actual query) $
               let query' = versionRange query
                   affectedVersion' = versionRange actual
-              in isVersionRangeAffectedBy packageName query' (mkAdvisory affectedVersion')
+              in isVersionRangeAffectedBy component query' (mkAdvisory affectedVersion')
                     @?= expected
   ]
 
@@ -115,7 +114,7 @@ mkAdvisory versionRange =
      , advisoryRelated = [ "CVE-2022-YYYY" , "CVE-2022-ZZZZ" ]
      , advisoryAffected =
          [ Affected
-             { affectedComponentIdentifier = Hackage packageName
+             { affectedComponentIdentifier = component
              , affectedCVSS = cvss
              , affectedVersions = mkAffectedVersions versionRange
              , affectedArchitectures = Nothing
@@ -186,8 +185,8 @@ mkAffectedVersions vr =
       , high <- mkAffectedVersions y
       ]
 
-packageName :: Text
-packageName = "package-name"
+component :: ComponentIdentifier
+component = Hackage "package-name"
 
 -- | Parse 'VersionRange' as given to the CLI
 parseVersionRange :: Maybe Text -> Either Text VersionRange

code/hsec-tools/hsec-tools.cabal

@@ -133,7 +133,6 @@ test-suite spec
   other-modules:
     Paths_hsec_tools
     Spec.FormatSpec
-    Spec.QueriesSpec
   build-depends:
     , aeson-pretty   <2
     , base

code/hsec-tools/src/Security/Advisories/Queries.hs

@@ -1,56 +1,19 @@
 module Security.Advisories.Queries
   ( listVersionAffectedBy
   , listVersionRangeAffectedBy
-  , isVersionAffectedBy
-  , isVersionRangeAffectedBy
   )
 where
 
 import Control.Monad.IO.Class (MonadIO)
 import Data.Text (Text)
 import Distribution.Types.Version (Version)
-import Distribution.Types.VersionInterval (asVersionIntervals)
-import Distribution.Types.VersionRange (VersionRange, anyVersion, earlierVersion, intersectVersionRanges, noVersion, orLaterVersion, unionVersionRanges, withinRange)
+import Distribution.Types.VersionRange (VersionRange)
 import Validation (Validation(..))
 
 import Security.Advisories.Core.Advisory
 import Security.Advisories.Filesystem
 import Security.Advisories.Parse
 
--- | Check whether a package and a version is concerned by an advisory
-isVersionAffectedBy :: Text -> Version -> Advisory -> Bool
-isVersionAffectedBy = isAffectedByHelper withinRange
-
--- | Check whether a package and a version range is concerned by an advisory
-isVersionRangeAffectedBy :: Text -> 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) -> Text -> a -> Advisory -> Bool
-isAffectedByHelper checkWithRange queryPackageName queryVersionish =
-    any checkAffected . advisoryAffected
-    where
-      checkAffected :: Affected -> Bool
-      checkAffected affected = case affectedComponentIdentifier affected of
-        Hackage pkg -> queryPackageName == pkg && checkWithRange queryVersionish (fromAffected affected)
-        -- TODO: support GHC ecosystem query, e.g. by adding a cli flag
-        _ -> False
-
-      fromAffected :: Affected -> VersionRange
-      fromAffected = foldr (unionVersionRanges . fromAffectedVersionRange) noVersion . affectedVersions
-
-      fromAffectedVersionRange :: AffectedVersionRange -> VersionRange
-      fromAffectedVersionRange avr = intersectVersionRanges
-        (orLaterVersion (affectedVersionRangeIntroduced avr))
-        (maybe anyVersion earlierVersion (affectedVersionRangeFixed avr))
-
 type QueryResult = Validation [(FilePath, ParseAdvisoryError)] [Advisory]
 
 -- | List the advisories matching a package name and a version
@@ -68,7 +31,7 @@ listVersionRangeAffectedBy = listAffectedByHelper isVersionRangeAffectedBy
 -- | Helper function for 'listVersionAffectedBy' and 'listVersionRangeAffectedBy'
 listAffectedByHelper
   :: (MonadIO m)
-  => (Text -> a -> Advisory -> Bool) -> FilePath -> Text -> a -> m QueryResult
+  => (ComponentIdentifier -> a -> Advisory -> Bool) -> FilePath -> Text -> a -> m QueryResult
 listAffectedByHelper checkAffectedBy root queryPackageName queryVersionish =
-  fmap (filter (checkAffectedBy queryPackageName queryVersionish)) <$>
+  fmap (filter (checkAffectedBy (Hackage queryPackageName) queryVersionish)) <$>
     listAdvisories root

code/hsec-tools/test/Spec.hs

@@ -13,7 +13,6 @@ import Paths_hsec_tools (getDataFileName)
 import qualified Security.Advisories.Convert.OSV as OSV
 import Security.Advisories.Parse
 import qualified Spec.FormatSpec as FormatSpec
-import qualified Spec.QueriesSpec as QueriesSpec
 import System.Directory (listDirectory)
 import Test.Tasty (defaultMain, testGroup, TestTree)
 import Test.Tasty.Golden (goldenVsString)
@@ -26,7 +25,6 @@ main = do
         testGroup
             "Tests"
             [ goldenTestsSpec goldenFiles
-            , QueriesSpec.spec
             , FormatSpec.spec
             ]