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