cabal-audit: init

.github/workflows/nix.yml

@@ -22,6 +22,10 @@ jobs:
         uses: DeterminateSystems/flake-checker-action@v4
       - name: Build executable (hsec-tools)
         run: nix -L build
+      - name: Build executable (hsec-sync)
+        run: nix -L build '.#hsec-sync'
+      - name: Build executable (cabal-audit)
+        run: nix -L build '.#cabal-audit'
       - name: Build docker image
         run: nix build -L '.#packages.x86_64-linux.hsec-tools-image'
       - run: mkdir -p ~/.local/dockerImages

.gitignore

@@ -1,5 +1,6 @@
 *~
 dist-newstyle/
-result
+result*
 .direnv
 .env
+.pre-commit-config.yaml

README.md

@@ -11,6 +11,29 @@ please open a PR listing it here.
 To report a new vulnerability, open a pull request using the template below.
 See [CONTRIBUTING.md] for more information.
 
+## Checking your project for vulnerabilities
+
+For cabal projects, the security-advisories repository offers a way to inspect your project 
+for vulnerabilities. 
+
+To do so 
+1. install the `cabal-audit` executable, for example with nix by running `nix shell github:haskell/security-advisories#cabal-audit`
+2. navigate to your cabal project
+3. run `cabal-audit`
+
+The `cabal-audit` executable will then go on and 
+1. git clone the newest version of https://github.com/haskell/security-advisories
+2. solve your project 
+3. query the created plan against the advisory database
+
+Run `cabal-audit --help` to see available options.
+
+What to do if `cabal-audit` reported a vulnerability (in that order): 
+1. check if you can upgrade to at least the proposed fix version
+2. check if you can upgrade to a fix version that is not shown (find more information at the provided URL)
+3. check if there is a not vulnerable dependency that you can switch to
+4. check if the vulnerable behaviour applies to your project (find more information at the provided URL)
+
 ## Advisory Format
 
 See [EXAMPLE_ADVISORY.md] for a template.

code/.envrc

@@ -0,0 +1 @@
+use flake .. -Lv 

code/cabal-audit/app/Main.hs

@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Audit (auditMain)
+
+main :: IO ()
+main = auditMain

code/cabal-audit/cabal-audit.cabal

@@ -0,0 +1,103 @@
+cabal-version:      2.4
+name:               cabal-audit
+version:            1.0.0.0
+
+-- A short (one-line) description of the package.
+synopsis:           Checking a cabal project for security advisories
+
+-- A longer description of the package.
+description:
+  Tools for querying the haskell security advisories database against cabal projects.
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+license:            BSD-3-Clause
+author:             @MangoIV
+maintainer:         [email protected]
+
+-- A copyright notice.
+-- copyright:
+category:           Data
+extra-doc-files:
+extra-source-files:
+tested-with:
+  GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.3 || ==9.8.1
+
+common common-all
+  ghc-options:
+    -Wall -Wcompat -Widentities -Wincomplete-record-updates
+    -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
+    -fmax-relevant-binds=0 -fno-show-valid-hole-fits
+
+  if impl(ghc >=9.6.1)
+    ghc-options: -fno-show-error-context
+
+  default-extensions:
+    BlockArguments
+    DeriveGeneric
+    DerivingStrategies
+    EmptyCase
+    ImportQualifiedPost
+    LambdaCase
+    NamedFieldPuns
+    NoStarIsType
+    OverloadedStrings
+    PartialTypeSignatures
+    ScopedTypeVariables
+    StandaloneDeriving
+    StandaloneKindSignatures
+    TypeApplications
+
+library
+  import:           common-all
+  exposed-modules:
+    Distribution.Audit
+    Security.Advisories.Cabal
+
+  build-depends:
+    , base                  <5
+    , Cabal
+    , cabal-install
+    , colourista
+    , containers
+    , filepath
+    , hsec-core
+    , hsec-tools
+    , http-client
+    , optparse-applicative
+    , process
+    , temporary
+    , text
+    , validation-selective
+
+  hs-source-dirs:   src
+  default-language: Haskell2010
+
+executable cabal-audit
+  import:           common-all
+  hs-source-dirs:   app
+  main-is:          Main.hs
+  other-modules:
+  build-depends:
+    , base         <5
+    , cabal-audit
+
+  default-language: Haskell2010
+
+test-suite spec
+  import:           common-all
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          Main.hs
+  other-modules:    Spec
+  build-depends:
+    , base           <5
+    , Cabal
+    , cabal-audit
+    , cabal-install
+    , containers
+    , hspec
+
+  default-language: Haskell2010

