From b0100ac902af2e4164f40c361ee29b7fd29bec1e Mon Sep 17 00:00:00 2001
From: Mann mit Hut <github+mmhat@with-h.at>
Date: Sat, 30 Sep 2023 14:57:59 +0200
Subject: [PATCH] Moved validation code to executable

---
 code/hsec-tools/app/Main.hs                   | 16 ++++++++----
 code/hsec-tools/hsec-tools.cabal              |  1 +
 .../src/Security/Advisories/Queries.hs        | 26 +++++--------------
 3 files changed, 19 insertions(+), 24 deletions(-)

diff --git a/code/hsec-tools/app/Main.hs b/code/hsec-tools/app/Main.hs
index 39ac78af..1582a273 100644
--- a/code/hsec-tools/app/Main.hs
+++ b/code/hsec-tools/app/Main.hs
@@ -12,8 +12,9 @@ import Data.List (intercalate, isPrefixOf)
 import Distribution.Parsec (eitherParsec)
 import Distribution.Types.VersionRange (VersionRange, anyVersion)
 import System.Exit (die, exitFailure, exitSuccess)
-import System.IO (hPutStrLn, stderr)
+import System.IO (hPrint, hPutStrLn, stderr)
 import System.FilePath (takeBaseName)
+import Validation (Validation(..))
 
 import qualified Data.Aeson
 import qualified Data.Text as T
@@ -117,10 +118,15 @@ commandQuery =
       where go :: T.Text -> Maybe VersionRange -> Maybe FilePath -> IO ()
             go packageName versionRange advisoriesPath = do
               let versionRange' = fromMaybe anyVersion versionRange
-              affectedAdvisories <- listVersionRangeAffectedBy (fromMaybe "." advisoriesPath) packageName versionRange'
-              case affectedAdvisories of
-                [] -> putStrLn "Not affected"
-                _ -> do
+              maybeAffectedAdvisories <- listVersionRangeAffectedBy (fromMaybe "." advisoriesPath) packageName versionRange'
+              case maybeAffectedAdvisories of
+                Validation.Failure errors -> do
+                  T.hPutStrLn stderr "Cannot parse some advisories"
+                  forM_ errors $
+                    hPrint stderr
+                  exitFailure
+                Validation.Success [] -> putStrLn "Not affected"
+                Validation.Success affectedAdvisories -> do
                   hPutStrLn stderr "Affected by:"
                   forM_ affectedAdvisories $ \advisory ->
                     T.hPutStrLn stderr $ "* [" <> T.pack (printHsecId $ advisoryId advisory) <> "] " <> advisorySummary advisory
diff --git a/code/hsec-tools/hsec-tools.cabal b/code/hsec-tools/hsec-tools.cabal
index 26c577a9..bee59c0d 100644
--- a/code/hsec-tools/hsec-tools.cabal
+++ b/code/hsec-tools/hsec-tools.cabal
@@ -88,6 +88,7 @@ executable hsec-tools
     , hsec-tools
     , optparse-applicative  >=0.17    && <0.19
     , text                  >=1.2     && <3
+    , validation-selective  >=0.1     && <1
 
   hs-source-dirs:   app
   default-language: Haskell2010
diff --git a/code/hsec-tools/src/Security/Advisories/Queries.hs b/code/hsec-tools/src/Security/Advisories/Queries.hs
index fd5768e0..c4d0104c 100644
--- a/code/hsec-tools/src/Security/Advisories/Queries.hs
+++ b/code/hsec-tools/src/Security/Advisories/Queries.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-
 module Security.Advisories.Queries
   ( listVersionAffectedBy
   , listVersionRangeAffectedBy
@@ -9,12 +6,8 @@ module Security.Advisories.Queries
   )
 where
 
-import Control.Monad (forM_)
-import System.Exit (exitFailure)
-import System.IO (stderr, hPrint)
-
+import Control.Monad.IO.Class (MonadIO)
 import Data.Text (Text)
-import qualified Data.Text.IO as T
 import Distribution.Types.Version (Version)
 import Distribution.Types.VersionInterval (asVersionIntervals)
 import Distribution.Types.VersionRange (VersionRange, anyVersion, earlierVersion, intersectVersionRanges, noVersion, orLaterVersion, unionVersionRanges, withinRange)
@@ -22,6 +15,7 @@ import Validation (Validation(..))
 
 import Security.Advisories.Definition
 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
@@ -57,21 +51,15 @@ isAffectedByHelper checkWithRange queryPackageName queryVersionish =
         (maybe anyVersion earlierVersion (affectedVersionRangeFixed avr))
 
 -- | List the advisories matching a package name and a version
-listVersionAffectedBy :: FilePath -> Text -> Version -> IO [Advisory]
+listVersionAffectedBy :: MonadIO m => FilePath -> Text -> Version -> m (Validation [ParseAdvisoryError] [Advisory])
 listVersionAffectedBy = listAffectedByHelper isVersionAffectedBy
 
 -- | List the advisories matching a package name and a version range
-listVersionRangeAffectedBy :: FilePath -> Text -> VersionRange -> IO [Advisory]
+listVersionRangeAffectedBy :: MonadIO m => FilePath -> Text -> VersionRange -> m (Validation [ParseAdvisoryError] [Advisory])
 listVersionRangeAffectedBy = listAffectedByHelper isVersionRangeAffectedBy
 
 -- | Helper function for 'listVersionAffectedBy' and 'listVersionRangeAffectedBy'
-listAffectedByHelper :: (Text -> a -> Advisory -> Bool) -> FilePath -> Text -> a -> IO [Advisory]
+listAffectedByHelper :: MonadIO m => (Text -> a -> Advisory -> Bool) -> FilePath -> Text -> a -> m (Validation [ParseAdvisoryError] [Advisory])
 listAffectedByHelper checkAffectedBy root queryPackageName queryVersionish =
-  listAdvisories root >>= \case
-    Failure errors -> do
-      T.hPutStrLn stderr "Cannot parse some advisories"
-      forM_ errors $
-        hPrint stderr
-      exitFailure
-    Success advisories ->
-      return $ filter (checkAffectedBy queryPackageName queryVersionish) advisories
+  fmap (filter (checkAffectedBy queryPackageName queryVersionish)) <$>
+    listAdvisories root