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 #-}