module Hadolint.Config.Commandline
  ( CommandlineConfig (..),
    parseCommandline
  )
where

import Control.Applicative
import Data.Bifunctor (second)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.String (IsString (fromString))
import Data.Text (Text, pack, unpack, breakOn, drop)
import Hadolint.Formatter.Format (readMaybeOutputFormat)
import Hadolint.Config.Configuration
import Hadolint.Rule
  ( LabelName,
    LabelType,
    readEitherLabelType,
    readEitherSeverity
  )
import Options.Applicative
  ( Parser,
    ReadM,
    action,
    argument,
    completeWith,
    eitherReader,
    flag',
    help,
    long,
    maybeReader,
    metavar,
    option,
    short,
    str,
    strOption,
    switch,
  )


data CommandlineConfig =
  CommandlineConfig
    { CommandlineConfig -> Bool
showVersion :: Bool,
      CommandlineConfig -> Maybe FilePath
configFile :: Maybe FilePath,
      CommandlineConfig -> [FilePath]
dockerfiles :: [String],
      CommandlineConfig -> Maybe FilePath
filePathInReportOption :: Maybe FilePath,
      CommandlineConfig -> PartialConfiguration
configuration :: PartialConfiguration
    }
  deriving (CommandlineConfig -> CommandlineConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandlineConfig -> CommandlineConfig -> Bool
$c/= :: CommandlineConfig -> CommandlineConfig -> Bool
== :: CommandlineConfig -> CommandlineConfig -> Bool
$c== :: CommandlineConfig -> CommandlineConfig -> Bool
Eq, Int -> CommandlineConfig -> ShowS
[CommandlineConfig] -> ShowS
CommandlineConfig -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CommandlineConfig] -> ShowS
$cshowList :: [CommandlineConfig] -> ShowS
show :: CommandlineConfig -> FilePath
$cshow :: CommandlineConfig -> FilePath
showsPrec :: Int -> CommandlineConfig -> ShowS
$cshowsPrec :: Int -> CommandlineConfig -> ShowS
Show)

parseCommandline :: Parser CommandlineConfig
parseCommandline :: Parser CommandlineConfig
parseCommandline =
  Bool
-> Maybe FilePath
-> [FilePath]
-> Maybe FilePath
-> PartialConfiguration
-> CommandlineConfig
CommandlineConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseVersion
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
parseConfigFile
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
parseFiles
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
parseFilePathInReportOption
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PartialConfiguration
parseConfiguration
  where
    parseVersion :: Parser Bool
parseVersion = Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show version")

    parseConfigFile :: Parser (Maybe FilePath)
parseConfigFile =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"config" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILENAME"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to the configuration file"
            )
        )

    parseFiles :: Parser [FilePath]
parseFiles = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str (forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DOCKERFILE..." forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file"))

    parseFilePathInReportOption :: Parser (Maybe FilePath)
parseFilePathInReportOption =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"file-path-in-report"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILEPATHINREPORT"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The file path referenced in the generated report.\
                        \ This only applies for the 'checkstyle' format and is\
                        \ useful when running Hadolint with Docker to set the\
                        \ correct file path."
            )
        )

    parseConfiguration :: Parser PartialConfiguration
parseConfiguration =
      Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe OutputFormat
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> Set Registry
-> LabelSchema
-> Maybe Bool
-> Maybe Bool
-> Maybe DLSeverity
-> PartialConfiguration
PartialConfiguration
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Bool)
parseNoFail
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseNoColor
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseVerbose
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe OutputFormat)
parseOutputFormat
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseErrorList
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseWarningList
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseInfoList
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseStyleList
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [RuleCode]
parseIgnoreList
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Set Registry)
parseAllowedRegistries
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LabelSchema
parseLabelSchema
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseStrictlabels
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Bool)
parseDisableIgnorePragma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe DLSeverity)
parseFailureThreshold

    -- All optional flags with boolean value must not have a default value. The
    -- optional parser then converts it to Nothing.
    -- This is to ensure if they are not set, this is correctly mirrored in the
    -- parsed Configuration and then their behaviour with respect to
    -- configurations from environment variables or config files is correct.
    parseNoFail :: Parser (Maybe Bool)
parseNoFail =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-fail"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't exit with a failure status code when any rule is\
                        \ violated"
            )
        )

    parseNoColor :: Parser (Maybe Bool)
parseNoColor =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-color"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't colorize output"
            )
        )

    parseVerbose :: Parser (Maybe Bool)
