module Hadolint.Rule.DL3026 (rule) where import qualified Data.Set as Set import Data.Text (Text, pack, drop, dropEnd, isSuffixOf, isPrefixOf) import Hadolint.Rule import Language.Docker.Syntax rule :: Set.Set Registry -> Rule args rule :: forall args. Set Registry -> Rule args rule Set Registry allowed = forall a args. (Linenumber -> State a -> Instruction args -> State a) -> State a -> Rule args customRule forall {args}. Linenumber -> State (Set (Maybe ImageAlias)) -> Instruction args -> State (Set (Maybe ImageAlias)) check (forall a. a -> State a emptyState forall a. Set a Set.empty) where code :: RuleCode code = RuleCode "DL3026" severity :: DLSeverity severity = DLSeverity DLErrorC message :: Text message = Text "Use only an allowed registry in the FROM image" check :: Linenumber -> State (Set (Maybe ImageAlias)) -> Instruction args -> State (Set (Maybe ImageAlias)) check Linenumber line State (Set (Maybe ImageAlias)) st (From BaseImage {Image $sel:image:BaseImage :: BaseImage -> Image image :: Image image, Maybe ImageAlias $sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias alias :: Maybe ImageAlias alias}) = let newState :: State (Set (Maybe ImageAlias)) newState = State (Set (Maybe ImageAlias)) st forall a b. a -> (a -> b) -> b |> forall a. (a -> a) -> State a -> State a modify (forall a. Ord a => a -> Set a -> Set a Set.insert Maybe ImageAlias alias) in if Set (Maybe ImageAlias) -> Image -> Bool doCheck (forall a. State a -> a state State (Set (Maybe ImageAlias)) st) Image image then State (Set (Maybe ImageAlias)) newState else State (Set (Maybe ImageAlias)) newState forall a b. a -> (a -> b) -> b |> forall a. CheckFailure -> State a -> State a addFail CheckFailure {Linenumber Text RuleCode DLSeverity line :: Linenumber message :: Text severity :: DLSeverity code :: RuleCode line :: Linenumber message :: Text severity :: DLSeverity code :: RuleCode ..} check Linenumber _ State (Set (Maybe ImageAlias)) st Instruction args _ = State (Set (Maybe ImageAlias)) st doCheck :: Set (Maybe ImageAlias) -> Image -> Bool doCheck Set (Maybe ImageAlias) st Image img = forall a. Ord a => a -> Set a -> Bool Set.member (Image -> Maybe ImageAlias toImageAlias Image img) Set (Maybe ImageAlias) st Bool -> Bool -> Bool || forall a. Set a -> Bool Set.null Set Registry allowed Bool -> Bool -> Bool || Image -> Bool isAllowed Image img toImageAlias :: Image -> Maybe ImageAlias toImageAlias = forall a. a -> Maybe a Just forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> ImageAlias ImageAlias forall b c a. (b -> c) -> (a -> b) -> a -> c . Image -> Text imageName isAllowed :: Image -> Bool isAllowed Image {$sel:registryName:Image :: Image -> Maybe Registry registryName = Just Registry registry} = Text -> Bool isRegistryAllowed (Registry -> Text unRegistry Registry registry) isAllowed Image {$sel:registryName:Image :: Image -> Maybe Registry registryName = Maybe Registry Nothing, Text imageName :: Text $sel:imageName:Image :: Image -> Text imageName} = Text imageName forall a. Eq a => a -> a -> Bool == Text "scratch" Bool -> Bool -> Bool || Text -> Bool isRegistryAllowed Text "docker.io" Bool -> Bool -> Bool || Text -> Bool isRegistryAllowed Text "hub.docker.com" isRegistryAllowed :: Text -> Bool isRegistryAllowed Text registry = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (\Registry p -> Text -> Text -> Bool matchRegistry (Registry -> Text unRegistry Registry p) Text registry) Set Registry allowed matchRegistry :: Text -> Text -> Bool matchRegistry :: Text -> Text -> Bool matchRegistry Text allow Text registry | Text allow forall a. Eq a => a -> a -> Bool == Text star = Bool True | Text star Text -> Text -> Bool `isPrefixOf` Text allow = Linenumber -> Text -> Text Data.Text.drop Linenumber 1 Text allow Text -> Text -> Bool `isSuffixOf` Text registry | Text star Text -> Text -> Bool `isSuffixOf` Text allow = Linenumber -> Text -> Text Data.Text.dropEnd Linenumber 1 Text allow Text -> Text -> Bool `isPrefixOf` Text registry | Bool otherwise = Text registry forall a. Eq a => a -> a -> Bool == Text allow where star :: Text star = String -> Text pack String "*" {-# INLINEABLE rule #-}