[feat] make pretty human-readable output, allow URL

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
 

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 "<path to advisories>")
+        <$> 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

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

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