module Hadolint.Rule.DL3049 (rule) where

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
import Hadolint.Rule
import Language.Docker.Syntax


rule :: LabelSchema -> Rule args
rule :: LabelSchema -> Rule args
rule LabelSchema
labelschema = [Rule args] -> Rule args
forall a. Monoid a => [a] -> a
mconcat ([Rule args] -> Rule args) -> [Rule args] -> Rule args
forall a b. (a -> b) -> a -> b
$ (LabelName -> Rule args) -> [LabelName] -> [Rule args]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LabelName -> Rule args
forall args. LabelName -> Rule args
missingLabelRule (LabelSchema -> [LabelName]
forall k a. Map k a -> [k]
Map.keys LabelSchema
labelschema)
{-# INLINEABLE rule #-}

data StageID = StageID
  { StageID -> LabelName
name :: Text.Text,
    StageID -> Linenumber
line :: Linenumber
  } deriving (StageID -> StageID -> Bool
(StageID -> StageID -> Bool)
-> (StageID -> StageID -> Bool) -> Eq StageID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StageID -> StageID -> Bool
$c/= :: StageID -> StageID -> Bool
== :: StageID -> StageID -> Bool
$c== :: StageID -> StageID -> Bool
Eq, Eq StageID
Eq StageID
-> (StageID -> StageID -> Ordering)
-> (StageID -> StageID -> Bool)
-> (StageID -> StageID -> Bool)
-> (StageID -> StageID -> Bool)
-> (StageID -> StageID -> Bool)
-> (StageID -> StageID -> StageID)
-> (StageID -> StageID -> StageID)
-> Ord StageID
StageID -> StageID -> Bool
StageID -> StageID -> Ordering
StageID -> StageID -> StageID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StageID -> StageID -> StageID
$cmin :: StageID -> StageID -> StageID
max :: StageID -> StageID -> StageID
$cmax :: StageID -> StageID -> StageID
>= :: StageID -> StageID -> Bool
$c>= :: StageID -> StageID -> Bool
> :: StageID -> StageID -> Bool
$c> :: StageID -> StageID -> Bool
<= :: StageID -> StageID -> Bool
$c<= :: StageID -> StageID -> Bool
< :: StageID -> StageID -> Bool
$c< :: StageID -> StageID -> Bool
compare :: StageID -> StageID -> Ordering
$ccompare :: StageID -> StageID -> Ordering
$cp1Ord :: Eq StageID
Ord, Linenumber -> StageID -> ShowS
[StageID] -> ShowS
StageID -> String
(Linenumber -> StageID -> ShowS)
-> (StageID -> String) -> ([StageID] -> ShowS) -> Show StageID
forall a.
(Linenumber -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StageID] -> ShowS
$cshowList :: [StageID] -> ShowS
show :: StageID -> String
$cshow :: StageID -> String
showsPrec :: Linenumber -> StageID -> ShowS
$cshowsPrec :: Linenumber -> StageID -> ShowS
Show)

data Acc
  = Acc StageID (Set.Set StageID) (Set.Set StageID)
  | Empty
  deriving (Linenumber -> Acc -> ShowS
[Acc] -> ShowS
Acc -> String
(Linenumber -> Acc -> ShowS)
-> (Acc -> String) -> ([Acc] -> ShowS) -> Show Acc
forall a.
(Linenumber -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Acc] -> ShowS
$cshowList :: [Acc] -> ShowS
show :: Acc -> String
$cshow :: Acc -> String
showsPrec :: Linenumber -> Acc -> ShowS
$cshowsPrec :: Linenumber -> Acc -> ShowS
Show)

-- missingLabelRule
--
-- triggers on a `FROM` instruction when label `label` is not defined within
-- that stage. Tracks defined labels through multi stage builds
missingLabelRule :: LabelName -> Rule args
missingLabelRule :: LabelName -> Rule args
missingLabelRule LabelName
label = (Linenumber -> State Acc -> Instruction args -> State Acc)
-> State Acc -> (State Acc -> Failures) -> Rule args
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule Linenumber -> State Acc -> Instruction args -> State Acc
forall args.
Linenumber -> State Acc -> Instruction args -> State Acc
check (Acc -> State Acc
forall a. a -> State a
emptyState Acc
Empty) State Acc -> Failures
markFailure
  where
    code :: RuleCode
code = RuleCode
"DL3049"
    severity :: DLSeverity
severity = DLSeverity
DLInfoC
    message :: LabelName
message = LabelName
"Label `" LabelName -> LabelName -> LabelName
forall a. Semigroup a => a -> a -> a
<> LabelName
label LabelName -> LabelName -> LabelName
forall a. Semigroup a => a -> a -> a
<> LabelName
"` is missing."
    check :: Linenumber -> State Acc -> Instruction args -> State Acc
check Linenumber
line State Acc
state (From BaseImage {Image
$sel:image:BaseImage :: BaseImage -> Image
image :: Image
image, $sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Just ImageAlias
als}) =
        State Acc
state State Acc -> (State Acc -> State Acc) -> State Acc
forall a b. a -> (a -> b) -> b
|> (Acc -> Acc) -> State Acc -> State Acc
forall a. (a -> a) -> State a -> State a
modify (LabelName -> StageID -> Acc -> Acc
currentStage (Image -> LabelName
imageName Image
image) (LabelName -> Linenumber -> StageID
StageID (ImageAlias -> LabelName
unImageAlias ImageAlias
als) Linenumber
line))
    check Linenumber
line State Acc
state (From BaseImage {Image
image :: Image
$sel:image:BaseImage :: BaseImage -> Image
image, $sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Maybe ImageAlias
Nothing}) =
        State Acc
state State Acc -> (State Acc -> State Acc) -> State Acc
forall a b. a -> (a -> b) -> b
|> (Acc -> Acc) -> State Acc -> State Acc
forall a. (a -> a) -> State a -> State a
modify (LabelName -> StageID -> Acc -> Acc
currentStage (Image -> LabelName
imageName Image
image) (LabelName -> Linenumber -> StageID
StageID (Image -> LabelName
imageName Image
image) Linenumber
line))
    check Linenumber
_ State Acc
state (Label Pairs
pairs)
        | LabelName
label LabelName -> [LabelName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((LabelName, LabelName) -> LabelName) -> Pairs -> [LabelName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LabelName, LabelName) -> LabelName
forall a b. (a, b) -> a
fst Pairs
pairs = State Acc
state State Acc -> (State Acc -> State Acc) -> State Acc
forall a b. a -> (a -> b) -> b
|> (Acc -> Acc) -> State Acc -> State Acc
forall a. (a -> a) -> State a -> State a
modify Acc -> Acc
goodStage
        | Bool
otherwise = State Acc
state
    check Linenumber
_ State Acc
state Instruction args
_ = State Acc
state

    markFailure :: State Acc -> Failures
    markFailure :: State Acc -> Failures
markFailure (State Failures
fails (Acc StageID
_ Set StageID
_ Set StageID
b)) = (Failures -> CheckFailure -> Failures)
-> Failures -> Set CheckFailure -> Failures
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Failures -> CheckFailure -> Failures
forall a. Seq a -> a -> Seq a
(Seq.|>) Failures
fails ((StageID -> CheckFailure) -> Set StageID -> Set CheckFailure
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map StageID -> CheckFailure
markFail Set StageID
b)
    markFailure State Acc
st = State Acc -> Failures
forall a. State a -> Failures
failures State Acc
st

    markFail :: StageID -> CheckFailure
markFail (StageID LabelName
_ Linenumber
line) = CheckFailure :: RuleCode -> DLSeverity -> LabelName -> Linenumber -> CheckFailure
CheckFailure {Linenumber
LabelName
RuleCode
DLSeverity
line :: Linenumber
message :: LabelName
severity :: DLSeverity
code :: RuleCode
line :: Linenumber
message :: LabelName
severity :: DLSeverity
code :: RuleCode
..}

currentStage :: Text.Text -> StageID -> Acc -> Acc
currentStage :: LabelName -> StageID -> Acc -> Acc
currentStage LabelName
src StageID
stageid (Acc StageID
_ Set StageID
g Set StageID
b)
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set StageID -> Bool
forall a. Set a -> Bool
Set.null ((StageID -> Bool) -> Set StageID -> Set StageID
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (LabelName -> StageID -> Bool
predicate LabelName
src) Set StageID
g) = StageID -> Set StageID -> Set StageID -> Acc
Acc StageID
stageid (Set StageID
g Set StageID -> (Set StageID -> Set StageID) -> Set StageID
forall a b. a -> (a -> b) -> b
|> StageID -> Set StageID -> Set StageID
forall a. Ord a => a -> Set a -> Set a
Set.insert StageID
stageid) Set StageID
b
    | Bool
otherwise = StageID -> Set StageID -> Set StageID -> Acc
Acc StageID
stageid Set StageID
g (Set StageID
b Set StageID -> (Set StageID -> Set StageID) -> Set StageID
forall a b. a -> (a -> b) -> b
|> StageID -> Set StageID -> Set StageID
forall a. Ord a => a -> Set a -> Set a
Set.insert StageID
stageid)
  where
    predicate :: LabelName -> StageID -> Bool
predicate LabelName
n0 StageID {name :: StageID -> LabelName
name = LabelName
n1} = LabelName
n1 LabelName -> LabelName -> Bool
forall a. Eq a => a -> a -> Bool
== LabelName
n0
currentStage LabelName
_ StageID
stageid Acc
Empty = StageID -> Set StageID -> Set StageID -> Acc
Acc StageID
stageid Set StageID
forall a. Set a
Set.empty (StageID -> Set StageID
forall a. a -> Set a
Set.singleton StageID
stageid)

goodStage :: Acc -> Acc
goodStage :: Acc -> Acc
goodStage (Acc StageID
stageid Set StageID
g Set StageID
b) = StageID -> Set StageID -> Set StageID -> Acc
Acc StageID
stageid (Set StageID
g Set StageID -> (Set StageID -> Set StageID) -> Set StageID
forall a b. a -> (a -> b) -> b
|> StageID -> Set StageID -> Set StageID
forall a. Ord a => a -> Set a -> Set a
Set.insert StageID
stageid) (Set StageID
b Set StageID -> (Set StageID -> Set StageID) -> Set StageID
forall a b. a -> (a -> b) -> b
|> StageID -> Set StageID -> Set StageID
forall a. Ord a => a -> Set a -> Set a
Set.delete StageID
stageid)
goodStage Acc
Empty = Acc
Empty