[chore] minor cleanups

- remove deps from testsuite
- only create tmp dir when really needed
- proper toplevel exception handling
- more documentation
- appease hlint
- format fourmolu.yaml

code/cabal-audit/cabal-audit.cabal

@@ -93,11 +93,8 @@ test-suite spec
   main-is:          Main.hs
   other-modules:    Spec
   build-depends:
-    , base           <5
-    , Cabal
+    , base         <5
     , cabal-audit
-    , cabal-install
-    , containers
     , hspec
 
   default-language: Haskell2010

code/cabal-audit/fourmolu.yaml

@@ -1,12 +1,14 @@
-indentation: 2
-function-arrows: leading
 comma-style: leading
+function-arrows: leading
+haddock-style: single-line
 import-export-style: leading
+in-style: right-align
 indent-wheres: false
-record-brace-space: true
-newlines-between-decls: 1
-haddock-style: single-line
+indentation: 2
 let-style: inline
-in-style: right-align
+newlines-between-decls: 1
+record-brace-space: true
 respectful: false
 single-constraint-parens: never
+single-deriving-parens: never
+unicode: never

code/cabal-audit/src/Distribution/Audit.hs

@@ -1,7 +1,15 @@
-module Distribution.Audit (auditMain, buildAdvisories, AuditConfig(..), AuditException(..)) where
+-- | provides the @cabal-audit@ plugin which works as follows:
+--
+-- 1. parse command line arguments to pass on to cabal to build
+--    an install plan and parse the advisories database
+-- 2. lookup all dependencies in the elaborated plan within the
+--    database
+-- 3. summarise the found vulnerabilities as a humand readable or
+--    otherwise formatted output
+module Distribution.Audit (auditMain, buildAdvisories, AuditConfig (..), AuditException (..)) where
 
 import Colourista.Pure (blue, bold, formatWith, green, red, yellow)
-import Control.Exception (Exception (displayException), throwIO)
+import Control.Exception (Exception (displayException), SomeException (SomeException), catch, throwIO)
 import Control.Monad (when)
 import Data.Coerce (coerce)
 import Data.Foldable (for_)
@@ -30,23 +38,32 @@ import Options.Applicative
 import Security.Advisories (Advisory (..), Keyword (..), ParseAdvisoryError, printHsecId)
 import Security.Advisories.Cabal (ElaboratedPackageInfoAdvised, ElaboratedPackageInfoWith (elaboratedPackageVersion, packageAdvisories), matchAdvisoriesForPlan)
 import Security.Advisories.Filesystem (listAdvisories)
+import System.Exit (exitFailure)
 import System.IO.Temp (withSystemTempDirectory)
 import System.Process (callProcess)
 import Validation (validation)
 
 data AuditException
-  = InvalidFilePath String
-  | ListAdvisoryValidationError FilePath [ParseAdvisoryError]
-  deriving stock (Eq, Show, Generic)
+  = -- | parsing the advisory database failed
+    ListAdvisoryValidationError FilePath [ParseAdvisoryError]
+  | -- | to rethrow exceptions thrown by cabal during plan elaboration
+    CabalException String SomeException
+  deriving stock (Show, Generic)
 
 instance Exception AuditException where
   displayException = \case
-    InvalidFilePath fp -> show fp <> " is not a valid filepath"
     ListAdvisoryValidationError dir errs ->
-      unlines
-        [ "Listing the advisories in directory " <> dir <> " failed with:"
+      mconcat
+        [ "Listing the advisories in directory "
+        , dir
+        , " failed with: \n"
         , show errs
         ]
+    CabalException ctx (SomeException ex) ->
+      "cabal failed while "
+        <> ctx
+        <> ":\n"
+        <> displayException ex
 
 -- | configuration that is specific to the cabal audit command
 data AuditConfig = MkAuditConfig
@@ -58,18 +75,26 @@ data AuditConfig = MkAuditConfig
 
 -- | 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")
-            ]
+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")
+              ]
+    `catch` \(SomeException ex) -> do
+      putStrLn $
+        unlines
+          [ formatWith [red, bold] "cabal-audit failed:"
+          , formatWith [red] $ displayException ex
+          ]
+      exitFailure
 
 buildAdvisories :: AuditConfig -> NixStyleFlags () -> IO (M.Map PackageName ElaboratedPackageInfoAdvised)
 buildAdvisories MkAuditConfig {advisoriesPathOrURL, verbosity} flags = do
