[feat] add support for outputing json to cabal-audit

haskell · Mar 31, 2024 · 78bf05a · 78bf05a
1 parent 9b6117c
commit 78bf05a
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 23 deletions.
diff --git a/code/cabal-audit/cabal-audit.cabal b/code/cabal-audit/cabal-audit.cabal
@@ -28,7 +28,7 @@ tested-with:
 common common-all
   ghc-options:
     -Wall -Wcompat -Widentities -Wincomplete-record-updates
-    -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
+    -Wincomplete-uni-patterns -Wredundant-constraints
     -fmax-relevant-binds=0 -fno-show-valid-hole-fits
 
   if impl(ghc >=9.6.1)
@@ -49,6 +49,7 @@ common common-all
     StandaloneDeriving
     StandaloneKindSignatures
     TypeApplications
+    ViewPatterns
 
 library
   import:           common-all
@@ -57,6 +58,7 @@ library
     Security.Advisories.Cabal
 
   build-depends:
+    , aeson
     , base                  <5
     , Cabal
     , cabal-install

diff --git a/code/cabal-audit/src/Distribution/Audit.hs b/code/cabal-audit/src/Distribution/Audit.hs
@@ -6,11 +6,13 @@
 --    database
 -- 3. summarise the found vulnerabilities as a humand readable or
 --    otherwise formatted output
-module Distribution.Audit (auditMain, buildAdvisories, AuditConfig (..), AuditException (..)) where
+module Distribution.Audit (auditMain, buildAdvisories, AuditConfig (..), AuditException (..), Output (..)) where
 
 import Colourista.Pure (blue, bold, formatWith, green, red, yellow)
 import Control.Exception (Exception (displayException), SomeException (SomeException), catch, throwIO)
 import Control.Monad (when)
+import Data.Aeson (KeyValue ((.=)), Value, object)
+import Data.Aeson qualified as Aeson
 import Data.Coerce (coerce)
 import Data.Foldable (for_)
 import Data.Functor.Identity (Identity (runIdentity))
@@ -36,7 +38,8 @@ import Distribution.Version (Version, versionNumbers)
 import GHC.Generics (Generic)
 import Options.Applicative
 import Security.Advisories (Advisory (..), Keyword (..), ParseAdvisoryError, printHsecId)
-import Security.Advisories.Cabal (ElaboratedPackageInfoAdvised, ElaboratedPackageInfoWith (elaboratedPackageVersion, packageAdvisories), matchAdvisoriesForPlan)
+import Security.Advisories.Cabal (ElaboratedPackageInfoAdvised, ElaboratedPackageInfoWith (MkElaboratedPackageInfoWith, elaboratedPackageVersion, packageAdvisories), matchAdvisoriesForPlan)
+import Security.Advisories.Convert.OSV qualified as OSV
 import Security.Advisories.Filesystem (listAdvisories)
 import System.Exit (exitFailure)
 import System.IO.Temp (withSystemTempDirectory)
@@ -45,9 +48,9 @@ import Validation (validation)
 
 data AuditException
   = -- | parsing the advisory database failed
-    ListAdvisoryValidationError FilePath [ParseAdvisoryError]
+    ListAdvisoryValidationError {originalFilePath :: FilePath, parseError :: [ParseAdvisoryError]}
   | -- | to rethrow exceptions thrown by cabal during plan elaboration
-    CabalException String SomeException
+    CabalException {reason :: String, cabalException :: SomeException}
   deriving stock (Show, Generic)
 
 instance Exception AuditException where
@@ -65,29 +68,36 @@ instance Exception AuditException where
         <> ":\n"
         <> displayException ex
 
+-- | the type of output that is chosen for the command
+data Output
+  = -- | write humand readable to stdout
+    HumanReadable
+  | -- | write as Osv format to the specified file
+    Osv {osvPath :: FilePath}
+
 -- | configuration that is specific to the cabal audit command
 data AuditConfig = MkAuditConfig
   { advisoriesPathOrURL :: Either FilePath String
   -- ^ path or URL to the advisories
   , verbosity :: Verbosity.Verbosity
   -- ^ verbosity of cabal
+  , outputType :: Output
   }
 
 -- | the main action to invoke
 auditMain :: IO ()
 auditMain =
   do
-    handleBuiltAdvisories
-      =<< uncurry buildAdvisories
-      =<< customExecParser (prefs showHelpOnEmpty) do
-        info
-          do helper <*> auditCommandParser
-          do
-            mconcat
-              [ fullDesc
-              , progDesc (formatWith [blue] "audit your cabal projects for vulnerabilities")
-              , header (formatWith [bold, blue] "Welcome to cabal audit")
-              ]
+    (auditConfig, nixStyleFlags) <- customExecParser (prefs showHelpOnEmpty) do
+      info (helper <*> auditCommandParser) do
+        mconcat
+          [ fullDesc
+          , progDesc (formatWith [blue] "audit your cabal projects for vulnerabilities")
+          , header (formatWith [bold, blue] "Welcome to cabal audit")
+          ]
+
+    buildAdvisories auditConfig nixStyleFlags
+      >>= handleBuiltAdvisories (outputType auditConfig)
     `catch` \(SomeException ex) -> do
       putStrLn $
         unlines
