module Hadolint.Config
  ( applyConfig,
    getConfig,
    ConfigFile (..),
    OverrideConfig (..),
  )
where

import Control.Applicative ((<|>))
import qualified Control.Foldl.Text as Text
import Control.Monad (filterM)
import qualified Data.ByteString as Bytes
import Data.Coerce (coerce)
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.Set as Set
import Data.YAML ((.:?))
import qualified Data.YAML as Yaml
import GHC.Generics (Generic)
import qualified Hadolint.Lint as Lint
import qualified Hadolint.Process as Process
import qualified Hadolint.Rule as Rule
import qualified Language.Docker as Docker
import System.Directory
  ( XdgDirectory (..),
    doesFileExist,
    getCurrentDirectory,
    getXdgDirectory,
  )
import System.FilePath ((</>))

data OverrideConfig = OverrideConfig
  { OverrideConfig -> Maybe [ErrorRule]
overrideErrorRules :: Maybe [Lint.ErrorRule],
    OverrideConfig -> Maybe [ErrorRule]
overrideWarningRules :: Maybe [Lint.WarningRule],
    OverrideConfig -> Maybe [ErrorRule]
overrideInfoRules :: Maybe [Lint.InfoRule],
    OverrideConfig -> Maybe [ErrorRule]
overrideStyleRules :: Maybe [Lint.StyleRule]
  }
  deriving (Int -> OverrideConfig -> ShowS
[OverrideConfig] -> ShowS
OverrideConfig -> String
(Int -> OverrideConfig -> ShowS)
-> (OverrideConfig -> String)
-> ([OverrideConfig] -> ShowS)
-> Show OverrideConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OverrideConfig] -> ShowS
$cshowList :: [OverrideConfig] -> ShowS
show :: OverrideConfig -> String
$cshow :: OverrideConfig -> String
showsPrec :: Int -> OverrideConfig -> ShowS
$cshowsPrec :: Int -> OverrideConfig -> ShowS
Show, OverrideConfig -> OverrideConfig -> Bool
(OverrideConfig -> OverrideConfig -> Bool)
-> (OverrideConfig -> OverrideConfig -> Bool) -> Eq OverrideConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverrideConfig -> OverrideConfig -> Bool
$c/= :: OverrideConfig -> OverrideConfig -> Bool
== :: OverrideConfig -> OverrideConfig -> Bool
$c== :: OverrideConfig -> OverrideConfig -> Bool
Eq, (forall x. OverrideConfig -> Rep OverrideConfig x)
-> (forall x. Rep OverrideConfig x -> OverrideConfig)
-> Generic OverrideConfig
forall x. Rep OverrideConfig x -> OverrideConfig
forall x. OverrideConfig -> Rep OverrideConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OverrideConfig x -> OverrideConfig
$cfrom :: forall x. OverrideConfig -> Rep OverrideConfig x
Generic)

instance Semigroup OverrideConfig where
  OverrideConfig Maybe [ErrorRule]
a1 Maybe [ErrorRule]
a2 Maybe [ErrorRule]
a3 Maybe [ErrorRule]
a4 <> :: OverrideConfig -> OverrideConfig -> OverrideConfig
<> OverrideConfig Maybe [ErrorRule]
b1 Maybe [ErrorRule]
b2 Maybe [ErrorRule]
b3 Maybe [ErrorRule]
b4 =
    Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> OverrideConfig
OverrideConfig (Maybe [ErrorRule]
a1 Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> Maybe [ErrorRule]
b1) (Maybe [ErrorRule]
a2 Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> Maybe [ErrorRule]
b2) (Maybe [ErrorRule]
a3 Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> Maybe [ErrorRule]
b3) (Maybe [ErrorRule]
a4 Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall a. Semigroup a => a -> a -> a
<> Maybe [ErrorRule]
b4)

instance Monoid OverrideConfig where
  mempty :: OverrideConfig
