module Hadolint.Rule.DL3002 (rule) where

import qualified Data.IntMap.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
import Hadolint.Rule
import Language.Docker.Syntax (Instruction (..), Linenumber)

type StageLine = Linenumber

type UserLine = Linenumber

data Acc
  = Acc StageLine (Map.IntMap UserLine)
  | Empty
  deriving (Int -> Acc -> ShowS
[Acc] -> ShowS
Acc -> String
(Int -> Acc -> ShowS)
-> (Acc -> String) -> ([Acc] -> ShowS) -> Show Acc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Acc] -> ShowS
$cshowList :: [Acc] -> ShowS
show :: Acc -> String
$cshow :: Acc -> String
showsPrec :: Int -> Acc -> ShowS
$cshowsPrec :: Int -> Acc -> ShowS
Show)

rule :: Rule args
rule :: Rule args
rule = (Int -> State Acc -> Instruction args -> State Acc)
-> State Acc -> (State Acc -> Failures) -> Rule args
forall a args.
(Int -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule Int -> State Acc -> Instruction args -> State Acc
forall args. Int -> State Acc -> Instruction args -> State Acc
check (Acc -> State Acc
forall a. a -> State a
emptyState Acc
Empty) State Acc -> Failures
markFailures
  where
    code :: RuleCode
code = RuleCode
"DL3002"
    severity :: DLSeverity
severity = DLSeverity
DLWarningC
    message :: Text
message = Text
"Last USER should not be root"

    check :: Int -> State Acc -> Instruction args -> State Acc
check Int
line State Acc
st (From BaseImage
_) = State Acc
st 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 (Int -> Acc -> Acc
rememberStage Int
line)
    check Int
line State Acc
st (User Text
user)
      | Bool -> Bool
not (Text -> Bool
isRoot Text
user) = State Acc
st 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
forgetStage
      | Bool
otherwise = State Acc
st 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 (Int -> Acc -> Acc
rememberLine Int
line)
    check Int
_ State Acc
st Instruction args
_ = State Acc
st

    isRoot :: Text -> Bool
isRoot Text
user =
      Text -> Text -> Bool
Text.isPrefixOf Text
"root:" Text
user Bool -> Bool -> Bool
|| Text -> Text -> Bool
Text.isPrefixOf Text
"0:" Text
user Bool -> Bool -> Bool
|| Text
user Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"root" Bool -> Bool -> Bool
|| Text
user Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0"

    markFailures :: State Acc -> Failures
markFailures (State Failures
fails (Acc Int
_ IntMap Int
st)) = (Failures -> CheckFailure -> Failures)
-> Failures -> IntMap CheckFailure -> Failures
forall a b. (a -> b -> a) -> a -> IntMap b -> a
Map.foldl' Failures -> CheckFailure -> Failures
forall a. Seq a -> a -> Seq a
(Seq.|>) Failures
fails ((Int -> CheckFailure) -> IntMap Int -> IntMap CheckFailure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CheckFailure
makeFail IntMap Int
st)
    markFailures State Acc
st = State Acc -> Failures
forall a. State a -> Failures
failures State Acc
st
    makeFail :: Int -> CheckFailure
makeFail Int
line = CheckFailure :: RuleCode -> DLSeverity -> Text -> Int -> CheckFailure
CheckFailure {Int
Text
RuleCode
DLSeverity
line :: Int
message :: Text
severity :: DLSeverity
code :: RuleCode
line :: Int
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
{-# INLINEABLE rule #-}

rememberStage :: StageLine -> Acc -> Acc
rememberStage :: Int -> Acc -> Acc
rememberStage Int
from (Acc Int
_ IntMap Int
m) = Int -> IntMap Int -> Acc
Acc Int
from IntMap Int
m
rememberStage Int
from Acc
Empty = Int -> IntMap Int -> Acc
Acc Int
from IntMap Int
forall a. IntMap a
Map.empty

forgetStage :: Acc -> Acc
forgetStage :: Acc -> Acc
forgetStage (Acc Int
from IntMap Int
m) = Int -> IntMap Int -> Acc
Acc Int
from (IntMap Int
m IntMap Int -> (IntMap Int -> IntMap Int) -> IntMap Int
forall a b. a -> (a -> b) -> b
|> Int -> IntMap Int -> IntMap Int
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
from)
forgetStage Acc
Empty = Acc
Empty

rememberLine :: StageLine -> Acc -> Acc
rememberLine :: Int -> Acc -> Acc
rememberLine Int
line (Acc Int
from IntMap Int
m) = Int -> IntMap Int -> Acc
Acc Int
from (IntMap Int
m IntMap Int -> (IntMap Int -> IntMap Int) -> IntMap Int
forall a b. a -> (a -> b) -> b
|> Int -> Int -> IntMap Int -> IntMap Int
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
from Int
line)
rememberLine Int
_ Acc
Empty = Acc
Empty