@@ -105,15 +115,15 @@ buildAdvisories MkAuditConfig {advisoriesPathOrURL, verbosity} flags = do
       verbosity
       cliConfig
       OtherCommand
-      `catch` \ex -> throwIO $ CabalException "trying to establish project base context" ex
+      `catch` \ex -> throwIO $ CabalException {reason = "trying to establish project base context", cabalException = ex}
   -- the two plans are
   -- 1. the "improved plan" with packages replaced by in-store packages
   -- 2. the "original" elaborated plan
   --
   -- as far as I can tell, for our use case these should be indistinguishable
   (_improvedPlan, plan, _, _, _) <-
     rebuildInstallPlan verbosity distDirLayout cabalDirLayout projectConfig localPackages Nothing
-      `catch` \ex -> throwIO $ CabalException "elaborating the install-plan" ex
+      `catch` \ex -> throwIO $ CabalException {reason = "elaborating the install-plan", cabalException = ex}
 
   when (verbosity > Verbosity.normal) do
     putStrLn (formatWith [blue] "Finished building the cabal install plan, looking for advisories...")
@@ -134,8 +144,21 @@ buildAdvisories MkAuditConfig {advisoriesPathOrURL, verbosity} flags = do
 -- | provides the built advisories in some consumable form, e.g. as human readable form
 --
 -- FUTUREWORK(mangoiv): provide output as JSON
-handleBuiltAdvisories :: M.Map PackageName ElaboratedPackageInfoAdvised -> IO ()
-handleBuiltAdvisories = humanReadableHandler . M.toList
+handleBuiltAdvisories :: Output -> M.Map PackageName ElaboratedPackageInfoAdvised -> IO ()
+handleBuiltAdvisories = \case
+  HumanReadable -> humanReadableHandler . M.toList
+  Osv fp -> osvHandler fp
+
+osvHandler :: FilePath -> M.Map PackageName ElaboratedPackageInfoAdvised -> IO ()
+osvHandler fp =
+  Aeson.encodeFile @Value fp . object . M.foldMapWithKey
+    \pn MkElaboratedPackageInfoWith {elaboratedPackageVersion, packageAdvisories} ->
+      [ fromString (unPackageName pn)
+          .= object
+            [ "version" .= prettyVersion @Text elaboratedPackageVersion
+            , "advisories" .= map (OSV.convert . fst) (runIdentity packageAdvisories)
+            ]
+      ]
 
 -- | pretty-prints a `Version`
 --
@@ -153,13 +176,12 @@ prettyAdvisory Advisory {advisoryId, advisoryPublished, advisoryKeywords, adviso
     map
       ("  " <>)
       [ formatWith [bold, blue] hsecId <> " \"" <> advisorySummary <> "\""
-      , "published: " <> formatWith [bold] (ps advisoryPublished)
+      , "published: " <> formatWith [bold] (T.pack $ show advisoryPublished)
       , "https://haskell.github.io/security-advisories/advisory/" <> hsecId
       , fixAvailable
       , formatWith [blue] $ T.intercalate ", " (coerce advisoryKeywords)
       ]
  where
-  ps = T.pack . show
   fixAvailable = case mfv of
     Nothing -> formatWith [bold, red] "No fix version available"
     Just fv -> formatWith [bold, green] "Fix available since version " <> formatWith [yellow] (prettyVersion fv)
@@ -190,7 +212,7 @@ auditCommandParser =
               mconcat
                 [ long "file-path"
                 , short 'p'
-                , metavar "FILE_PATH"
+                , metavar "FILEPATH"
                 , help "the path the the repository containing an advisories directory"
                 ]
               <|> Right
@@ -209,6 +231,16 @@ auditCommandParser =
             "verbose" -> Right Verbosity.verbose
             "deafening" -> Right Verbosity.deafening
             _ -> Left "verbosity has to be one of \"silent\", \"normal\", \"verbose\" or \"deafening\""
+        <*> do
+          Osv
+            <$> strOption do
+              mconcat
+                [ long "osv"
+                , short 'o'
+                , metavar "FILEPATH"
+                , help "whether to print to a file of osv, mapping package name and version to an osv"
+                ]
+              <|> pure HumanReadable
     -- FUTUREWORK(mangoiv): this will accept cabal flags as an additional argument with something like
     -- --cabal-flags "--some-cabal-flag" and print a helper that just forwards the cabal help text
     <*> pure (defaultNixStyleFlags ())