parseVerbose =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbose"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'V'
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enables verbose logging of hadolint's output to stderr"
            )
        )

    parseOutputFormat :: Parser (Maybe OutputFormat)
parseOutputFormat =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
        forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ( forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader (Text -> Maybe OutputFormat
readMaybeOutputFormat forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) )
          ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"format"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' -- options for the output format
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
                FilePath
"The output format for the results [tty | json | checkstyle |\
                \ codeclimate | gitlab_codeclimate | gnu | codacy | sonarqube |\
                \ sarif] (default: tty)"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => [FilePath] -> Mod f a
completeWith
                  [ FilePath
"tty",
                    FilePath
"json",
                    FilePath
"checkstyle",
                    FilePath
"codeclimate",
                    FilePath
"gitlab_codeclimate",
                    FilePath
"codacy",
                    FilePath
"sonarqube",
                    FilePath
"sarif"
                  ]
          )

    parseErrorList :: Parser [RuleCode]
parseErrorList =
      forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"error"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `error`"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseWarningList :: Parser [RuleCode]
parseWarningList =
      forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"warning"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `warning`"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseInfoList :: Parser [RuleCode]
parseInfoList =
      forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"info"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `info`"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseStyleList :: Parser [RuleCode]
parseStyleList =
      forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"style"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Make the rule `RULECODE` have the level `style`"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
            )
        )

    parseIgnoreList :: Parser [RuleCode]
parseIgnoreList =
      forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ignore"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RULECODE"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"A rule to ignore. If present, the ignore list in the\
                        \ config file is ignored"
            )
        )

    parseAllowedRegistries :: Parser (Set Registry)
parseAllowedRegistries =
      forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsString a => FilePath -> a
fromString
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
          ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
              ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"trusted-registry"
                  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"REGISTRY (e.g. docker.io)"
                  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"A docker registry to allow to appear in FROM \
                          \instructions"
              )
          )

    parseLabelSchema :: Parser LabelSchema
parseLabelSchema =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
          ( forall a. ReadM a -> Mod OptionFields a -> Parser a
option
              ReadM (Text, LabelType)
readSingleLabelSchema
              ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"require-label"
                  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LABELSCHEMA (e.g. maintainer:text)"
                  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The option --require-label=label:format makes\
                          \ Hadolint check that the label `label` conforms to\
                          \ format requirement `format`"
              )
          )

    parseStrictlabels :: Parser (Maybe Bool)
parseStrictlabels =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"strict-labels"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Do not permit labels other than specified in\
                        \ `label-schema`"
            )
        )

    parseDisableIgnorePragma :: Parser (Maybe Bool)
parseDisableIgnorePragma =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        ( forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True
            ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"disable-ignore-pragma"
                forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Disable inline ignore pragmas \
                        \ `# hadolint ignore=DLxxxx`"
            )
        )

    parseFailureThreshold :: Parser (Maybe DLSeverity)
parseFailureThreshold =
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
        forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ( forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader (Text -> Either FilePath DLSeverity
readEitherSeverity forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack) )
          ( forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't'
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"failure-threshold"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
                FilePath
"Exit with failure code only when rules with a severity equal\
                \ to or above THRESHOLD are violated. Accepted values: [error\
                \ | warning | info | style | ignore | none] (default: info)"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"THRESHOLD"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => [FilePath] -> Mod f a
completeWith
                  [ FilePath
"error",
                    FilePath
"warning",
                    FilePath
"info",
                    FilePath
"style",
                    FilePath
"ignore",
                    FilePath
"none"
                  ]
          )


type SingleLabelSchema = (LabelName, LabelType)

readSingleLabelSchema :: ReadM SingleLabelSchema
readSingleLabelSchema :: ReadM (Text, LabelType)
readSingleLabelSchema = forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ \FilePath
s -> Text -> Either FilePath (Text, LabelType)
labelParser (FilePath -> Text
pack FilePath
s)

labelParser :: Text -> Either String (LabelName, LabelType)
labelParser :: Text -> Either FilePath (Text, LabelType)
labelParser Text
l =
  case forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text -> Either Text LabelType
readEitherLabelType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Data.Text.drop Int
1) forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
breakOn Text
":" Text
l of
    (Text
ln, Right LabelType
lt) -> forall a b. b -> Either a b
Right (Text
ln, LabelType
lt)
    (Text
_, Left Text
e) -> forall a b. a -> Either a b
Left (Text -> FilePath
unpack Text
e)