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 <$> [Char] -> IO (Maybe Bool) maybeTruthy [Char] "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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO (Maybe Bool) isSet [Char] "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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO (Maybe Bool) maybeTruthy [Char] "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 a b. IO (a -> b) -> IO a -> IO b 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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO [RuleCode] getOverrideList [Char] "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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO [RuleCode] getOverrideList [Char] "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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO [RuleCode] getOverrideList [Char] "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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO [RuleCode] getOverrideList [Char] "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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO [RuleCode] getOverrideList [Char] "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 a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO (Set Registry) getAllowedSet [Char] "HADOLINT_TRUSTED_REGISTRIES" IO (LabelSchema -> Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO LabelSchema -> IO (Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO LabelSchema getLabelSchema [Char] "HADOLINT_REQUIRE_LABELS" IO (Maybe Bool -> Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe Bool) -> IO (Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO (Maybe Bool) maybeTruthy [Char] "HADOLINT_STRICT_LABELS" IO (Maybe Bool -> Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe Bool) -> IO (Maybe DLSeverity -> PartialConfiguration) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> IO (Maybe Bool) maybeTruthy [Char] "HADOLINT_DISABLE_IGNORE_PRAGMA" IO (Maybe DLSeverity -> PartialConfiguration) -> IO (Maybe DLSeverity) -> IO PartialConfiguration forall a b. IO (a -> b) -> IO a -> IO b 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] _ -> Maybe Bool -> IO (Maybe Bool) forall a. a -> IO a 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 [Char] Nothing -> Maybe Bool -> IO (Maybe Bool) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Maybe Bool 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 Maybe Bool -> IO (Maybe Bool) forall a. a -> IO a 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 a. a -> IO a 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 [Char] Nothing -> Maybe Bool -> IO (Maybe Bool) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Maybe Bool forall a. Maybe a Nothing truthy :: String -> Bool truthy :: [Char] -> Bool truthy [Char] s = (Char -> Char) -> [Char] -> [Char] forall a b. (a -> b) -> [a] -> [b] map Char -> Char toLower [Char] s [Char] -> [[Char]] -> Bool forall a. Eq a => a -> [a] -> Bool 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" Maybe OutputFormat -> IO (Maybe OutputFormat) forall a. a -> IO a 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) -> ([Char] -> Text) -> [Char] -> Maybe OutputFormat forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> Text pack) ([Char] -> Maybe OutputFormat) -> Maybe [Char] -> Maybe OutputFormat 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 -> [RuleCode] -> IO [RuleCode] forall a. a -> IO a 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 ([Char] -> Text pack [Char] s) Maybe [Char] Nothing -> [RuleCode] -> IO [RuleCode] forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return [] getRulecodes :: Text -> [RuleCode] getRulecodes :: Text -> [RuleCode] getRulecodes Text s = do Text list <- HasCallStack => Text -> Text -> [Text] Text -> Text -> [Text] splitOn Text "," Text s let rules :: RuleCode rules = Text -> RuleCode forall a b. Coercible a b => a -> b coerce (Text list :: Text) RuleCode -> [RuleCode] forall a. a -> [a] 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 -> Set Registry -> IO (Set Registry) forall a. a -> IO a 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 ([Char] -> Text pack [Char] s)) Maybe [Char] Nothing -> Set Registry -> IO (Set Registry) forall a. a -> IO a 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 <- HasCallStack => Text -> Text -> [Text] Text -> Text -> [Text] splitOn Text "," Text s let regs :: Registry regs = Text -> Registry forall a b. Coercible a b => a -> b coerce (Text list :: Text) Registry -> [Registry] forall a. a -> [a] 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 -> LabelSchema -> IO LabelSchema forall a. a -> IO a 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 ([Char] -> Text pack [Char] s)) Maybe [Char] Nothing -> LabelSchema -> IO LabelSchema forall a. a -> IO a 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 [Char] (Text, LabelType)) -> [(Text, Text)] -> [Either [Char] (Text, LabelType)] 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 = (Text -> (Text, Text)) -> [Text] -> [(Text, Text)] forall a b. (a -> b) -> [a] -> [b] map (HasCallStack => Text -> Text -> (Text, Text) Text -> Text -> (Text, Text) breakOn Text ":") (HasCallStack => Text -> Text -> [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 (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 [Char] (Text, LabelType) forall a b. b -> Either a b Right (Text -> Text forall a b. Coercible a b => a -> b coerce Text tln :: Text, LabelType lt) Left Text e -> [Char] -> Either [Char] (Text, LabelType) 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" Maybe DLSeverity -> IO (Maybe DLSeverity) forall a. a -> IO a 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) -> ([Char] -> Text) -> [Char] -> Maybe DLSeverity forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> Text pack) ([Char] -> Maybe DLSeverity) -> Maybe [Char] -> Maybe DLSeverity forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Maybe [Char] ft