module Hadolint.Rule.DL4004 (rule) where

import Hadolint.Rule
import Language.Docker.Syntax (Instruction (..))

data HasEntry = HasEntry | NoEntry

rule :: Rule args
rule :: Rule args
rule = (Linenumber
 -> State HasEntry -> Instruction args -> State HasEntry)
-> State HasEntry -> Rule args
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Linenumber -> State HasEntry -> Instruction args -> State HasEntry
forall args.
Linenumber -> State HasEntry -> Instruction args -> State HasEntry
check (HasEntry -> State HasEntry
forall a. a -> State a
emptyState HasEntry
NoEntry)
  where
    code :: RuleCode
code = RuleCode
"DL4004"
    severity :: DLSeverity
severity = DLSeverity
DLErrorC
    message :: Text
message =
      Text
"Multiple `ENTRYPOINT` instructions found. If you list more than one `ENTRYPOINT` then \
      \only the last `ENTRYPOINT` will take effect"

    -- Reset the state each time we find a FROM
    check :: Linenumber -> State HasEntry -> Instruction args -> State HasEntry
check Linenumber
_ State HasEntry
st From {} = State HasEntry
st State HasEntry
-> (State HasEntry -> State HasEntry) -> State HasEntry
forall a b. a -> (a -> b) -> b
|> HasEntry -> State HasEntry -> State HasEntry
forall a. a -> State a -> State a
replaceWith HasEntry
NoEntry
    -- Remember we found an ENTRYPOINT
    check Linenumber
_ st :: State HasEntry
st@(State Failures
_ HasEntry
NoEntry) Entrypoint {} = State HasEntry
st State HasEntry
-> (State HasEntry -> State HasEntry) -> State HasEntry
forall a b. a -> (a -> b) -> b
|> HasEntry -> State HasEntry -> State HasEntry
forall a. a -> State a -> State a
replaceWith HasEntry
HasEntry
    -- Add a failure if we found another entrypoint in the same stage
    check Linenumber
line st :: State HasEntry
st@(State Failures
_ HasEntry
HasEntry) Entrypoint {} = State HasEntry
st State HasEntry
-> (State HasEntry -> State HasEntry) -> State HasEntry
forall a b. a -> (a -> b) -> b
|> CheckFailure -> State HasEntry -> State HasEntry
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 HasEntry
st Instruction args
_ = State HasEntry
st
{-# INLINEABLE rule #-}