@@ -80,21 +105,29 @@ buildAdvisories MkAuditConfig {advisoriesPathOrURL, verbosity} flags = do
       verbosity
       cliConfig
       OtherCommand
-  (_plan', plan, _, _, _) <-
+      `catch` \ex -> throwIO $ CabalException "trying to establish project base context" 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
 
   when (verbosity > Verbosity.normal) do
     putStrLn (formatWith [blue] "Finished building the cabal install plan, looking for advisories...")
 
   advisories <- do
-    realPath <- case advisoriesPathOrURL of
-      Left fp -> pure fp
+    let k realPath =
+          listAdvisories realPath
+            >>= validation (throwIO . ListAdvisoryValidationError realPath) pure
+    case advisoriesPathOrURL of
+      Left fp -> k fp
       Right url -> withSystemTempDirectory "cabal-audit" \tmp -> do
         putStrLn $ formatWith [blue] $ "trying to clone " <> url
         callProcess "git" ["clone", url, tmp]
-        pure tmp
-    listAdvisories realPath
-      >>= validation (throwIO . ListAdvisoryValidationError realPath) pure
+        k tmp
 
   pure $ matchAdvisoriesForPlan plan advisories
 
@@ -104,9 +137,14 @@ buildAdvisories MkAuditConfig {advisoriesPathOrURL, verbosity} flags = do
 handleBuiltAdvisories :: M.Map PackageName ElaboratedPackageInfoAdvised -> IO ()
 handleBuiltAdvisories = humanReadableHandler . M.toList
 
-{-# INLINE prettyVersion #-}
+-- | pretty-prints a `Version`
+--
+-- >>> import Distribution.Version
+-- >>> prettyVersion $ mkVersion [0, 1, 0, 0]
+-- "0.1.0.0"
 prettyVersion :: IsString s => Version -> s
 prettyVersion = fromString . List.intercalate "." . map show . versionNumbers
+{-# INLINE prettyVersion #-}
 
 prettyAdvisory :: Advisory -> Maybe Version -> Text
 prettyAdvisory Advisory {advisoryId, advisoryPublished, advisoryKeywords, advisorySummary} mfv =
@@ -171,4 +209,6 @@ auditCommandParser =
             "verbose" -> Right Verbosity.verbose
             "deafening" -> Right Verbosity.deafening
             _ -> Left "verbosity has to be one of \"silent\", \"normal\", \"verbose\" or \"deafening\""
+    -- 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 ())

code/hsec-sync/app/Main.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main where

code/hsec-sync/hsec-sync.cabal

@@ -30,19 +30,19 @@ library
     Security.Advisories.Sync.Git
 
   build-depends:
-    , base         >=4.14  && <4.20
-    , directory    >=1.3   && <1.4
-    , extra        >=1.7   && <1.8
-    , feed         >=1.3   && <1.4
-    , filepath     >=1.4   && <1.5
+    , base          >=4.14  && <4.20
+    , directory     >=1.3   && <1.4
+    , extra         >=1.7   && <1.8
+    , feed          >=1.3   && <1.4
+    , filepath      >=1.4   && <1.5
     , hsec-core
-    , http-client  >=0.7.0 && <0.8
-    , lens         >=5.1   && <5.3
-    , process      >=1.6   && <1.7
-    , text         >=1.2   && <3
-    , time         >=1.9   && <1.14
-    , transformers >=0.5   && <0.7
-    , wreq         >=0.5   && <0.6
+    , http-client   >=0.7.0 && <0.8
+    , lens          >=5.1   && <5.3
+    , process       >=1.6   && <1.7
+    , text          >=1.2   && <3
+    , time          >=1.9   && <1.14
+    , transformers  >=0.5   && <0.7
+    , wreq          >=0.5   && <0.6
 
   hs-source-dirs:   src
   default-language: Haskell2010
@@ -81,12 +81,12 @@ test-suite spec
   build-depends:
     , base         <5
     , directory
-    , hsec-sync
     , filepath
+    , hsec-sync
     , process
     , tasty        <1.5
     , tasty-hunit  <0.11
-    , temporary    ==1.*
+    , temporary    >=1   && <2
     , text
     , time
 

code/hsec-sync/test/Spec/SyncSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Spec.SyncSpec (spec) where