module Hadolint.Rule.DL3026 (rule) where

import qualified Data.Set as Set
import Hadolint.Rule
import Language.Docker.Syntax

rule :: Set.Set Registry -> Rule args
rule :: Set Registry -> Rule args
rule Set Registry
allowed = (Linenumber
 -> State (Set (Maybe ImageAlias))
 -> Instruction args
 -> State (Set (Maybe ImageAlias)))
-> State (Set (Maybe ImageAlias)) -> Rule args
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Linenumber
-> State (Set (Maybe ImageAlias))
-> Instruction args
-> State (Set (Maybe ImageAlias))
forall args.
Linenumber
-> State (Set (Maybe ImageAlias))
-> Instruction args
-> State (Set (Maybe ImageAlias))
check (Set (Maybe ImageAlias) -> State (Set (Maybe ImageAlias))
forall a. a -> State a
emptyState Set (Maybe ImageAlias)
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 State (Set (Maybe ImageAlias))
-> (State (Set (Maybe ImageAlias))
    -> State (Set (Maybe ImageAlias)))
-> State (Set (Maybe ImageAlias))
forall a b. a -> (a -> b) -> b
|> (Set (Maybe ImageAlias) -> Set (Maybe ImageAlias))
-> State (Set (Maybe ImageAlias)) -> State (Set (Maybe ImageAlias))
forall a. (a -> a) -> State a -> State a
modify (Maybe ImageAlias
-> Set (Maybe ImageAlias) -> Set (Maybe ImageAlias)
forall a. Ord a => a -> Set a -> Set a
Set.insert Maybe ImageAlias
alias)
       in if Set (Maybe ImageAlias) -> Image -> Bool
doCheck (State (Set (Maybe ImageAlias)) -> Set (Maybe ImageAlias)
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 State (Set (Maybe ImageAlias))
-> (State (Set (Maybe ImageAlias))
    -> State (Set (Maybe ImageAlias)))
-> State (Set (Maybe ImageAlias))
forall a b. a -> (a -> b) -> b
|> CheckFailure
-> State (Set (Maybe ImageAlias)) -> State (Set (Maybe ImageAlias))
forall a. CheckFailure -> State a -> State a
addFail CheckFailure :: RuleCode -> DLSeverity -> Text -> Linenumber -> CheckFailure
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 = Maybe ImageAlias -> Set (Maybe ImageAlias) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Image -> Maybe ImageAlias
toImageAlias Image
img) Set (Maybe ImageAlias)
st Bool -> Bool -> Bool
|| Set Registry -> Bool
forall a. Set a -> Bool
Set.null Set Registry
allowed Bool -> Bool -> Bool
|| Image -> Bool
isAllowed Image
img

    toImageAlias :: Image -> Maybe ImageAlias
toImageAlias = ImageAlias -> Maybe ImageAlias
forall a. a -> Maybe a
Just (ImageAlias -> Maybe ImageAlias)
-> (Image -> ImageAlias) -> Image -> Maybe ImageAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImageAlias
ImageAlias (Text -> ImageAlias) -> (Image -> Text) -> Image -> 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} = Registry -> Set Registry -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Registry
registry Set Registry
allowed
    isAllowed Image {$sel:registryName:Image :: Image -> Maybe Registry
registryName = Maybe Registry
Nothing, Text
imageName :: Text
$sel:imageName:Image :: Image -> Text
imageName} =
      Text
imageName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"scratch"
        Bool -> Bool -> Bool
|| Registry -> Set Registry -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Registry
"docker.io" Set Registry
allowed
        Bool -> Bool -> Bool
|| Registry -> Set Registry -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Registry
"hub.docker.com" Set Registry
allowed
{-# INLINEABLE rule #-}