module Hadolint.Rule.DL3057 (rule) where

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


data StageID = StageID
  { StageID -> Text
src :: Text.Text,
    StageID -> Text
name :: Text.Text,
    StageID -> Linenumber
line :: Linenumber
  } deriving (Linenumber -> StageID -> ShowS
[StageID] -> ShowS
StageID -> String
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, StageID -> StageID -> Bool
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
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
Ord)

data Acc
  = Acc StageID (Set.Set StageID) (Set.Set StageID)
  | Empty
  deriving (Linenumber -> Acc -> ShowS
[Acc] -> ShowS
Acc -> String
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)

rule :: Rule args
rule :: forall args. Rule args
rule = forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule forall {args}.
Linenumber -> State Acc -> Instruction args -> State Acc
check (forall a. a -> State a
emptyState Acc
Empty) State Acc -> Failures
markFailures
  where
    code :: RuleCode
code = RuleCode
"DL3057"
    severity :: DLSeverity
severity = DLSeverity
DLIgnoreC
    message :: Text
message = Text
"`HEALTHCHECK` instruction 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 forall a b. a -> (a -> b) -> b
|> forall a. (a -> a) -> State a -> State a
modify
                  ( Text -> StageID -> Acc -> Acc
currentStage
                      (Image -> Text
imageName Image
image)
                      (Text -> Text -> Linenumber -> StageID
StageID (Image -> Text
imageName Image
image) (ImageAlias -> Text
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 forall a b. a -> (a -> b) -> b
|> forall a. (a -> a) -> State a -> State a
modify
                  ( Text -> StageID -> Acc -> Acc
currentStage
                      (Image -> Text
imageName Image
image)
                      (Text -> Text -> Linenumber -> StageID
StageID (Image -> Text
imageName Image
image) (Image -> Text
imageName Image
image) Linenumber
line)
                  )
    check Linenumber
_ State Acc
state (Healthcheck Check args
_) = State Acc
state forall a b. a -> (a -> b) -> b
|> forall a. (a -> a) -> State a -> State a
modify Acc -> Acc
goodStage
    check Linenumber
_ State Acc
state Instruction args
_ = State Acc
state

    markFailures :: State Acc -> Failures
    markFailures :: State Acc -> Failures
markFailures (State Failures
fails (Acc StageID
_ Set StageID
_ Set StageID
b)) = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' forall a. Seq a -> a -> Seq a
(Seq.|>) Failures
fails (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map StageID -> CheckFailure
makeFail Set StageID
b)
    markFailures State Acc
st = forall a. State a -> Failures
failures State Acc
st
    makeFail :: StageID -> CheckFailure
makeFail (StageID Text
_ Text
_ Linenumber
line) = CheckFailure {Linenumber
Text
RuleCode
DLSeverity
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
{-# INLINEABLE rule #-}

currentStage :: Text.Text -> StageID -> Acc -> Acc
currentStage :: Text -> StageID -> Acc -> Acc
currentStage Text
src StageID
stageid (Acc StageID
_ Set StageID
g Set StageID
b)
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
Set.null (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Text -> StageID -> Bool
predicate Text
src) Set StageID
g) = StageID -> Set StageID -> Set StageID -> Acc
Acc StageID
stageid (Set StageID
g forall a b. a -> (a -> b) -> b
|> 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 forall a b. a -> (a -> b) -> b
|> forall a. Ord a => a -> Set a -> Set a
Set.insert StageID
stageid)
  where
    predicate :: Text -> StageID -> Bool
predicate Text
n0 StageID {name :: StageID -> Text
name = Text
n1} = Text
n1 forall a. Eq a => a -> a -> Bool
== Text
n0
currentStage Text
_ StageID
stageid Acc
Empty = StageID -> Set StageID -> Set StageID -> Acc
Acc StageID
stageid forall a. Set a
Set.empty (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) = do
  let nowGood :: Set StageID
nowGood = Set StageID -> StageID -> Set StageID
recurseGood Set StageID
b StageID
stageid
  let good :: Set StageID
good =
        Set StageID
g
          forall a b. a -> (a -> b) -> b
|> forall a. Ord a => Set a -> Set a -> Set a
Set.union Set StageID
nowGood
          forall a b. a -> (a -> b) -> b
|> forall a. Ord a => a -> Set a -> Set a
Set.insert StageID
stageid
      bad :: Set StageID
bad =
        Set StageID
b
          forall a b. a -> (a -> b) -> b
|> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set StageID
nowGood
          forall a b. a -> (a -> b) -> b
|> forall a. Ord a => a -> Set a -> Set a
Set.delete StageID
stageid
   in StageID -> Set StageID -> Set StageID -> Acc
Acc
        StageID
stageid
        Set StageID
good
        Set StageID
bad
  where
    predicate :: StageID -> StageID -> Bool
predicate StageID { src :: StageID -> Text
src = Text
s1 } StageID { name :: StageID -> Text
name = Text
n1 } = Text
n1 forall a. Eq a => a -> a -> Bool
== Text
s1

    recurseGood :: Set.Set StageID -> StageID -> Set.Set StageID
    recurseGood :: Set StageID -> StageID -> Set StageID
recurseGood Set StageID
bad StageID
sid = do
      let g1 :: Set StageID
g1 = forall a. (a -> Bool) -> Set a -> Set a
Set.filter (StageID -> StageID -> Bool
predicate StageID
sid) Set StageID
bad  -- bad stages to be marked good
          b1 :: Set StageID
b1 = forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set StageID
bad Set StageID
g1  -- bad stages not to be marked good
       in if forall a. Set a -> Bool
Set.null Set StageID
g1
            then Set StageID
g1
            else forall a. Ord a => Set a -> Set a -> Set a
Set.union Set StageID
g1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Set StageID -> StageID -> Set StageID
recurseGood Set StageID
b1) Set StageID
g1

goodStage Acc
Empty = Acc
Empty