{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

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

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

import qualified Hadolint.Lint as Lint
import qualified Hadolint.Rules as Rules

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"

-- | 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 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))
    -- | Applies the configuration found in the file to the passed Lint.LintOptions
    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
    -- | Converts a list of TrustedRegistry to a RulesConfig record
    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
          ]