mempty = Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> OverrideConfig
OverrideConfig Maybe [ErrorRule]
forall a. Maybe a
Nothing Maybe [ErrorRule]
forall a. Maybe a
Nothing Maybe [ErrorRule]
forall a. Maybe a
Nothing Maybe [ErrorRule]
forall a. Maybe a
Nothing

data ConfigFile = ConfigFile
  { ConfigFile -> Maybe OverrideConfig
overrideRules :: Maybe OverrideConfig,
    ConfigFile -> Maybe [ErrorRule]
ignoredRules :: Maybe [Lint.IgnoreRule],
    ConfigFile -> Maybe [TrustedRegistry]
trustedRegistries :: Maybe [Lint.TrustedRegistry],
    ConfigFile -> Maybe LabelSchema
labelSchemaConfig :: Maybe Rule.LabelSchema,
    ConfigFile -> Maybe Bool
strictLabelSchema :: Maybe Bool,
    ConfigFile -> Maybe DLSeverity
failureThreshold :: Maybe Rule.DLSeverity
  }
  deriving (Int -> ConfigFile -> ShowS
[ConfigFile] -> ShowS
ConfigFile -> String
(Int -> ConfigFile -> ShowS)
-> (ConfigFile -> String)
-> ([ConfigFile] -> ShowS)
-> Show ConfigFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigFile] -> ShowS
$cshowList :: [ConfigFile] -> ShowS
show :: ConfigFile -> String
$cshow :: ConfigFile -> String
showsPrec :: Int -> ConfigFile -> ShowS
$cshowsPrec :: Int -> ConfigFile -> ShowS
Show, ConfigFile -> ConfigFile -> Bool
(ConfigFile -> ConfigFile -> Bool)
-> (ConfigFile -> ConfigFile -> Bool) -> Eq ConfigFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigFile -> ConfigFile -> Bool
$c/= :: ConfigFile -> ConfigFile -> Bool
== :: ConfigFile -> ConfigFile -> Bool
$c== :: ConfigFile -> ConfigFile -> Bool
Eq, (forall x. ConfigFile -> Rep ConfigFile x)
-> (forall x. Rep ConfigFile x -> ConfigFile) -> Generic ConfigFile
forall x. Rep ConfigFile x -> ConfigFile
forall x. ConfigFile -> Rep ConfigFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigFile x -> ConfigFile
$cfrom :: forall x. ConfigFile -> Rep ConfigFile x
Generic)

instance Yaml.FromYAML OverrideConfig where
  parseYAML :: Node Pos -> Parser OverrideConfig
parseYAML = String
-> (Mapping Pos -> Parser OverrideConfig)
-> Node Pos
-> Parser OverrideConfig
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
Yaml.withMap String
"OverrideConfig" ((Mapping Pos -> Parser OverrideConfig)
 -> Node Pos -> Parser OverrideConfig)
-> (Mapping Pos -> Parser OverrideConfig)
-> Node Pos
-> Parser OverrideConfig
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> do
    Maybe [TrustedRegistry]
err <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe [TrustedRegistry])
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"error"
    Maybe [TrustedRegistry]
wrn <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe [TrustedRegistry])
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"warning"
    Maybe [TrustedRegistry]
inf <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe [TrustedRegistry])
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"info"
    Maybe [TrustedRegistry]
sty <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe [TrustedRegistry])
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"style"
    let overrideErrorRules :: Maybe [ErrorRule]
overrideErrorRules = Maybe [TrustedRegistry] -> Maybe [ErrorRule]
coerce (Maybe [TrustedRegistry]
err :: Maybe [Text.Text])
        overrideWarningRules :: Maybe [ErrorRule]
overrideWarningRules = Maybe [TrustedRegistry] -> Maybe [ErrorRule]
coerce (Maybe [TrustedRegistry]
wrn :: Maybe [Text.Text])
        overrideInfoRules :: Maybe [ErrorRule]
overrideInfoRules = Maybe [TrustedRegistry] -> Maybe [ErrorRule]
coerce (Maybe [TrustedRegistry]
inf :: Maybe [Text.Text])
        overrideStyleRules :: Maybe [ErrorRule]
