module Hadolint.Rule.DL3060 (rule) where

import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import Hadolint.Rule
import qualified Hadolint.Shell as Shell
import qualified Hadolint.Utils as Utils
import Language.Docker.Syntax

data Acc
  = Acc
      { Acc -> BaseImage
current :: BaseImage,
        Acc -> Map Text Int
active :: Map.Map Text.Text Linenumber,
        Acc -> Map Int BaseImage
inactive :: Map.Map Linenumber BaseImage
      }
  | 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
$cshowsPrec :: Int -> Acc -> ShowS
showsPrec :: Int -> Acc -> ShowS
$cshow :: Acc -> String
show :: Acc -> String
$cshowList :: [Acc] -> ShowS
showList :: [Acc] -> ShowS
Show)

rule :: Rule Shell.ParsedShell
rule :: Rule ParsedShell
rule = Rule ParsedShell
dl3060 Rule ParsedShell -> Rule ParsedShell -> Rule ParsedShell
forall a. Semigroup a => a -> a -> a
<> Rule ParsedShell -> Rule ParsedShell
forall args. Rule args -> Rule args
onbuild Rule ParsedShell
dl3060
{-# INLINEABLE rule #-}

dl3060 :: Rule Shell.ParsedShell
dl3060 :: Rule ParsedShell
dl3060 = (Int -> State Acc -> Instruction ParsedShell -> State Acc)
-> State Acc -> (State Acc -> Failures) -> Rule ParsedShell
forall a args.
(Int -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule Int -> State Acc -> Instruction ParsedShell -> State Acc
check (Acc -> State Acc
forall a. a -> State a
emptyState Acc
Empty) State Acc -> Failures
markFailures
  where
    code :: RuleCode
code = RuleCode
"DL3060"
    severity :: DLSeverity
severity = DLSeverity
DLInfoC
    message :: Text
message = Text
"`yarn cache clean` missing after `yarn install` was run."

    check :: Int -> State Acc -> Instruction ParsedShell -> State Acc
check Int
line State Acc
st (From BaseImage
from) =
      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 -> BaseImage -> Acc -> Acc
rememberStage Int
line BaseImage
from)
    check Int
line State Acc
st (Run (RunArgs Arguments ParsedShell
args RunFlags
flags))
      | (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
yarnInstall) Arguments ParsedShell
args
          Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
yarnCacheClean) Arguments ParsedShell
args
          Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> RunFlags -> Bool
Utils.hasCacheOrTmpfsMountWith Text
".cache/yarn" RunFlags
flags) =
        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
line State Acc
st (Run (RunArgs Arguments ParsedShell
args RunFlags
_))
      | (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
yarnInstall) Arguments ParsedShell
args
          Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
yarnCacheClean) Arguments ParsedShell
args
          Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ParsedShell -> Bool
isCleanBeforeInstall Arguments ParsedShell
args =
        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)
      | Bool
otherwise = State Acc
st
    check Int
_ State Acc
st Instruction ParsedShell
_ = State Acc
st

    -- Produce failures from the final state Acc
    markFailures :: State Acc -> Failures
    markFailures :: State Acc -> Failures
markFailures (State Failures
fails Acc
Empty) = Failures
fails
    markFailures (State Failures
_ Acc {BaseImage
Map Int BaseImage
Map Text Int
current :: Acc -> BaseImage
active :: Acc -> Map Text Int
inactive :: Acc -> Map Int BaseImage
current :: BaseImage
active :: Map Text Int
inactive :: Map Int BaseImage
..}) = Map Int BaseImage
inactive Map Int BaseImage -> (Map Int BaseImage -> Failures) -> Failures
forall a b. a -> (a -> b) -> b
|> (Int -> BaseImage -> Failures) -> Map Int BaseImage -> Failures
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Int -> BaseImage -> Failures
forall {f :: * -> *}.
(Applicative f, Monoid (f CheckFailure)) =>
Int -> BaseImage -> f CheckFailure
mapFail
      where
        mapFail :: Int -> BaseImage -> f CheckFailure
mapFail Int
line BaseImage
from
          | BaseImage