code/cabal-audit/fourmolu.yaml

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

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

@@ -0,0 +1,174 @@
+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.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.String (IsString (fromString))
+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
+  ( CurrentCommand (OtherCommand)
+  , ProjectBaseContext (ProjectBaseContext, cabalDirLayout, distDirLayout, localPackages, projectConfig)
+  , commandLineFlagsToProjectConfig
+  , establishProjectBaseContext
+  )
+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 (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.Filesystem (listAdvisories)
+import System.IO.Temp (withSystemTempDirectory)
+import System.Process (callProcess)
+import Validation (validation)
+
+data AuditException
+  = InvalidFilePath String
+  | ListAdvisoryValidationError FilePath [ParseAdvisoryError]
+  deriving stock (Eq, 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:"
+        , show errs
+        ]
+
+-- | 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
+  }
+
+-- | 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")
+            ]
+
+buildAdvisories :: AuditConfig -> NixStyleFlags () -> IO (M.Map PackageName ElaboratedPackageInfoAdvised)
+buildAdvisories MkAuditConfig {advisoriesPathOrURL, verbosity} flags = do
+  let cliConfig = projectConfigFromFlags flags
+
+  ProjectBaseContext {distDirLayout, cabalDirLayout, projectConfig, localPackages} <-
+    establishProjectBaseContext
+      verbosity
+      cliConfig
+      OtherCommand
+  (_plan', plan, _, _, _) <-
+    rebuildInstallPlan verbosity distDirLayout cabalDirLayout projectConfig localPackages Nothing
+
+  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
+      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
+
+  pure $ matchAdvisoriesForPlan plan advisories
+
+-- | 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
+
+{-# INLINE prettyVersion #-}
+prettyVersion :: IsString s => Version -> s
+prettyVersion = fromString . List.intercalate "." . map show . versionNumbers
+
+prettyAdvisory :: Advisory -> Maybe Version -> Text
+prettyAdvisory Advisory {advisoryId, advisoryPublished, advisoryKeywords, advisorySummary} mfv =
+  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
+      , 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)
+
+-- | this is handler is used when displaying to the user
+humanReadableHandler :: [(PackageName, ElaboratedPackageInfoAdvised)] -> IO ()
+humanReadableHandler = \case
+  [] -> putStrLn (formatWith [green, bold] "No advisories found.")
+  avs -> do
+    putStrLn (formatWith [bold, red] "\n\nFound advisories:\n")
+    for_ avs \(pn, i) -> do
+      let verString = formatWith [yellow] $ prettyVersion $ elaboratedPackageVersion i
+          pkgName = formatWith [yellow] $ show $ unPackageName pn
+      putStrLn ("dependency " <> pkgName <> " at version " <> verString <> " is vulnerable for:")
+      for_ (runIdentity (packageAdvisories i)) (T.putStrLn . uncurry prettyAdvisory)
+
+projectConfigFromFlags :: NixStyleFlags a -> ProjectConfig
+projectConfigFromFlags flags = commandLineFlagsToProjectConfig defaultGlobalFlags flags mempty
+
+auditCommandParser :: Parser (AuditConfig, NixStyleFlags ())
+auditCommandParser =
+  (,)
+    <$> do
+      MkAuditConfig
+        <$> 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
+            "normal" -> Right Verbosity.normal
+            "verbose" -> Right Verbosity.verbose
+            "deafening" -> Right Verbosity.deafening
+            _ -> Left "verbosity has to be one of \"silent\", \"normal\", \"verbose\" or \"deafening\""
+    <*> pure (defaultNixStyleFlags ())