module Hadolint.Config.Environment
  ( getConfigFromEnvironment
  )
where

import Data.Char (toLower)
import Data.Coerce (coerce)
import Data.Map (empty, fromList)
import Data.Set (Set, empty, fromList)
import Data.Text (Text, pack, unpack, drop, splitOn, breakOn)
import Hadolint.Formatter.Format (OutputFormat (..), readMaybeOutputFormat)
import Hadolint.Config.Configuration
import Hadolint.Rule
import Language.Docker.Syntax
import System.Environment


getConfigFromEnvironment :: IO PartialConfiguration
getConfigFromEnvironment :: IO PartialConfiguration
getConfigFromEnvironment =
  Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe OutputFormat
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> [RuleCode]
-> Set Registry
-> LabelSchema
-> Maybe Bool
-> Maybe Bool
-> Maybe DLSeverity
-> PartialConfiguration
PartialConfiguration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe Bool)
maybeTruthy [Char]
"HADOLINT_NOFAIL"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Bool)
isSet [Char]
"NO_COLOR"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Bool)
maybeTruthy [Char]
"HADOLINT_VERBOSE"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Maybe OutputFormat)
getFormat
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO [RuleCode]
getOverrideList [Char]
"HADOLINT_OVERRIDE_ERROR"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO [RuleCode]
getOverrideList [Char]
"HADOLINT_OVERRIDE_WARNING"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO [RuleCode]
getOverrideList [Char]
"HADOLINT_OVERRIDE_INFO"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO [RuleCode]
getOverrideList [Char]
"HADOLINT_OVERRIDE_STYLE"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO [RuleCode]
getOverrideList [Char]
"HADOLINT_IGNORE"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Set Registry)
getAllowedSet [Char]
"HADOLINT_TRUSTED_REGISTRIES"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO LabelSchema
getLabelSchema [Char]
"HADOLINT_REQUIRE_LABELS"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Bool)
maybeTruthy [Char]
"HADOLINT_STRICT_LABELS"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> IO (Maybe Bool)
maybeTruthy [Char]
"HADOLINT_DISABLE_IGNORE_PRAGMA"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Maybe DLSeverity)
getFailureThreshold


isSet :: String -> IO (Maybe Bool)
isSet :: [Char] -> IO (Maybe Bool)
isSet [Char]
name = do
  Maybe [Char]
e <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
name
  case Maybe [Char]
e of
    Just [Char]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Bool
True
    Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

maybeTruthy :: String -> IO (Maybe Bool)
maybeTruthy :: [Char] -> IO (Maybe Bool)
maybeTruthy [Char]
name = do
  Maybe [Char]
e <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
name
  case Maybe [Char]
e of
    Just [Char]
v ->
      if [Char] -> Bool
truthy [Char]
v
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Bool
True
      else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Bool
False
    Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

truthy :: String -> Bool
truthy :: [Char] -> Bool
truthy [Char]
s = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"1", [Char]
"y", [Char]
"on", [Char]
"true", [Char]
"yes"]

getFormat :: IO (Maybe OutputFormat)
getFormat :: IO (Maybe OutputFormat)
getFormat = do
  Maybe [Char]
fmt <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"HADOLINT_FORMAT"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text -> Maybe OutputFormat
readMaybeOutputFormat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [Char]
fmt

getOverrideList :: String -> IO [RuleCode]
getOverrideList :: [Char] -> IO [RuleCode]
getOverrideList [Char]
env = do
  Maybe [Char]
maybeString <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
env
  case Maybe [Char]
maybeString of
    Just [Char]
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [RuleCode]
getRulecodes ([Char] -> Text
pack [Char]
s)
    Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []

getRulecodes :: Text -> [RuleCode]
getRulecodes :: Text -> [RuleCode]
getRulecodes Text
s = do
  Text
list <- Text -> Text -> [Text]
splitOn Text
"," Text
s
  let rules :: RuleCode
rules = coerce :: forall a b. Coercible a b => a -> b
coerce (Text
list :: Text)
  forall (m :: * -> *) a. Monad m => a -> m a
return RuleCode
rules

getAllowedSet :: String -> IO (Set Registry)
getAllowedSet :: [Char] -> IO (Set Registry)
getAllowedSet [Char]
env = do
  Maybe [Char]
maybeString <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
env
  case Maybe [Char]
maybeString of
    Just [Char]
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Data.Set.fromList (Text -> [Registry]
getAllowed ([Char] -> Text
pack [Char]
s))
    Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Set a
Data.Set.empty

getAllowed :: Text -> [Registry]
getAllowed :: Text -> [Registry]
getAllowed Text
s = do
  Text
list <- Text -> Text -> [Text]
splitOn Text
"," Text
s
  let regs :: Registry
regs = coerce :: forall a b. Coercible a b => a -> b
coerce (Text
list :: Text)
  forall (m :: * -> *) a. Monad m => a -> m a
return Registry
regs

getLabelSchema :: String -> IO LabelSchema
getLabelSchema :: [Char] -> IO LabelSchema
getLabelSchema [Char]
env = do
  Maybe [Char]
maybeString <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
env
  case Maybe [Char]
maybeString of
    Just [Char]
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList (Text -> [(Text, LabelType)]
labelSchemaFromText ([Char] -> Text
pack [Char]
s))
    Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Data.Map.empty

labelSchemaFromText :: Text -> [(LabelName, LabelType)]
labelSchemaFromText :: Text -> [(Text, LabelType)]
labelSchemaFromText Text
txt =
  [ (Text
ln, LabelType
lt) | Right (Text
ln, LabelType
lt) <- forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Either [Char] (Text, LabelType)
convertToLabelSchema (Text -> [(Text, Text)]
convertToPairs Text
txt) ]

convertToPairs :: Text -> [(Text, Text)]
convertToPairs :: Text -> [(Text, Text)]
convertToPairs Text
txt = forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> (Text, Text)
breakOn Text
":") (Text -> Text -> [Text]
splitOn Text
"," Text
txt)

convertToLabelSchema :: (Text, Text) -> Either String (LabelName, LabelType)
convertToLabelSchema :: (Text, Text) -> Either [Char] (Text, LabelType)
convertToLabelSchema (Text
tln, Text
tlt) =
  case (Text -> Either Text LabelType
readEitherLabelType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Data.Text.drop Int
1) Text
tlt of
    Right LabelType
lt -> forall a b. b -> Either a b
Right (coerce :: forall a b. Coercible a b => a -> b
coerce Text
tln :: Text, LabelType
lt)
    Left Text
e -> forall a b. a -> Either a b
Left (Text -> [Char]
unpack Text
e)

getFailureThreshold :: IO (Maybe DLSeverity)
getFailureThreshold :: IO (Maybe DLSeverity)
getFailureThreshold = do
  Maybe [Char]
ft <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"HADOLINT_FAILURE_THRESHOLD"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text -> Maybe DLSeverity
readMaybeSeverity forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [Char]
ft