overrideStyleRules = Maybe [TrustedRegistry] -> Maybe [ErrorRule]
coerce (Maybe [TrustedRegistry]
sty:: Maybe [Text.Text])
    OverrideConfig -> Parser OverrideConfig
forall (m :: * -> *) a. Monad m => a -> m a
return OverrideConfig :: Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> OverrideConfig
OverrideConfig {Maybe [ErrorRule]
overrideStyleRules :: Maybe [ErrorRule]
overrideInfoRules :: Maybe [ErrorRule]
overrideWarningRules :: Maybe [ErrorRule]
overrideErrorRules :: Maybe [ErrorRule]
overrideStyleRules :: Maybe [ErrorRule]
overrideInfoRules :: Maybe [ErrorRule]
overrideWarningRules :: Maybe [ErrorRule]
overrideErrorRules :: Maybe [ErrorRule]
..}

instance Yaml.FromYAML ConfigFile where
  parseYAML :: Node Pos -> Parser ConfigFile
parseYAML = String
-> (Mapping Pos -> Parser ConfigFile)
-> Node Pos
-> Parser ConfigFile
forall a.
String -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
Yaml.withMap String
"ConfigFile" ((Mapping Pos -> Parser ConfigFile)
 -> Node Pos -> Parser ConfigFile)
-> (Mapping Pos -> Parser ConfigFile)
-> Node Pos
-> Parser ConfigFile
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> do
    Maybe OverrideConfig
overrideRules <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe OverrideConfig)
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"override"
    Maybe [TrustedRegistry]
ignored <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe [TrustedRegistry])
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"ignored"
    let ignoredRules :: Maybe [ErrorRule]
ignoredRules = Maybe [TrustedRegistry] -> Maybe [ErrorRule]
coerce (Maybe [TrustedRegistry]
ignored :: Maybe [Text.Text])
    Maybe [TrustedRegistry]
trustedRegistries <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe [TrustedRegistry])
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"trustedRegistries"
    Maybe LabelSchema
labelSchemaConfig <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe LabelSchema)
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"label-schema"
    Maybe Bool
strictLabelSchema <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe Bool)
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"strict-labels"
    Maybe DLSeverity
failureThreshold <- Mapping Pos
m Mapping Pos -> TrustedRegistry -> Parser (Maybe DLSeverity)
forall a.
FromYAML a =>
Mapping Pos -> TrustedRegistry -> Parser (Maybe a)
.:? TrustedRegistry
"failure-threshold"
    ConfigFile -> Parser ConfigFile
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigFile :: Maybe OverrideConfig
-> Maybe [ErrorRule]
-> Maybe [TrustedRegistry]
-> Maybe LabelSchema
-> Maybe Bool
-> Maybe DLSeverity
-> ConfigFile
ConfigFile {Maybe Bool
Maybe [TrustedRegistry]
Maybe [ErrorRule]
Maybe LabelSchema
Maybe DLSeverity
Maybe OverrideConfig
failureThreshold :: Maybe DLSeverity
strictLabelSchema :: Maybe Bool
labelSchemaConfig :: Maybe LabelSchema
trustedRegistries :: Maybe [TrustedRegistry]
ignoredRules :: Maybe [ErrorRule]
overrideRules :: Maybe OverrideConfig
failureThreshold :: Maybe DLSeverity
strictLabelSchema :: Maybe Bool
labelSchemaConfig :: Maybe LabelSchema
trustedRegistries :: Maybe [TrustedRegistry]
ignoredRules :: Maybe [ErrorRule]
overrideRules :: Maybe OverrideConfig
..}

-- | If both the ignoreRules and rulesConfig properties of Lint options are empty
-- then this function will fill them with the default found in the passed config
-- file. If there is an error parsing the default config file, this function will
-- return the error string.
applyConfig :: Maybe FilePath -> Lint.LintOptions -> IO (Either String Lint.LintOptions)
applyConfig :: Maybe String -> LintOptions -> IO (Either String LintOptions)
applyConfig Maybe String
maybeConfig LintOptions
o
  | Bool -> Bool
