module Hadolint.Rule.DL3009 (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 Language.Docker.Syntax

data Acc
  = Acc
      { Acc -> BaseImage
lastFrom :: BaseImage,
        Acc -> Map Text Linenumber
stages :: Map.Map Text.Text Linenumber,
        Acc -> Map Linenumber BaseImage
forgets :: Map.Map Linenumber BaseImage
      }
  | 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)

rule :: Rule Shell.ParsedShell
rule :: Rule ParsedShell
rule = (Linenumber -> State Acc -> Instruction ParsedShell -> State Acc)
-> State Acc -> (State Acc -> Failures) -> Rule ParsedShell
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule Linenumber -> 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
"DL3009"
    severity :: DLSeverity
severity = DLSeverity
DLInfoC
    message :: Text
message = Text
"Delete the apt-get lists after installing something"

    check :: Linenumber -> State Acc -> Instruction ParsedShell -> State Acc
check Linenumber
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 (Linenumber -> BaseImage -> Acc -> Acc
rememberStage Linenumber
line BaseImage
from)
    check Linenumber
line State Acc
st (Run (RunArgs Arguments ParsedShell
args RunFlags
flags))
      | RunFlags -> Bool
hasNoCacheMount RunFlags
flags Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ParsedShell -> Bool
forgotToCleanup 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 (Linenumber -> Acc -> Acc
rememberLine Linenumber
line)
      | Bool
otherwise = State Acc
st
    check Linenumber
_ State Acc
st Instruction ParsedShell
_ = State Acc
st

    -- Convert the final state into failures
    markFailures :: State Acc -> Failures
markFailures (State Failures
fails Acc
Empty) = Failures
fails
    markFailures (State Failures
_ Acc {Map Linenumber BaseImage
Map Text Linenumber
BaseImage
forgets :: Map Linenumber BaseImage
stages :: Map Text Linenumber
lastFrom :: BaseImage
forgets :: Acc -> Map Linenumber BaseImage
stages :: Acc -> Map Text Linenumber
lastFrom :: Acc -> BaseImage
..}) = Map Linenumber BaseImage
forgets Map Linenumber BaseImage
-> (Map Linenumber BaseImage -> Failures) -> Failures
forall a b. a -> (a -> b) -> b
|> (Linenumber -> BaseImage -> Failures)
-> Map Linenumber BaseImage -> Failures
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Linenumber -> BaseImage -> Failures
forall (f :: * -> *).
(Applicative f, Monoid (f CheckFailure)) =>
Linenumber -> BaseImage -> f CheckFailure
mapFail
      where
        mapFail :: Linenumber -> BaseImage -> f CheckFailure
mapFail Linenumber
line BaseImage
from
          | BaseImage
from BaseImage -> BaseImage -> Bool
forall a. Eq a => a -> a -> Bool
== BaseImage
lastFrom = CheckFailure -> f CheckFailure
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
..}
          | BaseImage {$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Just (ImageAlias Text
als)} <- BaseImage
from, -- Check if this stage is used later
            Just Linenumber
_ <- Text -> Map Text Linenumber -> Maybe Linenumber
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
als Map Text Linenumber
stages =
            -- If the same alias is used in another stage, fail
            CheckFailure -> f CheckFailure
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
..}
          | Bool
otherwise = f CheckFailure
forall a. Monoid a => a
mempty
{-# INLINEABLE rule #-}

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

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

forgotToCleanup :: Shell.ParsedShell -> Bool
forgotToCleanup :: ParsedShell -> Bool
forgotToCleanup ParsedShell
args
  | Bool
hasUpdate Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasCleanup = Bool
True
  | Bool
otherwise = Bool
False
  where
    hasCleanup :: Bool
hasCleanup =
      (Command -> Bool) -> [Command] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"rm" [Text
"-rf", Text
"/var/lib/apt/lists/*"]) (ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args)

    hasUpdate :: Bool
hasUpdate = (Command -> Bool) -> [Command] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apt-get" [Text
"update"]) (ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args)

hasNoCacheMount :: RunFlags -> Bool
hasNoCacheMount :: RunFlags -> Bool
hasNoCacheMount RunFlags
  { $sel:mount:RunFlags :: RunFlags -> Maybe RunMount
mount =
      Just (CacheMount CacheOpts {$sel:cTarget:CacheOpts :: CacheOpts -> TargetPath
cTarget = TargetPath {$sel:unTargetPath:TargetPath :: TargetPath -> Text
unTargetPath = Text
p}})
  } = (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"/var/lib/apt/lists"
hasNoCacheMount RunFlags {} = Bool
True

-- | Even though dockerfiles without a FROM are not valid, we still want to provide some feedback for this rule
-- so we pretend there is a base image at the start of the file if there is none
emptyImage :: BaseImage
emptyImage :: BaseImage
emptyImage = (BaseImage :: Image
-> Maybe Tag
-> Maybe Digest
-> Maybe ImageAlias
-> Maybe Text
-> BaseImage
BaseImage {$sel:image:BaseImage :: Image
image = Image
"scratch", $sel:tag:BaseImage :: Maybe Tag
tag = Maybe Tag
forall a. Maybe a
Nothing, $sel:digest:BaseImage :: Maybe Digest
digest = Maybe Digest
forall a. Maybe a
Nothing, $sel:alias:BaseImage :: Maybe ImageAlias
alias = Maybe ImageAlias
forall a. Maybe a
Nothing, $sel:platform:BaseImage :: Maybe Text
platform = Maybe Text
forall a. Maybe a
Nothing})