From 5d99c1673b49da359cd13f8c28d6995fcd2e1e1f Mon Sep 17 00:00:00 2001 From: seaerchin <44049504+seaerchin@users.noreply.github.com> Date: Tue, 4 May 2021 16:32:14 +0800 Subject: [PATCH] feat(main): log configuration file used (#615) * feat(main): added new flag to determine if the configuration file should be shown * feat(main.hs): pipe messages to stderr instead of stdout * style(main.hs): changes flag to be a verbose flag instead * feat(config): added new method to get the actual config filepath * refactor(main): uses new getConfig method; passes actual config to applyConfig call --- app/Main.hs | 55 ++++++++++++++++++++++++++++++------------ src/Hadolint/Config.hs | 29 +++++++++++++--------- 2 files changed, 57 insertions(+), 27 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index ef9cb788..dcf14453 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,12 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + module Main where import Control.Applicative +import Control.Monad (when) import qualified Data.Bifunctor as Bifunctor import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map @@ -12,10 +18,11 @@ import qualified Data.Text as Text import qualified Data.Version import qualified Development.GitRev import qualified Hadolint -import qualified Hadolint.Rule as Rule import qualified Hadolint.Formatter.Format as Format +import qualified Hadolint.Rule as Rule import Options.Applicative ( Parser, + ReadM, action, argument, completeWith, @@ -31,7 +38,6 @@ import Options.Applicative metavar, option, progDesc, - ReadM, short, showDefaultWith, str, @@ -43,12 +49,14 @@ import Options.Applicative import qualified Paths_hadolint as Meta import System.Environment import System.Exit (exitFailure, exitSuccess) +import System.IO (hPutStrLn, stderr) data CommandOptions = CommandOptions { showVersion :: Bool, noFail :: Bool, nocolor :: Bool, configFile :: Maybe FilePath, + isVerbose :: Bool, format :: Hadolint.OutputFormat, dockerfiles :: [String], lintingOptions :: Hadolint.LintOptions @@ -87,6 +95,7 @@ parseOptions = <*> noFail <*> nocolor <*> configFile + <*> isVerbose <*> outputFormat <*> files <*> lintOptions @@ -100,9 +109,10 @@ parseOptions = (maybeReader toNofailSeverity) ( short 't' <> long "failure-theshold" - <> help "Exit with failure code only when rules with a severity \ - \above THRESHOLD are violated. Accepted values: \ - \[error | warning | info | style | ignore | none]" + <> help + "Exit with failure code only when rules with a severity \ + \above THRESHOLD are violated. Accepted values: \ + \[error | warning | info | style | ignore | none]" <> value Rule.DLInfoC <> metavar "THRESHOLD" <> showDefaultWith (Text.unpack . Format.severityText) @@ -111,8 +121,11 @@ parseOptions = nocolor = switch (long "no-color" <> help "Don't colorize output") - strictlabels = switch (long "strict-labels" - <> help "Do not permit labels other than specified in `label-schema`") + strictlabels = + switch + ( long "strict-labels" + <> help "Do not permit labels other than specified in `label-schema`" + ) configFile = optional @@ -122,6 +135,8 @@ parseOptions = ) ) + isVerbose = switch (long "verbose" <> short 'V' <> help "Enables verbose logging of hadolint's output to stderr") + outputFormat = option (maybeReader toOutputFormat) @@ -191,9 +206,11 @@ parseOptions = <*> parseRulesConfig <*> noFailCutoff - labels = Map.fromList + labels = + Map.fromList <$> many - ( option readSingleLabelSchema + ( option + readSingleLabelSchema ( long "require-label" <> help "The option --require-label=label:format makes Hadolint check that the label `label` conforms to format requirement `format`" <> metavar "LABELSCHEMA (e.g. maintainer:text)" @@ -206,7 +223,8 @@ parseOptions = <*> labels <*> strictlabels - parseAllowedRegistries = Set.fromList . fmap fromString + parseAllowedRegistries = + Set.fromList . fmap fromString <$> many ( strOption ( long "trusted-registry" @@ -222,9 +240,9 @@ readSingleLabelSchema = eitherReader $ \s -> labelParser (Text.pack s) labelParser :: Text.Text -> Either String (Rule.LabelName, Rule.LabelType) labelParser l = - case Bifunctor.second (Rule.read . Text.drop 1) $ Text.breakOn ":" l of - (ln, Right lt) -> Right (ln, lt) - (_, Left e) -> Left $ Text.unpack e + case Bifunctor.second (Rule.read . Text.drop 1) $ Text.breakOn ":" l of + (ln, Right lt) -> Right (ln, lt) + (_, Left e) -> Left $ Text.unpack e noFailure :: Hadolint.Result s e -> Rule.DLSeverity -> Bool noFailure (Hadolint.Result _ Seq.Empty Seq.Empty) _ = True @@ -232,7 +250,8 @@ noFailure (Hadolint.Result _ Seq.Empty fails) cutoff = Seq.null (Seq.filter (\f -> Rule.severity f < cutoff) fails) noFailure _ _ = False -exitProgram :: Foldable f => +exitProgram :: + Foldable f => CommandOptions -> Hadolint.LintOptions -> f (Hadolint.Result s e) -> @@ -260,7 +279,9 @@ main = do execute CommandOptions {dockerfiles = []} = putStrLn "Please provide a Dockerfile" >> exitFailure execute cmd = do - lintConfig <- Hadolint.applyConfig (configFile cmd) (lintingOptions cmd) + maybeConfig <- Hadolint.getConfig (configFile cmd) + when (isVerbose cmd) (hPutStrLn stderr $ getFilePathDescription maybeConfig) + lintConfig <- Hadolint.applyConfig maybeConfig (lintingOptions cmd) let files = NonEmpty.fromList (dockerfiles cmd) case lintConfig of Left err -> error err @@ -279,3 +300,7 @@ getVersion | otherwise = "Haskell Dockerfile Linter " ++ version where version = $(Development.GitRev.gitDescribe) + +getFilePathDescription :: Maybe FilePath -> String +getFilePathDescription Nothing = "No configuration was specified. Using default configuration" +getFilePathDescription (Just filepath) = "Configuration file used: " ++ filepath \ No newline at end of file diff --git a/src/Hadolint/Config.hs b/src/Hadolint/Config.hs index 7e00fec5..225beb81 100644 --- a/src/Hadolint/Config.hs +++ b/src/Hadolint/Config.hs @@ -1,5 +1,6 @@ module Hadolint.Config ( applyConfig, + getConfig, ConfigFile (..), OverrideConfig (..), ) @@ -90,21 +91,10 @@ applyConfig :: Maybe FilePath -> Lint.LintOptions -> IO (Either String Lint.Lint applyConfig maybeConfig o | not (Prelude.null (Lint.ignoreRules o)) && Lint.rulesConfig o /= mempty = return (Right o) | otherwise = do - theConfig <- - case maybeConfig of - Nothing -> findConfig - c -> return c - case theConfig of + case maybeConfig of Nothing -> return (Right o) Just config -> parseAndApply config where - acceptedConfigs = [".hadolint.yaml", ".hadolint.yml"] - - findConfig = do - localConfigFiles <- traverse (\filePath -> ( filePath) <$> getCurrentDirectory) acceptedConfigs - configFiles <- traverse (getXdgDirectory XdgConfig) acceptedConfigs - listToMaybe <$> filterM doesFileExist (localConfigFiles ++ configFiles) - parseAndApply :: FilePath -> IO (Either String Lint.LintOptions) parseAndApply configFile = do contents <- Bytes.readFile configFile @@ -168,3 +158,18 @@ applyConfig maybeConfig o "", err ] + +-- | Gets the configuration file which Hadolint uses +getConfig :: Maybe FilePath -> IO (Maybe FilePath) +getConfig maybeConfig = + case maybeConfig of + Nothing -> findConfig + _ -> return maybeConfig + where + findConfig :: IO (Maybe FilePath) + findConfig = do + localConfigFiles <- traverse (\filePath -> ( filePath) <$> getCurrentDirectory) acceptedConfigs + configFiles <- traverse (getXdgDirectory XdgConfig) acceptedConfigs + listToMaybe <$> filterM doesFileExist (localConfigFiles ++ configFiles) + where + acceptedConfigs = [".hadolint.yaml", ".hadolint.yml"]