{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Hadolint.Config (applyConfig, ConfigFile (..)) 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 ConfigFile = ConfigFile
{ ConfigFile -> Maybe [IgnoreRule]
ignoredRules :: Maybe [Lint.IgnoreRule],
ConfigFile -> Maybe [IgnoreRule]
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 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 "ConfigFile" ((Mapping Pos -> Parser ConfigFile)
-> Node Pos -> Parser ConfigFile)
-> (Mapping Pos -> Parser ConfigFile)
-> Node Pos
-> Parser ConfigFile
forall a b. (a -> b) -> a -> b
$ \m :: Mapping Pos
m ->
Maybe [IgnoreRule] -> Maybe [IgnoreRule] -> ConfigFile
ConfigFile
(Maybe [IgnoreRule] -> Maybe [IgnoreRule] -> ConfigFile)
-> Parser (Maybe [IgnoreRule])
-> Parser (Maybe [IgnoreRule] -> ConfigFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Pos
m Mapping Pos -> IgnoreRule -> Parser (Maybe [IgnoreRule])
forall a.
FromYAML a =>
Mapping Pos -> IgnoreRule -> Parser (Maybe a)
.:? "ignored"
Parser (Maybe [IgnoreRule] -> ConfigFile)
-> Parser (Maybe [IgnoreRule]) -> Parser ConfigFile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> IgnoreRule -> Parser (Maybe [IgnoreRule])
forall a.
FromYAML a =>
Mapping Pos -> IgnoreRule -> Parser (Maybe a)
.:? "trustedRegistries"
applyConfig :: Maybe FilePath -> Lint.LintOptions -> IO (Either String Lint.LintOptions)
applyConfig :: Maybe String -> LintOptions -> IO (Either String LintOptions)
applyConfig maybeConfig :: Maybe String
maybeConfig o :: LintOptions
o
| Bool -> Bool
not ([IgnoreRule] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LintOptions -> [IgnoreRule]
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
Nothing -> IO (Maybe String)
findConfig
c :: 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
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 config :: String
config -> String -> IO (Either String LintOptions)
parseAndApply String
config
where
findConfig :: IO (Maybe String)
findConfig = do
String
localConfigFile <- (String -> ShowS
</> ".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 "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 configFile :: 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 (_, err :: 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 ignore :: Maybe [IgnoreRule]
ignore trusted :: Maybe [IgnoreRule]
trusted) -> 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 (Maybe [IgnoreRule] -> Maybe [IgnoreRule] -> LintOptions
forall a.
Coercible a [Registry] =>
Maybe [IgnoreRule] -> Maybe a -> LintOptions
override Maybe [IgnoreRule]
ignore Maybe [IgnoreRule]
trusted))
override :: Maybe [IgnoreRule] -> Maybe a -> LintOptions
override ignore :: Maybe [IgnoreRule]
ignore trusted :: 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 [IgnoreRule] -> LintOptions -> LintOptions
applyIgnore Maybe [IgnoreRule]
ignore (LintOptions -> LintOptions) -> LintOptions -> LintOptions
forall a b. (a -> b) -> a -> b
$ LintOptions
o
applyIgnore :: Maybe [IgnoreRule] -> LintOptions -> LintOptions
applyIgnore ignore :: Maybe [IgnoreRule]
ignore opts :: LintOptions
opts =
case LintOptions -> [IgnoreRule]
Lint.ignoreRules LintOptions
opts of
[] -> LintOptions
opts {ignoreRules :: [IgnoreRule]
Lint.ignoreRules = [IgnoreRule] -> Maybe [IgnoreRule] -> [IgnoreRule]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [IgnoreRule]
ignore}
_ -> LintOptions
opts
applyTrusted :: Maybe a -> LintOptions -> LintOptions
applyTrusted trusted :: Maybe a
trusted opts :: 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 trusted :: 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]
forall a b. Coercible a b => a -> b
coerce (a -> Set Registry) -> a -> Set Registry
forall a b. (a -> b) -> a -> b
$ a
trusted)
toRules _ = RulesConfig
forall a. Monoid a => a
mempty
formatError :: String -> ShowS
formatError err :: String
err config :: String
config =
[String] -> String
unlines
[ "Error parsing your config file in '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
config String -> ShowS
forall a. [a] -> [a] -> [a]
++ "':",
"It should contain one of the keys 'ignored' or 'trustedRegistries'. For example:\n",
"ignored:",
"\t- DL3000",
"\t- SC1099\n\n",
"The key 'trustedRegistries' should contain the names of the allowed docker registries:\n",
"allowedRegistries:",
"\t- docker.io",
"\t- my-company.com",
"",
String
err
]