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 (Maybe Bool -> Maybe Bool -> Maybe Bool -> Maybe OutputFormat -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe Bool) -> IO (Maybe Bool -> Maybe Bool -> Maybe OutputFormat -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> IO (Maybe Bool) maybeTruthy String "HADOLINT_NOFAIL" IO (Maybe Bool -> Maybe Bool -> Maybe OutputFormat -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe Bool) -> IO (Maybe Bool -> Maybe OutputFormat -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO (Maybe Bool) isSet String "NO_COLOR" IO (Maybe Bool -> Maybe OutputFormat -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe Bool) -> IO (Maybe OutputFormat -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO (Maybe Bool) maybeTruthy String "HADOLINT_VERBOSE" IO (Maybe OutputFormat -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe OutputFormat) -> IO ([RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> IO (Maybe OutputFormat) getFormat IO ([RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO [RuleCode] -> IO ([RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO [RuleCode] getOverrideList String "HADOLINT_OVERRIDE_ERROR" IO ([RuleCode] -> [RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO [RuleCode] -> IO ([RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO [RuleCode] getOverrideList String "HADOLINT_OVERRIDE_WARNING" IO ([RuleCode] -> [RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO [RuleCode] -> IO ([RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO [RuleCode] getOverrideList String "HADOLINT_OVERRIDE_INFO" IO ([RuleCode] -> [RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO [RuleCode] -> IO ([RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO [RuleCode] getOverrideList String "HADOLINT_OVERRIDE_STYLE" IO ([RuleCode] -> Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO [RuleCode] -> IO (Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO [RuleCode] getOverrideList String "HADOLINT_IGNORE" IO (Set Registry -> LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Set Registry) -> IO (LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO (Set Registry) getAllowedSet String "HADOLINT_TRUSTED_REGISTRIES" IO (LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO LabelSchema -> IO (Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO LabelSchema getLabelSchema String "HADOLINT_REQUIRE_LABELS" IO (Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe Bool) -> IO (Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO (Maybe Bool) maybeTruthy String "HADOLINT_STRICT_LABELS" IO (Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe Bool) -> IO (Maybe DLSeverity -> PartialConfiguration) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> IO (Maybe Bool) maybeTruthy String "HADOLINT_DISABLE_IGNORE_PRAGMA" IO (Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe DLSeverity) -> IO PartialConfiguration forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> IO (Maybe DLSeverity) getFailureThreshold isSet :: String -> IO (Maybe Bool) isSet :: String -> IO (Maybe Bool) isSet String name = do Maybe String e <- String -> IO (Maybe String) lookupEnv String name case Maybe String e of Just String _ -> Maybe Bool -> IO (Maybe Bool) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool) forall a b. (a -> b) -> a -> b $ Bool -> Maybe Bool forall a. a -> Maybe a Just Bool True Maybe String Nothing -> Maybe Bool -> IO (Maybe Bool) forall (m :: * -> *) a. Monad m => a -> m a return Maybe Bool forall a. Maybe a Nothing maybeTruthy :: String -> IO (Maybe Bool) maybeTruthy :: String -> IO (Maybe Bool) maybeTruthy String name = do Maybe String e <- String -> IO (Maybe String) lookupEnv String name case Maybe String e of Just String v -> if String -> Bool truthy String v then Maybe Bool -> IO (Maybe Bool) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool) forall a b. (a -> b) -> a -> b $ Bool -> Maybe Bool forall a. a -> Maybe a Just Bool True else Maybe Bool -> IO (Maybe Bool) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool) forall a b. (a -> b) -> a -> b $ Bool -> Maybe Bool forall a. a -> Maybe a Just Bool False Maybe String Nothing -> Maybe Bool -> IO (Maybe Bool) forall (m :: * -> *) a. Monad m => a -> m a return Maybe Bool forall a. Maybe a Nothing truthy :: String -> Bool truthy :: String -> Bool truthy String s = (Char -> Char) -> String -> String forall a b. (a -> b) -> [a] -> [b] map Char -> Char toLower String s String -> [String] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [String "1", String "y", String "on", String "true", String "yes"] getFormat :: IO (Maybe OutputFormat) getFormat :: IO (Maybe OutputFormat) getFormat = do Maybe String fmt <- String -> IO (Maybe String) lookupEnv String "HADOLINT_FORMAT" Maybe OutputFormat -> IO (Maybe OutputFormat) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe OutputFormat -> IO (Maybe OutputFormat)) -> Maybe OutputFormat -> IO (Maybe OutputFormat) forall a b. (a -> b) -> a -> b $ (Text -> Maybe OutputFormat readMaybeOutputFormat (Text -> Maybe OutputFormat) -> (String -> Text) -> String -> Maybe OutputFormat forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text pack) (String -> Maybe OutputFormat) -> Maybe String -> Maybe OutputFormat forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Maybe String fmt getOverrideList :: String -> IO [RuleCode] getOverrideList :: String -> IO [RuleCode] getOverrideList String env = do Maybe String maybeString <- String -> IO (Maybe String) lookupEnv String env case Maybe String maybeString of Just String s -> [RuleCode] -> IO [RuleCode] forall (m :: * -> *) a. Monad m => a -> m a return ([RuleCode] -> IO [RuleCode]) -> [RuleCode] -> IO [RuleCode] forall a b. (a -> b) -> a -> b $ Text -> [RuleCode] getRulecodes (String -> Text pack String s) Maybe String Nothing -> [RuleCode] -> IO [RuleCode] 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 = Text -> RuleCode coerce (Text list :: Text) RuleCode -> [RuleCode] forall (m :: * -> *) a. Monad m => a -> m a return RuleCode rules getAllowedSet :: String -> IO (Set Registry) getAllowedSet :: String -> IO (Set Registry) getAllowedSet String env = do Maybe String maybeString <- String -> IO (Maybe String) lookupEnv String env case Maybe String maybeString of Just String s -> Set Registry -> IO (Set Registry) forall (m :: * -> *) a. Monad m => a -> m a return (Set Registry -> IO (Set Registry)) -> Set Registry -> IO (Set Registry) forall a b. (a -> b) -> a -> b $ [Registry] -> Set Registry forall a. Ord a => [a] -> Set a Data.Set.fromList (Text -> [Registry] getAllowed (String -> Text pack String s)) Maybe String Nothing -> Set Registry -> IO (Set Registry) forall (m :: * -> *) a. Monad m => a -> m a return Set Registry 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 = Text -> Registry coerce (Text list :: Text) Registry -> [Registry] forall (m :: * -> *) a. Monad m => a -> m a return Registry regs getLabelSchema :: String -> IO LabelSchema getLabelSchema :: String -> IO LabelSchema getLabelSchema String env = do Maybe String maybeString <- String -> IO (Maybe String) lookupEnv String env case Maybe String maybeString of Just String s -> LabelSchema -> IO LabelSchema forall (m :: * -> *) a. Monad m => a -> m a return (LabelSchema -> IO LabelSchema) -> LabelSchema -> IO LabelSchema forall a b. (a -> b) -> a -> b $ [(Text, LabelType)] -> LabelSchema forall k a. Ord k => [(k, a)] -> Map k a Data.Map.fromList (Text -> [(Text, LabelType)] labelSchemaFromText (String -> Text pack String s)) Maybe String Nothing -> LabelSchema -> IO LabelSchema forall (m :: * -> *) a. Monad m => a -> m a return LabelSchema 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) <- ((Text, Text) -> Either String (Text, LabelType)) -> [(Text, Text)] -> [Either String (Text, LabelType)] forall a b. (a -> b) -> [a] -> [b] map (Text, Text) -> Either String (Text, LabelType) convertToLabelSchema (Text -> [(Text, Text)] convertToPairs Text txt) ] convertToPairs :: Text -> [(Text, Text)] convertToPairs :: Text -> [(Text, Text)] convertToPairs Text txt = (Text -> (Text, Text)) -> [Text] -> [(Text, Text)] 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 String (Text, LabelType) convertToLabelSchema (Text tln, Text tlt) = case (Text -> Either Text LabelType readEitherLabelType (Text -> Either Text LabelType) -> (Text -> Text) -> Text -> Either Text LabelType forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Text -> Text Data.Text.drop Int 1) Text tlt of Right LabelType lt -> (Text, LabelType) -> Either String (Text, LabelType) forall a b. b -> Either a b Right (Text -> Text coerce Text tln :: Text, LabelType lt) Left Text e -> String -> Either String (Text, LabelType) forall a b. a -> Either a b Left (Text -> String unpack Text e) getFailureThreshold :: IO (Maybe DLSeverity) getFailureThreshold :: IO (Maybe DLSeverity) getFailureThreshold = do Maybe String ft <- String -> IO (Maybe String) lookupEnv String "HADOLINT_FAILURE_THRESHOLD" Maybe DLSeverity -> IO (Maybe DLSeverity) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe DLSeverity -> IO (Maybe DLSeverity)) -> Maybe DLSeverity -> IO (Maybe DLSeverity) forall a b. (a -> b) -> a -> b $ (Text -> Maybe DLSeverity readMaybeSeverity (Text -> Maybe DLSeverity) -> (String -> Text) -> String -> Maybe DLSeverity forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text pack) (String -> Maybe DLSeverity) -> Maybe String -> Maybe DLSeverity forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Maybe String ft