module Hadolint.Config.Configfile
  ( getConfigFromFile
  )
where

import Control.Monad (when, filterM)
import Data.Maybe (listToMaybe)
import Data.YAML as Yaml
import qualified Data.ByteString as Bytes
import Hadolint.Config.Configuration (PartialConfiguration (..))
import System.Directory
  ( XdgDirectory (..),
    doesFileExist,
    getCurrentDirectory,
    getAppUserDataDirectory,
    getUserDocumentsDirectory,
    getXdgDirectory,
  )
import System.FilePath ((</>))
import System.IO (hPrint, stderr)


getConfigFromFile ::
  Maybe FilePath -> Bool -> IO (Either String PartialConfiguration)
getConfigFromFile :: Maybe FilePath -> Bool -> IO (Either FilePath PartialConfiguration)
getConfigFromFile Maybe FilePath
maybeExplicitPath Bool
verbose = do
  Maybe FilePath
maybePath <- Maybe FilePath -> IO (Maybe FilePath)
getConfig Maybe FilePath
maybeExplicitPath
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose forall a b. (a -> b) -> a -> b
$ forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> FilePath
getFilePathDescription Maybe FilePath
maybePath
  case Maybe FilePath
maybePath of
    Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
    Just FilePath
path -> FilePath -> IO (Either FilePath PartialConfiguration)
readConfig FilePath
path

readConfig :: FilePath -> IO (Either String PartialConfiguration)
readConfig :: FilePath -> IO (Either FilePath PartialConfiguration)
readConfig FilePath
path = do
  ByteString
contents <- FilePath -> IO ByteString
Bytes.readFile FilePath
path
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall v. FromYAML v => ByteString -> Either (Pos, FilePath) v
Yaml.decode1Strict ByteString
contents of
    Left (Pos
_, FilePath
err) -> forall a b. a -> Either a b
Left (FilePath -> FilePath -> FilePath
formatError FilePath
err FilePath
path)
    Right PartialConfiguration
config -> forall a b. b -> Either a b
Right PartialConfiguration
config

getFilePathDescription :: Maybe FilePath -> String
getFilePathDescription :: Maybe FilePath -> FilePath
getFilePathDescription Maybe FilePath
Nothing =
  FilePath
"No configuration was specified. Using default configuration"
getFilePathDescription (Just FilePath
filepath) = FilePath
"Configuration file used: " forall a. [a] -> [a] -> [a]
++ FilePath
filepath

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

-- | Gets the configuration file which Hadolint uses
getConfig :: Maybe FilePath -> IO (Maybe FilePath)
getConfig :: Maybe FilePath -> IO (Maybe FilePath)
getConfig Maybe FilePath
maybeConfig =
  case Maybe FilePath
maybeConfig of
    Maybe FilePath
Nothing -> IO (Maybe FilePath)
findConfig
    Maybe FilePath
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
maybeConfig

-- | If no configuration file path was given on the command line, Hadolint
-- searches these locations or their equivalents on MacOS/Windows:
--  - $(pwd)/.hadolint.{yaml|yml}
--  - $HOME/.config/hadolint.{yaml|yml}
--  - $HOME/.hadolint/{hadolint|config}.{yaml|yml}
--  - $HOME/.hadolint.{yaml|yml}
-- The first file found is used, all other are ignored.
findConfig :: IO (Maybe FilePath)
findConfig :: IO (Maybe FilePath)
findConfig = do
  [FilePath]
filesInCWD <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                  (\FilePath
filePath -> (FilePath -> FilePath -> FilePath
</> FilePath
filePath) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory)
                  [FilePath]
hiddenConfigs
  [FilePath]
filesInXdgConfig <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig) [FilePath]
visibleConfigs
  [FilePath]
filesInAppData <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                      (\FilePath
fp -> (FilePath -> FilePath -> FilePath
</> FilePath
fp) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"hadolint")
                      ([FilePath]
visibleConfigs forall a. Semigroup a => a -> a -> a
<> [FilePath]
moreConfigs)
  [FilePath]
filesInHome <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                   (\FilePath
fp -> (FilePath -> FilePath -> FilePath
</> FilePath
fp) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getUserDocumentsDirectory)
                   [FilePath]
hiddenConfigs
  forall a. [a] -> Maybe a
listToMaybe
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
          FilePath -> IO Bool
doesFileExist
          ([FilePath]
filesInCWD forall a. Semigroup a => a -> a -> a
<> [FilePath]
filesInXdgConfig forall a. Semigroup a => a -> a -> a
<> [FilePath]
filesInAppData forall a. Semigroup a => a -> a -> a
<> [FilePath]
filesInHome)
  where
    hiddenConfigs :: [FilePath]
hiddenConfigs = [FilePath
".hadolint.yaml", FilePath
".hadolint.yml"]
    visibleConfigs :: [FilePath]
visibleConfigs = [FilePath
"hadolint.yaml", FilePath
"hadolint.yml"]
    moreConfigs :: [FilePath]
moreConfigs = [FilePath
"config.yaml", FilePath
"config.yml"]