from BaseImage -> BaseImage -> Bool
forall a. Eq a => a -> a -> Bool
== BaseImage
current = CheckFailure -> f CheckFailure
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CheckFailure {Int
Text
RuleCode
DLSeverity
code :: RuleCode
severity :: DLSeverity
message :: Text
line :: Int
line :: Int
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
          | BaseImage {alias :: BaseImage -> Maybe ImageAlias
alias = Just (ImageAlias Text
als)} <- BaseImage
from,
            Just Int
_ <- Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
als Map Text Int
active = CheckFailure -> f CheckFailure
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CheckFailure {Int
Text
RuleCode
DLSeverity
code :: RuleCode
severity :: DLSeverity
message :: Text
line :: Int
line :: Int
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
          | Bool
otherwise = f CheckFailure
forall a. Monoid a => a
mempty
{-# INLINEABLE dl3060 #-}

rememberStage :: Linenumber -> BaseImage -> Acc -> Acc
rememberStage :: Int -> BaseImage -> Acc -> Acc
rememberStage Int
line stage :: BaseImage
stage@BaseImage {image :: BaseImage -> Image
image = Image Maybe Registry
_ Text
als} Acc
Empty =
  BaseImage -> Map Text Int -> Map Int BaseImage -> Acc
Acc BaseImage
stage (Text -> Int -> Map Text Int
forall k a. k -> a -> Map k a
Map.singleton Text
als Int
line) Map Int BaseImage
forall k a. Map k a
Map.empty
rememberStage Int
line stage :: BaseImage
stage@BaseImage {image :: BaseImage -> Image
image = Image Maybe Registry
_ Text
als} (Acc BaseImage
_ Map Text Int
stages Map Int BaseImage
o) =
  BaseImage -> Map Text Int -> Map Int BaseImage -> Acc
Acc BaseImage
stage (Text -> Int -> Map Text Int -> Map Text Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
als Int
line Map Text Int
stages) Map Int BaseImage
o

rememberLine :: Linenumber -> Acc -> Acc
rememberLine :: Int -> Acc -> Acc
rememberLine Int
line Acc
Empty = BaseImage -> Map Text Int -> Map Int BaseImage -> Acc
Acc BaseImage
scratch Map Text Int
forall a. Monoid a => a
mempty (Int -> BaseImage -> Map Int BaseImage
forall k a. k -> a -> Map k a
Map.singleton Int
line BaseImage
scratch)
rememberLine Int
line (Acc BaseImage
from Map Text Int
stages Map Int BaseImage
o) = BaseImage -> Map Text Int -> Map Int BaseImage -> Acc
Acc BaseImage
from Map Text Int
stages (Int -> BaseImage -> Map Int BaseImage -> Map Int BaseImage
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
line BaseImage
from Map Int BaseImage
o)

yarnInstall :: Shell.Command -> Bool
yarnInstall :: Command -> Bool
yarnInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"yarn" [Text
"install"]

yarnCacheClean :: Shell.Command -> Bool
yarnCacheClean :: Command -> Bool
yarnCacheClean = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"yarn" [Text
"cache", Text
"clean"]

isCleanBeforeInstall :: Shell.ParsedShell -> Bool
isCleanBeforeInstall :: ParsedShell -> Bool
isCleanBeforeInstall ParsedShell
args =
  case ( (Command -> Bool) -> ParsedShell -> Maybe Int
Shell.findCommandIndex Command -> Bool
yarnCacheClean ParsedShell
args,
         (Command -> Bool) -> ParsedShell -> Maybe Int
Shell.findCommandIndex Command -> Bool
yarnInstall ParsedShell
args
       ) of
    (Just Int
cleanIdx, Just Int
installIdx) -> Int
cleanIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
installIdx
    (Maybe Int, Maybe Int)
_ -> Bool
False

-- | This is needed as placeholder when no FROM statement has yet been
-- encountered.
scratch :: BaseImage
scratch :: BaseImage
scratch =
  ( BaseImage
      { image :: Image
image = Image
"scratch",
        tag :: Maybe Tag
tag = Maybe Tag
forall a. Maybe a
Nothing,
        digest :: Maybe Digest
digest = Maybe Digest
forall a. Maybe a
Nothing,
        alias :: Maybe ImageAlias
alias = Maybe ImageAlias
forall a. Maybe a
Nothing,
        platform :: Maybe Text
platform = Maybe Text
forall a. Maybe a
Nothing
      }
  )