not ([ErrorRule] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null (LintOptions -> [ErrorRule]
Lint.ignoreRules LintOptions
o)) Bool -> Bool -> Bool
&& LintOptions -> RulesConfig
Lint.rulesConfig LintOptions
o RulesConfig -> RulesConfig -> Bool
forall a. Eq a => a -> a -> Bool
/= RulesConfig
forall a. Monoid a => a
mempty = Either String LintOptions -> IO (Either String LintOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (LintOptions -> Either String LintOptions
forall a b. b -> Either a b
Right LintOptions
o)
  | Bool
otherwise = do
    case Maybe String
maybeConfig of
      Maybe String
Nothing -> Either String LintOptions -> IO (Either String LintOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (LintOptions -> Either String LintOptions
forall a b. b -> Either a b
Right LintOptions
o)
      Just String
config -> String -> IO (Either String LintOptions)
parseAndApply String
config
  where
    parseAndApply :: FilePath -> IO (Either String Lint.LintOptions)
    parseAndApply :: String -> IO (Either String LintOptions)
parseAndApply String
configFile = do
      ByteString
contents <- String -> IO ByteString
Bytes.readFile String
configFile
      Either String LintOptions -> IO (Either String LintOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String LintOptions -> IO (Either String LintOptions))
-> Either String LintOptions -> IO (Either String LintOptions)
forall a b. (a -> b) -> a -> b
$ case ByteString -> Either (Pos, String) ConfigFile
forall v. FromYAML v => ByteString -> Either (Pos, String) v
Yaml.decode1Strict ByteString
contents of
        Left (Pos
_, String
err) -> String -> Either String LintOptions
forall a b. a -> Either a b
Left (String -> ShowS
formatError String
err String
configFile)
        Right ConfigFile
config -> LintOptions -> Either String LintOptions
forall a b. b -> Either a b
Right (LintOptions -> Either String LintOptions)
-> LintOptions -> Either String LintOptions
forall a b. (a -> b) -> a -> b
$ LintOptions -> Maybe LintOptions -> LintOptions
forall a. a -> Maybe a -> a
fromMaybe LintOptions
o (ConfigFile -> Maybe LintOptions
applyOverride ConfigFile
config)

    applyOverride :: ConfigFile -> Maybe LintOptions
applyOverride ConfigFile {Maybe Bool
Maybe [TrustedRegistry]
Maybe [ErrorRule]
Maybe LabelSchema
Maybe DLSeverity
Maybe OverrideConfig
failureThreshold :: Maybe DLSeverity
strictLabelSchema :: Maybe Bool
labelSchemaConfig :: Maybe LabelSchema
trustedRegistries :: Maybe [TrustedRegistry]
ignoredRules :: Maybe [ErrorRule]
overrideRules :: Maybe OverrideConfig
failureThreshold :: ConfigFile -> Maybe DLSeverity
strictLabelSchema :: ConfigFile -> Maybe Bool
labelSchemaConfig :: ConfigFile -> Maybe LabelSchema
trustedRegistries :: ConfigFile -> Maybe [TrustedRegistry]
ignoredRules :: ConfigFile -> Maybe [ErrorRule]
overrideRules :: ConfigFile -> Maybe OverrideConfig
..} =
      -- Maybe.do
      do
        OverrideConfig {Maybe [ErrorRule]
overrideStyleRules :: Maybe [ErrorRule]
overrideInfoRules :: Maybe [ErrorRule]
overrideWarningRules :: Maybe [ErrorRule]
overrideErrorRules :: Maybe [ErrorRule]
overrideStyleRules :: OverrideConfig -> Maybe [ErrorRule]
overrideInfoRules :: OverrideConfig -> Maybe [ErrorRule]
overrideWarningRules :: OverrideConfig -> Maybe [ErrorRule]
overrideErrorRules :: OverrideConfig -> Maybe [ErrorRule]
..} <- Maybe OverrideConfig
overrideRules Maybe OverrideConfig
-> Maybe OverrideConfig -> Maybe OverrideConfig
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OverrideConfig -> Maybe OverrideConfig
forall a. a -> Maybe a
Just OverrideConfig
forall a. Monoid a => a
mempty
        [ErrorRule]
overrideError <- Maybe [ErrorRule]
overrideErrorRules Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule] -> Maybe [ErrorRule]
forall a. a -> Maybe a
Just [ErrorRule]
forall a. Monoid a => a
mempty
        [ErrorRule]
overrideWarning <- Maybe [ErrorRule]
overrideWarningRules Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule] -> Maybe [ErrorRule]
forall a. a -> Maybe a
Just [ErrorRule]
forall a. Monoid a => a
mempty
        [ErrorRule]
