Simplified query logic

Author: mmhat

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

@@ -17,7 +17,8 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Distribution.Parsec (eitherParsec)
-import Distribution.Types.VersionRange (VersionRange, VersionRangeF(..), anyVersion, earlierVersion, intersectVersionRanges, majorUpperBound, orLaterVersion, projectVersionRange)
+import Distribution.Types.VersionInterval (asVersionIntervals)
+import Distribution.Types.VersionRange (VersionRange, anyVersion, earlierVersion, intersectVersionRanges, noVersion, orLaterVersion, unionVersionRanges)
 import Validation (Validation(..))
 
 import Security.Advisories.Definition
@@ -27,53 +28,24 @@ import Security.Advisories.Filesystem
 isAffectedBy :: Text -> VersionRange -> Advisory -> Bool
 isAffectedBy queryPackageName queryVersionRange =
     any checkAffected . advisoryAffected
-  where checkAffected :: Affected -> Bool
+    where
+        checkAffected :: Affected -> Bool
         checkAffected affected =
           queryPackageName == affectedPackage affected
-          && any
-              (intersectsWith (projectVersionRange queryVersionRange) . projectVersionRange . mkVersionRange)
-              (affectedVersions affected)
-        mkVersionRange :: AffectedVersionRange -> VersionRange
-        mkVersionRange x =
-          case affectedVersionRangeFixed x of
-            Nothing ->
-              orLaterVersion (affectedVersionRangeIntroduced x)
-            Just affectedVersionRangeFixed' ->
-              orLaterVersion (affectedVersionRangeIntroduced x) `intersectVersionRanges` earlierVersion affectedVersionRangeFixed'
-        intersectsWith :: VersionRangeF VersionRange -> VersionRangeF VersionRange -> Bool
-        intersectsWith left right =
-          case (left, right) of
-            (ThisVersionF x, ThisVersionF y) -> x == y
-            (ThisVersionF x, LaterVersionF y) -> x < y
-            (ThisVersionF x, OrLaterVersionF y) -> x >= y
-            (ThisVersionF x, EarlierVersionF y) -> x < y
-            (ThisVersionF x, OrEarlierVersionF y) -> x <= y
-            (LaterVersionF x, ThisVersionF y) -> x < y
-            (LaterVersionF _, LaterVersionF _) -> True
-            (LaterVersionF _, OrLaterVersionF _) -> True
-            (LaterVersionF x, EarlierVersionF y) -> x < y
-            (LaterVersionF x, OrEarlierVersionF y) -> x < y
-            (OrLaterVersionF x, ThisVersionF y) -> x <= y
-            (OrLaterVersionF _, LaterVersionF _) -> True
-            (OrLaterVersionF _, OrLaterVersionF _) -> True
-            (OrLaterVersionF x, EarlierVersionF y) -> x < y
-            (OrLaterVersionF x, OrEarlierVersionF y) -> x <= y
-            (EarlierVersionF x, ThisVersionF y) -> x > y
-            (EarlierVersionF x, LaterVersionF y) -> x > y
-            (EarlierVersionF x, OrLaterVersionF y) -> x > y
-            (EarlierVersionF _, EarlierVersionF _) -> True
-            (EarlierVersionF _, OrEarlierVersionF _) -> True
-            (OrEarlierVersionF x, ThisVersionF y) -> x >= y
-            (OrEarlierVersionF x, LaterVersionF y) -> x > y
-            (OrEarlierVersionF x, OrLaterVersionF y) -> x >= y
-            (OrEarlierVersionF _, EarlierVersionF _) -> True
-            (OrEarlierVersionF _, OrEarlierVersionF _) -> True
-            (MajorBoundVersionF x, _) -> intersectsWith (OrLaterVersionF x) right && intersectsWith (EarlierVersionF $ majorUpperBound x) right
-            (UnionVersionRangesF x y, _) -> intersectsWith (projectVersionRange x) right || intersectsWith (projectVersionRange y) right
-            (IntersectVersionRangesF x y, _) -> intersectsWith (projectVersionRange x) right && intersectsWith (projectVersionRange y) right
-            (_, UnionVersionRangesF x y) -> intersectsWith left (projectVersionRange x) || intersectsWith left (projectVersionRange y)
-            (_, IntersectVersionRangesF x y) -> intersectsWith left (projectVersionRange x) && intersectsWith left (projectVersionRange y)
-            (_, MajorBoundVersionF x) -> intersectsWith left (OrLaterVersionF x) && intersectsWith left (EarlierVersionF $ majorUpperBound x)
+            && isSomeVersion (fromAffected affected `intersectVersionRanges` queryVersionRange)
+
+        fromAffected :: Affected -> VersionRange
+        fromAffected = foldr (unionVersionRanges . fromAffectedVersionRange) noVersion . affectedVersions
+
+        fromAffectedVersionRange :: AffectedVersionRange -> VersionRange
+        fromAffectedVersionRange avr = intersectVersionRanges
+          (orLaterVersion (affectedVersionRangeIntroduced avr))
+          (maybe anyVersion earlierVersion (affectedVersionRangeFixed avr))
+
+        isSomeVersion :: VersionRange -> Bool
+        isSomeVersion range
+            | [] <- asVersionIntervals range = False
+            | otherwise = True
 
 -- | Parse 'VersionRange' as given to the CLI
 parseVersionRange :: Maybe Text -> Either Text VersionRange
@@ -91,6 +63,4 @@ listAffectedBy root queryPackageName queryVersionRange = do
         exitFailure
       Success advisories ->
         return advisories
-
-
   return $ filter (isAffectedBy queryPackageName queryVersionRange) advisories