From 2de40ce0599d31470714d9eae567eaa49fa5bc22 Mon Sep 17 00:00:00 2001 From: mangoiv Date: Sun, 17 Mar 2024 23:26:18 +0100 Subject: [PATCH] [feat] make pretty human-readable output, allow URL --- code/hsec-cabal/hsec-cabal.cabal | 5 + code/hsec-cabal/src/Distribution/Audit.hs | 92 ++++++++++++++++--- .../src/Security/Advisories/Cabal.hs | 13 ++- .../src/Security/Advisories/Core/Advisory.hs | 2 +- 4 files changed, 97 insertions(+), 15 deletions(-) diff --git a/code/hsec-cabal/hsec-cabal.cabal b/code/hsec-cabal/hsec-cabal.cabal index 34665513..94246d69 100644 --- a/code/hsec-cabal/hsec-cabal.cabal +++ b/code/hsec-cabal/hsec-cabal.cabal @@ -42,6 +42,7 @@ common common-all ImportQualifiedPost LambdaCase NamedFieldPuns + OverloadedStrings ScopedTypeVariables StandaloneDeriving StandaloneKindSignatures @@ -57,11 +58,15 @@ library , base <5 , Cabal , cabal-install + , colourista , containers , filepath , hsec-core , hsec-tools + , http-client , optparse-applicative + , process + , temporary , text , validation-selective diff --git a/code/hsec-cabal/src/Distribution/Audit.hs b/code/hsec-cabal/src/Distribution/Audit.hs index 1dcb3218..44330393 100644 --- a/code/hsec-cabal/src/Distribution/Audit.hs +++ b/code/hsec-cabal/src/Distribution/Audit.hs @@ -1,6 +1,16 @@ module Distribution.Audit (auditMain) where +import Colourista.Pure (blue, bold, formatWith, green, red, yellow) import Control.Exception (Exception (displayException), throwIO) +import Control.Monad (when) +import Data.Coerce (coerce) +import Data.Foldable (for_) +import Data.Functor.Identity (Identity (runIdentity)) +import Data.List qualified as List +import Data.Map qualified as M +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T import Distribution.Client.NixStyleOptions (NixStyleFlags, defaultNixStyleFlags) import Distribution.Client.ProjectConfig (ProjectConfig) import Distribution.Client.ProjectOrchestration @@ -11,12 +21,16 @@ import Distribution.Client.ProjectOrchestration ) import Distribution.Client.ProjectPlanning (rebuildInstallPlan) import Distribution.Client.Setup (defaultGlobalFlags) +import Distribution.Types.PackageName (PackageName, unPackageName) import Distribution.Verbosity qualified as Verbosity +import Distribution.Version (versionNumbers) import GHC.Generics (Generic) import Options.Applicative -import Security.Advisories (ParseAdvisoryError) -import Security.Advisories.Cabal (matchAdvisoriesForPlan) +import Security.Advisories (Advisory (..), Keyword (..), ParseAdvisoryError, printHsecId) +import Security.Advisories.Cabal (ElaboratedPackageInfoAdvised, ElaboratedPackageInfoWith (elaboratedPackageVersion, packageAdvisories), matchAdvisoriesForPlan) import Security.Advisories.Filesystem (listAdvisories) +import System.IO.Temp (withSystemTempDirectory) +import System.Process import Validation (validation) data AuditException @@ -35,22 +49,22 @@ instance Exception AuditException where -- | configuration that is specific to the cabal audit command data AuditConfig = MkAuditConfig - { advisoriesPath :: FilePath - -- ^ path to the advisories + { advisoriesPathOrURL :: Either FilePath String + -- ^ path or URL to the advisories , verbosity :: Verbosity.Verbosity -- ^ verbosity of cabal } auditMain :: IO () auditMain = do - (MkAuditConfig {advisoriesPath, verbosity}, flags) <- customExecParser (prefs showHelpOnEmpty) do + (MkAuditConfig {advisoriesPathOrURL, verbosity}, flags) <- customExecParser (prefs showHelpOnEmpty) do info do helper <*> auditCommandParser do mconcat [ fullDesc - , progDesc "audit your cabal projects for vulnerabilities" - , header "Welcome to cabal audit" + , progDesc (formatWith [blue] "audit your cabal projects for vulnerabilities") + , header (formatWith [bold, blue] "Welcome to cabal audit") ] let cliConfig = projectConfigFromFlags flags @@ -61,10 +75,47 @@ auditMain = do OtherCommand (_plan', plan, _, _, _) <- rebuildInstallPlan verbosity distDirLayout cabalDirLayout projectConfig localPackages Nothing - advisories <- - listAdvisories advisoriesPath - >>= validation (throwIO . ListAdvisoryValidationError advisoriesPath) pure - print $ matchAdvisoriesForPlan plan advisories + + when (verbosity > Verbosity.normal) do + putStrLn (formatWith [blue] "Finished building the cabal install plan, looking for advisories...") + + advisories <- withSystemTempDirectory "hsec-cabal" \tmp -> do + realPath <- case advisoriesPathOrURL of + Left fp -> pure fp + Right url -> do + putStrLn $ formatWith [blue] $ "trying to clone " <> url + callProcess "git" ["clone", url, tmp] + pure tmp + listAdvisories realPath + >>= validation (throwIO . ListAdvisoryValidationError realPath) pure + + humanReadableHandler (M.toList (matchAdvisoriesForPlan plan advisories)) + +prettyAdvisory :: Advisory -> Text +prettyAdvisory Advisory {advisoryId, advisoryPublished, advisoryKeywords, advisorySummary} = + T.unlines do + let hsecId = T.pack (printHsecId advisoryId) + map + (" " <>) + [ formatWith [bold, blue] hsecId <> " (\"" <> advisorySummary <> "\")" + , "published: " <> formatWith [bold] (ps advisoryPublished) + , "https://haskell.github.io/security-advisories/advisory/" <> hsecId + , formatWith [blue] $ T.intercalate ", " (coerce advisoryKeywords) + , "" + ] + where + ps = T.pack . show + +-- | this is handler is used when displaying to the user +humanReadableHandler :: [(PackageName, ElaboratedPackageInfoAdvised)] -> IO () +humanReadableHandler = \case + [] -> putStrLn (formatWith [green, bold] "No advisories found.") + avs -> for_ avs \(pn, i) -> do + putStrLn (formatWith [bold, red] "\n\nFound advisories:\n") + let verString = formatWith [yellow] $ List.intercalate "." $ map show $ versionNumbers $ elaboratedPackageVersion i + pkgName = formatWith [yellow] $ show $ unPackageName pn + putStrLn (pkgName <> " at version: " <> verString <> " is vulnerable for:") + for_ (runIdentity (packageAdvisories i)) (T.putStrLn . prettyAdvisory) -- print $ matchAdvisoriesForPlan plan' advisories -- TODO(mangoiv): find out what's the correct plan @@ -77,7 +128,24 @@ auditCommandParser = (,) <$> do MkAuditConfig - <$> strArgument (metavar "") + <$> do + Left + <$> strOption do + mconcat + [ long "file-path" + , short 'p' + , metavar "FILE_PATH" + , help "the path the the repository containing an advisories directory" + ] + <|> Right + <$> strOption do + mconcat + [ long "repository" + , short 'r' + , metavar "REPOSITORY" + , help "the url to the repository containing an advisories directory" + , value "https://github.com/haskell/security-advisories" + ] <*> flip option (long "verbosity" <> value Verbosity.normal <> showDefaultWith (const "normal")) do eitherReader \case "silent" -> Right Verbosity.silent diff --git a/code/hsec-cabal/src/Security/Advisories/Cabal.hs b/code/hsec-cabal/src/Security/Advisories/Cabal.hs index 6cfbb2fd..9ea238b4 100644 --- a/code/hsec-cabal/src/Security/Advisories/Cabal.hs +++ b/code/hsec-cabal/src/Security/Advisories/Cabal.hs @@ -1,7 +1,13 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE UndecidableInstances #-} -module Security.Advisories.Cabal (matchAdvisoriesForPlan) where +module Security.Advisories.Cabal + ( matchAdvisoriesForPlan + , ElaboratedPackageInfoWith (..) + , ElaboratedPackageInfoAdvised + , ElaboratedPackageInfo + ) +where import Data.Functor.Identity (Identity (Identity)) import Data.Kind (Type) @@ -64,6 +70,9 @@ data ElaboratedPackageInfoWith f = MkElaboratedPackageInfoWith { elaboratedPackageVersion :: Version -- ^ the version of the package that is installed , packageAdvisories :: f [Advisory] + -- ^ the advisories for some package; this is just the () type + -- (Proxy) as longas the advisories haven't been looked up and a + -- [Advisory] after looking up the advisories in the DB } deriving stock (Generic) @@ -73,7 +82,7 @@ deriving stock instance Ord (f [Advisory]) => (Ord (ElaboratedPackageInfoWith f) deriving stock instance Show (f [Advisory]) => (Show (ElaboratedPackageInfoWith f)) --- FUTUREWORK(mangoiv): this could probably be done more intelligent by also +-- FUTUREWORK(mangoiv): this could probably be done more intelligently by also -- looking up via the version range but I don't know exacty how -- | 'Map' to lookup the package name in the install plan that returns information diff --git a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs b/code/hsec-core/src/Security/Advisories/Core/Advisory.hs index 1211be2b..800ebfb4 100644 --- a/code/hsec-core/src/Security/Advisories/Core/Advisory.hs +++ b/code/hsec-core/src/Security/Advisories/Core/Advisory.hs @@ -95,7 +95,7 @@ data OS | OpenBSD deriving stock (Show) -newtype Keyword = Keyword Text +newtype Keyword = Keyword {getKeyWord :: Text} deriving stock (Eq, Ord) deriving (Show) via Text