overrideInfo <- Maybe [ErrorRule]
overrideInfoRules Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule] -> Maybe [ErrorRule]
forall a. a -> Maybe a
Just [ErrorRule]
forall a. Monoid a => a
mempty
        [ErrorRule]
overrideStyle <- Maybe [ErrorRule]
overrideStyleRules Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule] -> Maybe [ErrorRule]
forall a. a -> Maybe a
Just [ErrorRule]
forall a. Monoid a => a
mempty
        [ErrorRule]
overrideIgnored <- Maybe [ErrorRule]
ignoredRules Maybe [ErrorRule] -> Maybe [ErrorRule] -> Maybe [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule] -> Maybe [ErrorRule]
forall a. a -> Maybe a
Just [ErrorRule]
forall a. Monoid a => a
mempty
        DLSeverity
overrideThreshold <- Maybe DLSeverity
failureThreshold Maybe DLSeverity -> Maybe DLSeverity -> Maybe DLSeverity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DLSeverity -> Maybe DLSeverity
forall a. a -> Maybe a
Just DLSeverity
forall a. Monoid a => a
mempty

        Set Registry
trusted <- [Registry] -> Set Registry
forall a. Ord a => [a] -> Set a
Set.fromList ([Registry] -> Set Registry)
-> ([TrustedRegistry] -> [Registry])
-> [TrustedRegistry]
-> Set Registry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TrustedRegistry] -> [Registry]
coerce ([TrustedRegistry] -> Set Registry)
-> Maybe [TrustedRegistry] -> Maybe (Set Registry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe [TrustedRegistry]
trustedRegistries Maybe [TrustedRegistry]
-> Maybe [TrustedRegistry] -> Maybe [TrustedRegistry]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [TrustedRegistry] -> Maybe [TrustedRegistry]
forall a. a -> Maybe a
Just [TrustedRegistry]
forall a. Monoid a => a
mempty)
        LabelSchema
schema <- Maybe LabelSchema
labelSchemaConfig Maybe LabelSchema -> Maybe LabelSchema -> Maybe LabelSchema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LabelSchema -> Maybe LabelSchema
forall a. a -> Maybe a
Just LabelSchema
forall a. Monoid a => a
mempty
        Bool
strictLabels <- Maybe Bool
strictLabelSchema Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False

        let rulesConfig :: RulesConfig
rulesConfig = LintOptions -> RulesConfig
Lint.rulesConfig LintOptions
o

        LintOptions -> Maybe LintOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (LintOptions -> Maybe LintOptions)
-> LintOptions -> Maybe LintOptions
forall a b. (a -> b) -> a -> b
$
          LintOptions :: [ErrorRule]
