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