diff --git a/code/hsec-cabal/hsec-cabal.cabal b/code/hsec-cabal/hsec-cabal.cabal index 049a0270..ae492df4 100644 --- a/code/hsec-cabal/hsec-cabal.cabal +++ b/code/hsec-cabal/hsec-cabal.cabal @@ -34,20 +34,21 @@ common common-all BlockArguments DeriveGeneric DerivingStrategies + EmptyCase + LambdaCase + NamedFieldPuns library import: common-all exposed-modules: Distribution.Audit - Distribution.Audit.Option Security.Advisories.Cabal build-depends: - , base <5 + , base <5 + , Cabal , cabal-install - , Cabal-syntax , hsec-core - , optparse-applicative hs-source-dirs: src default-language: Haskell2010 diff --git a/code/hsec-cabal/src/Distribution/Audit.hs b/code/hsec-cabal/src/Distribution/Audit.hs index 8ccc8fa6..5a7c410b 100644 --- a/code/hsec-cabal/src/Distribution/Audit.hs +++ b/code/hsec-cabal/src/Distribution/Audit.hs @@ -1,5 +1,77 @@ module Distribution.Audit (auditMain) where +import Data.Foldable (traverse_) +import qualified Distribution.Client.InstallPlan as Plan +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (configFlags) + , defaultNixStyleFlags + , nixStyleOptions + ) +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 (ConfigFlags (configVerbosity), defaultGlobalFlags) +import Distribution.Simple.Command + ( CommandParse (CommandErrors, CommandHelp, CommandList, CommandReadyToGo) + , CommandUI (..) + , commandParseArgs + ) +import Distribution.Simple.Flag (fromFlagOrDefault) +import qualified Distribution.Verbosity as Verbosity +import System.Environment (getArgs) + auditMain :: IO () -auditMain = do - putStrLn "unimplemented" +auditMain = + handleArgs auditCommandUI \flags -> do + let verbosity = verbosityFromFlags flags + cliConfig = projectConfigFromFlags flags + ProjectBaseContext {distDirLayout, cabalDirLayout, projectConfig, localPackages} <- + establishProjectBaseContext + verbosity + cliConfig + OtherCommand + (_, plan, _, _, _) <- + rebuildInstallPlan verbosity distDirLayout cabalDirLayout projectConfig localPackages Nothing + print `traverse_` Plan.toList plan + +projectConfigFromFlags :: NixStyleFlags a -> ProjectConfig +projectConfigFromFlags flags = commandLineFlagsToProjectConfig defaultGlobalFlags flags mempty + +verbosityFromFlags :: NixStyleFlags a -> Verbosity.Verbosity +verbosityFromFlags = fromFlagOrDefault Verbosity.normal . configVerbosity . configFlags + +auditCommandUI :: CommandUI (NixStyleFlags ()) +auditCommandUI = + CommandUI + { commandName = "cabal-audit" + , commandSynopsis = "Audits your cabal project" + , commandUsage = ("Usage: " ++) + , commandDescription = Nothing + , commandNotes = Nothing + , commandDefaultFlags = defaultNixStyleFlags () + , commandOptions = nixStyleOptions (const []) + } + +-- | handle cabal global command args +handleArgs + :: CommandUI flags + -> (flags -> IO ()) + -> IO () +handleArgs ui k = do + args <- getArgs + case commandParseArgs ui True args of + CommandHelp help -> putStrLn $ help "cabal-audit" + CommandList opts -> putStrLn $ "commandList: " <> show opts + CommandErrors errs -> putStrLn $ "commandErrors: " <> show errs + CommandReadyToGo (flags, _commandParse) -> k $ flags $ commandDefaultFlags ui diff --git a/code/hsec-cabal/src/Distribution/Audit/Option.hs b/code/hsec-cabal/src/Distribution/Audit/Option.hs deleted file mode 100644 index 211aa42d..00000000 --- a/code/hsec-cabal/src/Distribution/Audit/Option.hs +++ /dev/null @@ -1,18 +0,0 @@ --- TODO(mangoiv): implement a proper parser as well as proper options to --- - use constraints from a cabal file --- - use a cabal.freeze file --- - solve and then use cabal.freeze obtained -module Distribution.Audit.Option - ( CabalAuditOptions (..) - , cabalAuditParser - ) -where - -import GHC.Generics (Generic) -import Options.Applicative (Parser) - -data CabalAuditOptions = MkCabalAuditOptions {} - deriving stock (Eq, Ord, Show, Generic) - -cabalAuditParser :: Parser CabalAuditOptions -cabalAuditParser = pure MkCabalAuditOptions diff --git a/code/hsec-cabal/src/Security/Advisories/Cabal.hs b/code/hsec-cabal/src/Security/Advisories/Cabal.hs index d0124aee..23de1a0f 100644 --- a/code/hsec-cabal/src/Security/Advisories/Cabal.hs +++ b/code/hsec-cabal/src/Security/Advisories/Cabal.hs @@ -1 +1,4 @@ module Security.Advisories.Cabal where + + +