-> [ErrorRule]
-> [ErrorRule]
-> [ErrorRule]
-> [ErrorRule]
-> RulesConfig
-> DLSeverity
-> LintOptions
Lint.LintOptions
            { errorRules :: [ErrorRule]
Lint.errorRules = LintOptions -> [ErrorRule]
Lint.errorRules LintOptions
o [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule]
overrideError,
              warningRules :: [ErrorRule]
Lint.warningRules = LintOptions -> [ErrorRule]
Lint.warningRules LintOptions
o [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule]
overrideWarning,
              infoRules :: [ErrorRule]
Lint.infoRules = LintOptions -> [ErrorRule]
Lint.infoRules LintOptions
o [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule]
overrideInfo,
              styleRules :: [ErrorRule]
Lint.styleRules = LintOptions -> [ErrorRule]
Lint.styleRules LintOptions
o [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule]
overrideStyle,
              ignoreRules :: [ErrorRule]
Lint.ignoreRules = LintOptions -> [ErrorRule]
Lint.ignoreRules LintOptions
o [ErrorRule] -> [ErrorRule] -> [ErrorRule]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ErrorRule]
overrideIgnored,
              rulesConfig :: RulesConfig
Lint.rulesConfig =
                RulesConfig :: Set Registry -> LabelSchema -> Bool -> RulesConfig
Process.RulesConfig
                  { allowedRegistries :: Set Registry
Process.allowedRegistries = RulesConfig -> Set Registry
Process.allowedRegistries RulesConfig
rulesConfig Set Registry -> Set Registry -> Set Registry
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
`ifNull` Set Registry
trusted,
                    labelSchema :: LabelSchema
Process.labelSchema = RulesConfig -> LabelSchema
Process.labelSchema RulesConfig
rulesConfig LabelSchema -> LabelSchema -> LabelSchema
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
`ifNull` LabelSchema
schema,
                    strictLabels :: Bool
Process.strictLabels = RulesConfig -> Bool
Process.strictLabels RulesConfig
rulesConfig Bool -> Bool -> Bool
|| Bool
strictLabels
                  },
            failThreshold :: DLSeverity
Lint.failThreshold = LintOptions -> DLSeverity
Lint.failThreshold LintOptions
o DLSeverity -> DLSeverity -> DLSeverity
forall a. Semigroup a => a -> a -> a
<> DLSeverity
overrideThreshold
            }

    ifNull :: t a -> t a -> t a
ifNull t a
value t a
override = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
value then t a
override else t a
value

    formatError :: String -> ShowS
formatError String
err String
config =
      [String] -> String
Prelude.unlines
        [ String
"Error parsing your config file in  '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
config String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"':",
          String
"It should contain one of the keys 'override', 'ignored'",
          String
"or 'trustedRegistries'. For example:\n",
          String
"ignored:",
          String
"\t- DL3000",
          String
"\t- SC1099\n\n",
          String
"The key 'override' should contain only lists with names 'error',",
          String
"'warning', 'info' or 'style', which each name rules to override the",
          String
"severity on. For example:\n",
          String
"override:",
          String
"\terror:",
          String
"\t\t- DL3008\n\n",
          String
"The key 'trustedRegistries' should contain the names of the allowed docker registries:\n",
          String
"trustedRegistries:",
          String
"\t- docker.io",
          String
"\t- my-company.com",
          String
"",
          String
err
        ]

-- | Gets the configuration file which Hadolint uses
getConfig :: Maybe FilePath -> IO (Maybe FilePath)
getConfig :: Maybe String -> IO (Maybe String)
getConfig Maybe String
maybeConfig =
  case Maybe String
maybeConfig of
    Maybe String
Nothing -> IO (Maybe String)
findConfig
    Maybe String
_ -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
maybeConfig
  where
    findConfig :: IO (Maybe FilePath)
    findConfig :: IO (Maybe String)
findConfig = do
      [String]
localConfigFiles <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                            (\String
filePath -> (String -> ShowS
</> String
filePath) ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getCurrentDirectory)
                            (ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"."String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
acceptedConfigs)
      [String]
configFiles <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig) [String]
acceptedConfigs
      [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String) -> IO [String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist ([String]
localConfigFiles [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
configFiles)
      where
        acceptedConfigs :: [String]
acceptedConfigs = [String
"hadolint.yaml", String
"hadolint.yml"]