{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Hadolint.Config (applyConfig, ConfigFile (..), OverrideConfig (..)) where
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.Rules as Rules
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)
data ConfigFile = ConfigFile
{ ConfigFile -> Maybe OverrideConfig
overrideRules :: Maybe OverrideConfig,
ConfigFile -> Maybe [ErrorRule]
ignoredRules :: Maybe [Lint.IgnoreRule],
ConfigFile -> Maybe [ErrorRule]
trustedRegistries :: Maybe [Lint.TrustedRegistry]
}
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 -> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> OverrideConfig
OverrideConfig
(Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> OverrideConfig)
-> Parser (Maybe [ErrorRule])
-> Parser
(Maybe [ErrorRule]
-> Maybe [ErrorRule] -> Maybe [ErrorRule] -> OverrideConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Pos
m Mapping Pos -> ErrorRule -> Parser (Maybe [ErrorRule])
forall a.
FromYAML a =>
Mapping Pos -> ErrorRule -> Parser (Maybe a)
.:? ErrorRule
"error"
Parser
(Maybe [ErrorRule]
-> Maybe [ErrorRule] -> Maybe [ErrorRule] -> OverrideConfig)
-> Parser (Maybe [ErrorRule])
-> Parser
(Maybe [ErrorRule] -> Maybe [ErrorRule] -> OverrideConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> ErrorRule -> Parser (Maybe [ErrorRule])
forall a.
FromYAML a =>
Mapping Pos -> ErrorRule -> Parser (Maybe a)
.:? ErrorRule
"warning"
Parser (Maybe [ErrorRule] -> Maybe [ErrorRule] -> OverrideConfig)
-> Parser (Maybe [ErrorRule])
-> Parser (Maybe [ErrorRule] -> OverrideConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> ErrorRule -> Parser (Maybe [ErrorRule])
forall a.
FromYAML a =>
Mapping Pos -> ErrorRule -> Parser (Maybe a)
.:? ErrorRule
"info"
Parser (Maybe [ErrorRule] -> OverrideConfig)
-> Parser (Maybe [ErrorRule]) -> Parser OverrideConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> ErrorRule -> Parser (Maybe [ErrorRule])
forall a.
FromYAML a =>
Mapping Pos -> ErrorRule -> Parser (Maybe a)
.:? ErrorRule
"style"
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 ->
Maybe OverrideConfig
-> Maybe [ErrorRule] -> Maybe [ErrorRule] -> ConfigFile
ConfigFile
(Maybe OverrideConfig
-> Maybe [ErrorRule] -> Maybe [ErrorRule] -> ConfigFile)
-> Parser (Maybe OverrideConfig)
-> Parser (Maybe [ErrorRule] -> Maybe [ErrorRule] -> ConfigFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Pos
m Mapping Pos -> ErrorRule -> Parser (Maybe OverrideConfig)
forall a.
FromYAML a =>
Mapping Pos -> ErrorRule -> Parser (Maybe a)
.:? ErrorRule
"override"
Parser (Maybe [ErrorRule] -> Maybe [ErrorRule] -> ConfigFile)
-> Parser (Maybe [ErrorRule])
-> Parser (Maybe [ErrorRule] -> ConfigFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> ErrorRule -> Parser (Maybe [ErrorRule])
forall a.
FromYAML a =>
Mapping Pos -> ErrorRule -> Parser (Maybe a)
.:? ErrorRule
"ignored"
Parser (Maybe [ErrorRule] -> ConfigFile)
-> Parser (Maybe [ErrorRule]) -> Parser ConfigFile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> ErrorRule -> Parser (Maybe [ErrorRule])
forall a.
FromYAML a =>
Mapping Pos -> ErrorRule -> Parser (Maybe a)
.:? ErrorRule
"trustedRegistries"
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
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
Maybe String
theConfig <-
case Maybe String
maybeConfig of
Maybe String
Nothing -> IO (Maybe String)
findConfig
Maybe String
c -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
c
case Maybe String
theConfig 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
findConfig :: IO (Maybe String)
findConfig = do
String
localConfigFile <- (String -> ShowS
</> String
".hadolint.yaml") ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getCurrentDirectory
String
configFile <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgConfig String
"hadolint.yaml"
[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
localConfigFile, String
configFile]
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
case ByteString -> Either (Pos, String) ConfigFile
forall v. FromYAML v => ByteString -> Either (Pos, String) v
Yaml.decode1Strict ByteString
contents of
Left (Pos
_, String
err) -> 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
$ String -> Either String LintOptions
forall a b. a -> Either a b
Left (String -> ShowS
formatError String
err String
configFile)
Right (ConfigFile Maybe OverrideConfig
Nothing Maybe [ErrorRule]
ignore Maybe [ErrorRule]
trusted) ->
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
$
LintOptions -> Either String LintOptions
forall a b. b -> Either a b
Right (Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> LintOptions
forall a.
Coercible a [Registry] =>
Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe a
-> LintOptions
applyOverride 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 Maybe [ErrorRule]
ignore Maybe [ErrorRule]
trusted)
Right (ConfigFile (Just (OverrideConfig Maybe [ErrorRule]
errors Maybe [ErrorRule]
warnings Maybe [ErrorRule]
infos Maybe [ErrorRule]
styles)) Maybe [ErrorRule]
ignore Maybe [ErrorRule]
trusted) ->
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
$
LintOptions -> Either String LintOptions
forall a b. b -> Either a b
Right (Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> LintOptions
forall a.
Coercible a [Registry] =>
Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe a
-> LintOptions
applyOverride Maybe [ErrorRule]
errors Maybe [ErrorRule]
warnings Maybe [ErrorRule]
infos Maybe [ErrorRule]
styles Maybe [ErrorRule]
ignore Maybe [ErrorRule]
trusted)
applyOverride :: Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe [ErrorRule]
-> Maybe a
-> LintOptions
applyOverride Maybe [ErrorRule]
errors Maybe [ErrorRule]
warnings Maybe [ErrorRule]
infos Maybe [ErrorRule]
styles Maybe [ErrorRule]
ignore Maybe a
trusted =
Maybe a -> LintOptions -> LintOptions
forall a.
Coercible a [Registry] =>
Maybe a -> LintOptions -> LintOptions
applyTrusted Maybe a
trusted
(LintOptions -> LintOptions)
-> (LintOptions -> LintOptions) -> LintOptions -> LintOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [ErrorRule] -> LintOptions -> LintOptions
applyIgnore Maybe [ErrorRule]
ignore
(LintOptions -> LintOptions)
-> (LintOptions -> LintOptions) -> LintOptions -> LintOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [ErrorRule] -> LintOptions -> LintOptions
applyStyles Maybe [ErrorRule]
styles
(LintOptions -> LintOptions)
-> (LintOptions -> LintOptions) -> LintOptions -> LintOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [ErrorRule] -> LintOptions -> LintOptions
applyInfos Maybe [ErrorRule]
infos
(LintOptions -> LintOptions)
-> (LintOptions -> LintOptions) -> LintOptions -> LintOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [ErrorRule] -> LintOptions -> LintOptions
applyWarnings Maybe [ErrorRule]
warnings
(LintOptions -> LintOptions)
-> (LintOptions -> LintOptions) -> LintOptions -> LintOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [ErrorRule] -> LintOptions -> LintOptions
applyErrors Maybe [ErrorRule]
errors
(LintOptions -> LintOptions) -> LintOptions -> LintOptions
forall a b. (a -> b) -> a -> b
$ LintOptions
o
applyErrors :: Maybe [ErrorRule] -> LintOptions -> LintOptions
applyErrors Maybe [ErrorRule]
errors LintOptions
opts =
case LintOptions -> [ErrorRule]
Lint.errorRules LintOptions
opts of
[] -> LintOptions
opts {errorRules :: [ErrorRule]
Lint.errorRules = [ErrorRule] -> Maybe [ErrorRule] -> [ErrorRule]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ErrorRule]
errors}
[ErrorRule]
_ -> LintOptions
opts
applyWarnings :: Maybe [ErrorRule] -> LintOptions -> LintOptions
applyWarnings Maybe [ErrorRule]
warnings LintOptions
opts =
case LintOptions -> [ErrorRule]
Lint.warningRules LintOptions
opts of
[] -> LintOptions
opts {warningRules :: [ErrorRule]
Lint.warningRules = [ErrorRule] -> Maybe [ErrorRule] -> [ErrorRule]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ErrorRule]
warnings}
[ErrorRule]
_ -> LintOptions
opts
applyInfos :: Maybe [ErrorRule] -> LintOptions -> LintOptions
applyInfos Maybe [ErrorRule]
infos LintOptions
opts =
case LintOptions -> [ErrorRule]
Lint.infoRules LintOptions
opts of
[] -> LintOptions
opts {infoRules :: [ErrorRule]
Lint.infoRules = [ErrorRule] -> Maybe [ErrorRule] -> [ErrorRule]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ErrorRule]
infos}
[ErrorRule]
_ -> LintOptions
opts
applyStyles :: Maybe [ErrorRule] -> LintOptions -> LintOptions
applyStyles Maybe [ErrorRule]
styles LintOptions
opts =
case LintOptions -> [ErrorRule]
Lint.styleRules LintOptions
opts of
[] -> LintOptions
opts {styleRules :: [ErrorRule]
Lint.styleRules = [ErrorRule] -> Maybe [ErrorRule] -> [ErrorRule]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ErrorRule]
styles}
[ErrorRule]
_ -> LintOptions
opts
applyIgnore :: Maybe [ErrorRule] -> LintOptions -> LintOptions
applyIgnore Maybe [ErrorRule]
ignore LintOptions
opts =
case LintOptions -> [ErrorRule]
Lint.ignoreRules LintOptions
opts of
[] -> LintOptions
opts {ignoreRules :: [ErrorRule]
Lint.ignoreRules = [ErrorRule] -> Maybe [ErrorRule] -> [ErrorRule]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ErrorRule]
ignore}
[ErrorRule]
_ -> LintOptions
opts
applyTrusted :: Maybe a -> LintOptions -> LintOptions
applyTrusted Maybe a
trusted LintOptions
opts
| Set Registry -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RulesConfig -> Set Registry
Rules.allowedRegistries (LintOptions -> RulesConfig
Lint.rulesConfig LintOptions
opts)) =
LintOptions
opts {rulesConfig :: RulesConfig
Lint.rulesConfig = Maybe a -> RulesConfig
forall a. Coercible a [Registry] => Maybe a -> RulesConfig
toRules Maybe a
trusted RulesConfig -> RulesConfig -> RulesConfig
forall a. Semigroup a => a -> a -> a
<> LintOptions -> RulesConfig
Lint.rulesConfig LintOptions
opts}
| Bool
otherwise = LintOptions
opts
toRules :: Maybe a -> RulesConfig
toRules (Just a
trusted) = Set Registry -> RulesConfig
Rules.RulesConfig ([Registry] -> Set Registry
forall a. Ord a => [a] -> Set a
Set.fromList ([Registry] -> Set Registry)
-> (a -> [Registry]) -> a -> Set Registry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Registry]
coerce (a -> Set Registry) -> a -> Set Registry
forall a b. (a -> b) -> a -> b
$ a
trusted)
toRules Maybe a
_ = RulesConfig
forall a. Monoid a => a
mempty
formatError :: String -> ShowS
formatError String
err String
config =
[String] -> String
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
"allowedRegistries:",
String
"\t- docker.io",
String
"\t- my-company.com",
String
"",
String
err
]