diff --git a/code/hsec-tools/app/Main.hs b/code/hsec-tools/app/Main.hs index b240b9ab..39ac78af 100644 --- a/code/hsec-tools/app/Main.hs +++ b/code/hsec-tools/app/Main.hs @@ -9,6 +9,8 @@ import Data.Maybe (fromMaybe) import Data.Foldable (for_) import Data.Functor ((<&>)) 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.FilePath (takeBaseName) @@ -21,7 +23,7 @@ import Options.Applicative import Security.Advisories import qualified Security.Advisories.Convert.OSV as OSV import Security.Advisories.Git -import Security.Advisories.Queries (listVersionRangeAffectedBy, parseVersionRange) +import Security.Advisories.Queries (listVersionRangeAffectedBy) import Security.Advisories.Generate.HTML import qualified Command.Reserve @@ -109,24 +111,20 @@ commandQuery = isAffected = go <$> argument str (metavar "PACKAGE") - <*> optional (option str (metavar "VERSION-SPEC" <> short 'v' <> long "version-spec")) + <*> optional (option versionRangeReader (metavar "VERSION-RANGE" <> short 'v' <> long "version-range")) <*> optional (option str (metavar "ADVISORIES-PATH" <> short 'p' <> long "advisories-path")) <**> helper - where go :: T.Text -> Maybe T.Text -> Maybe FilePath -> IO () - go packageName versionRange advisoriesPath = - case parseVersionRange versionRange of - Left e -> do - T.hPutStrLn stderr $ "Cannot parse '--version-spec': " <> e + 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 + hPutStrLn stderr "Affected by:" + forM_ affectedAdvisories $ \advisory -> + T.hPutStrLn stderr $ "* [" <> T.pack (printHsecId $ advisoryId advisory) <> "] " <> advisorySummary advisory exitFailure - Right versionRange' -> do - affectedAdvisories <- listVersionRangeAffectedBy (fromMaybe "." advisoriesPath) packageName versionRange' - case affectedAdvisories of - [] -> putStrLn "Not affected" - _ -> do - hPutStrLn stderr "Affected by:" - forM_ affectedAdvisories $ \advisory -> - T.hPutStrLn stderr $ "* [" <> T.pack (printHsecId $ advisoryId advisory) <> "] " <> advisorySummary advisory - exitFailure commandGenerateIndex :: Parser (IO ()) commandGenerateIndex = @@ -147,6 +145,9 @@ commandHelp = <$> optional (argument str (metavar "COMMAND")) <**> helper +versionRangeReader :: ReadM VersionRange +versionRangeReader = eitherReader eitherParsec + withAdvisory :: (Maybe FilePath -> Advisory -> IO ()) -> Maybe FilePath -> IO () withAdvisory go file = do input <- maybe T.getContents T.readFile file diff --git a/code/hsec-tools/hsec-tools.cabal b/code/hsec-tools/hsec-tools.cabal index 41d3e3b2..48dd2760 100644 --- a/code/hsec-tools/hsec-tools.cabal +++ b/code/hsec-tools/hsec-tools.cabal @@ -83,6 +83,7 @@ executable hsec-tools , aeson >=2.0.1.0 && <3 , base >=4.14 && <4.19 , bytestring >=0.10 && <0.12 + , Cabal-syntax >=3.8.1.0 && <3.11 , filepath >=1.4 && <1.5 , hsec-tools , optparse-applicative >=0.17 && <0.19 diff --git a/code/hsec-tools/src/Security/Advisories/Queries.hs b/code/hsec-tools/src/Security/Advisories/Queries.hs index 7f6f42b5..fd5768e0 100644 --- a/code/hsec-tools/src/Security/Advisories/Queries.hs +++ b/code/hsec-tools/src/Security/Advisories/Queries.hs @@ -6,19 +6,15 @@ module Security.Advisories.Queries , listVersionRangeAffectedBy , isVersionAffectedBy , isVersionRangeAffectedBy - , parseVersionRange ) where import Control.Monad (forM_) -import Data.Bifunctor (first) import System.Exit (exitFailure) import System.IO (stderr, hPrint) import Data.Text (Text) -import qualified Data.Text as T import qualified Data.Text.IO as T -import Distribution.Parsec (eitherParsec) import Distribution.Types.Version (Version) import Distribution.Types.VersionInterval (asVersionIntervals) import Distribution.Types.VersionRange (VersionRange, anyVersion, earlierVersion, intersectVersionRanges, noVersion, orLaterVersion, unionVersionRanges, withinRange) @@ -79,7 +75,3 @@ listAffectedByHelper checkAffectedBy root queryPackageName queryVersionish = exitFailure Success advisories -> return $ filter (checkAffectedBy queryPackageName queryVersionish) advisories - --- | Parse 'VersionRange' as given to the CLI -parseVersionRange :: Maybe Text -> Either Text VersionRange -parseVersionRange = maybe (return anyVersion) (first T.pack . eitherParsec . T.unpack) diff --git a/code/hsec-tools/test/Spec/QueriesSpec.hs b/code/hsec-tools/test/Spec/QueriesSpec.hs index 46675b59..f1da6442 100644 --- a/code/hsec-tools/test/Spec/QueriesSpec.hs +++ b/code/hsec-tools/test/Spec/QueriesSpec.hs @@ -3,16 +3,19 @@ module Spec.QueriesSpec (spec) where +import Data.Bifunctor (first) +import Data.Maybe (fromMaybe) import Data.Text (Text) -import Distribution.Types.VersionRange (VersionRange, VersionRangeF(..), projectVersionRange) +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.Advisories.Definition import Security.Advisories.HsecId import Security.Advisories.Queries -import Distribution.Types.Version (version0, alterVersion) -import Data.Maybe (fromMaybe) spec :: TestTree spec = @@ -180,3 +183,7 @@ mkAffectedVersions vr = packageName :: Text packageName = "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)