module Hadolint.Rule.DL3042 (rule) where

import Data.List (isInfixOf)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isNothing, isJust, fromJust)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Hadolint.Rule
import qualified Hadolint.Shell as Shell
import Language.Docker.Syntax


-- This data encapsulates the name of a build stage. It may be None withing an
-- `ONBUILD` context.
data Stage
  = Stage {Stage -> Text
stage :: Text}
  | None
  deriving (Stage -> Stage -> Bool
(Stage -> Stage -> Bool) -> (Stage -> Stage -> Bool) -> Eq Stage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stage -> Stage -> Bool
$c/= :: Stage -> Stage -> Bool
== :: Stage -> Stage -> Bool
$c== :: Stage -> Stage -> Bool
Eq, Eq Stage
Eq Stage
-> (Stage -> Stage -> Ordering)
-> (Stage -> Stage -> Bool)
-> (Stage -> Stage -> Bool)
-> (Stage -> Stage -> Bool)
-> (Stage -> Stage -> Bool)
-> (Stage -> Stage -> Stage)
-> (Stage -> Stage -> Stage)
-> Ord Stage
Stage -> Stage -> Bool
Stage -> Stage -> Ordering
Stage -> Stage -> Stage
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 :: Stage -> Stage -> Stage
$cmin :: Stage -> Stage -> Stage
max :: Stage -> Stage -> Stage
$cmax :: Stage -> Stage -> Stage
>= :: Stage -> Stage -> Bool
$c>= :: Stage -> Stage -> Bool
> :: Stage -> Stage -> Bool
$c> :: Stage -> Stage -> Bool
<= :: Stage -> Stage -> Bool
$c<= :: Stage -> Stage -> Bool
< :: Stage -> Stage -> Bool
$c< :: Stage -> Stage -> Bool
compare :: Stage -> Stage -> Ordering
$ccompare :: Stage -> Stage -> Ordering
$cp1Ord :: Eq Stage
Ord)

data Acc
  = Acc {Acc -> Stage
current :: Stage, Acc -> Map Stage Bool
noCacheMap :: Map Stage Bool}
  | Empty


rule :: Rule Shell.ParsedShell
rule :: Rule ParsedShell
rule = (Linenumber -> State Acc -> Instruction ParsedShell -> State Acc)
-> State Acc -> Rule ParsedShell
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Linenumber -> State Acc -> Instruction ParsedShell -> State Acc
check (Acc -> State Acc
forall a. a -> State a
emptyState Acc
Empty)
  where
    code :: RuleCode
code = RuleCode
"DL3042"
    severity :: DLSeverity
severity = DLSeverity
DLWarningC
    message :: Text
message = Text
"Avoid use of cache directory with pip.\
              \ Use `pip install --no-cache-dir <package>`"
    check :: Linenumber -> State Acc -> Instruction ParsedShell -> State Acc
check Linenumber
_ 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 (BaseImage -> Acc -> Acc
rememberStage BaseImage
from)
    check Linenumber
_ State Acc
st (Env Pairs
pairs) = 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 (Pairs -> Acc -> Acc
registerEnv Pairs
pairs)
    check Linenumber
line State Acc
st (Run (RunArgs Arguments ParsedShell
args RunFlags
_))
      | Acc Stage
s Map Stage Bool
ncm <- State Acc -> Acc
forall a. State a -> a
state State Acc
st, Just Bool
True <- Stage -> Map Stage Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Stage
s Map Stage Bool
ncm = State Acc
st
      | (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ParsedShell -> Bool
pipNoCacheDirIsSet Arguments ParsedShell
args = State Acc
st
      | (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotNoCacheDir) Arguments ParsedShell
args = State Acc
st
      | Bool
otherwise = State Acc
st State Acc -> (State Acc -> State Acc) -> State Acc
forall a b. a -> (a -> b) -> b
|> CheckFailure -> State Acc -> State Acc
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 Acc
st Instruction ParsedShell
_ = State Acc
st
{-# INLINEABLE rule #-}

forgotNoCacheDir :: Shell.Command -> Bool
forgotNoCacheDir :: Command -> Bool
forgotNoCacheDir Command
cmd =  Command -> Bool
Shell.isPipInstall Command
cmd
    Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
usesNoCacheDir Command
cmd)
    Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
isPipWrapper Command
cmd)

usesNoCacheDir :: Shell.Command -> Bool
usesNoCacheDir :: Command -> Bool
usesNoCacheDir Command
cmd = Text
"--no-cache-dir" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Command -> [Text]
Shell.getArgs Command
cmd

pipNoCacheDirIsSet :: Shell.ParsedShell -> Bool
pipNoCacheDirIsSet :: ParsedShell -> Bool
pipNoCacheDirIsSet ParsedShell
shell = (Text -> Bool) -> Set Text -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
  (Text -> Text -> Bool
`Text.isPrefixOf` Linenumber -> Text -> Text
Text.drop Linenumber
1
    ((Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')
      ((Text, Text) -> Text
forall a b. (a, b) -> b
snd
        (Text -> Text -> (Text, Text)
Text.breakOn Text
"PIP_NO_CACHE_DIR=" (ParsedShell -> Text
Shell.original ParsedShell
shell)
        )
      )
    )
  ) Set Text
truthy

isPipWrapper :: Shell.Command -> Bool
isPipWrapper :: Command -> Bool
isPipWrapper cmd :: Command
cmd@(Shell.Command Text
name [CmdPart]
_ [CmdPart]
_) = Text -> Bool
isWrapper Text
"pipx" Bool -> Bool -> Bool
|| Text -> Bool
isWrapper Text
"pipenv"
  where
    isWrapper :: Text.Text -> Bool
    isWrapper :: Text -> Bool
isWrapper Text
w =
      Text
w Text -> Text -> Bool
`Text.isInfixOf` Text
name
        Bool -> Bool -> Bool
|| (Text
"python" Text -> Text -> Bool
`Text.isPrefixOf` Text
name Bool -> Bool -> Bool
&& [Text
"-m", Text
w] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
Shell.getArgs Command
cmd)

rememberStage :: BaseImage -> Acc -> Acc
rememberStage :: BaseImage -> Acc -> Acc
rememberStage BaseImage {$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Just ImageAlias
als} Acc
Empty =
  Acc :: Stage -> Map Stage Bool -> Acc
Acc
    { current :: Stage
current = Stage :: Text -> Stage
Stage {stage :: Text
stage = ImageAlias -> Text
unImageAlias ImageAlias
als},
      noCacheMap :: Map Stage Bool
noCacheMap = Map Stage Bool
forall a. Monoid a => a
mempty
    }
rememberStage BaseImage {$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Maybe ImageAlias
Nothing, Image
$sel:image:BaseImage :: BaseImage -> Image
image :: Image
image} Acc
Empty =
  Acc :: Stage -> Map Stage Bool -> Acc
Acc
    { current :: Stage
current = Stage :: Text -> Stage
Stage {stage :: Text
stage = Image -> Text
imageName Image
image},
      noCacheMap :: Map Stage Bool
noCacheMap = Map Stage Bool
forall a. Monoid a => a
mempty
    }
rememberStage BaseImage {$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Just ImageAlias
als, Image
image :: Image
$sel:image:BaseImage :: BaseImage -> Image
image} Acc {Map Stage Bool
Stage
noCacheMap :: Map Stage Bool
current :: Stage
noCacheMap :: Acc -> Map Stage Bool
current :: Acc -> Stage
..} =
  Acc :: Stage -> Map Stage Bool -> Acc
Acc
    { current :: Stage
current = Stage :: Text -> Stage
Stage {stage :: Text
stage = ImageAlias -> Text
unImageAlias ImageAlias
als},
      noCacheMap :: Map Stage Bool
noCacheMap =
        let parentValue :: Bool
parentValue =
              Stage -> Map Stage Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Stage :: Text -> Stage
Stage {stage :: Text
stage = Image -> Text
imageName Image
image}) Map Stage Bool
noCacheMap Maybe Bool -> (Maybe Bool -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
|> Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False
         in Map Stage Bool
noCacheMap Map Stage Bool
-> (Map Stage Bool -> Map Stage Bool) -> Map Stage Bool
forall a b. a -> (a -> b) -> b
|> Stage -> Bool -> Map Stage Bool -> Map Stage Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Stage :: Text -> Stage
Stage {stage :: Text
stage = ImageAlias -> Text
unImageAlias ImageAlias
als}) Bool
parentValue
    }
rememberStage BaseImage {$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Maybe ImageAlias
Nothing, Image
image :: Image
$sel:image:BaseImage :: BaseImage -> Image
image} Acc {Map Stage Bool
Stage
noCacheMap :: Map Stage Bool
current :: Stage
noCacheMap :: Acc -> Map Stage Bool
current :: Acc -> Stage
..} =
  Acc :: Stage -> Map Stage Bool -> Acc
Acc
    { current :: Stage
current = Stage :: Text -> Stage
Stage {stage :: Text
stage = Image -> Text
imageName Image
image},
      noCacheMap :: Map Stage Bool
noCacheMap =
        let parentValue :: Bool
parentValue =
              Stage -> Map Stage Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Stage :: Text -> Stage
Stage {stage :: Text
stage = Image -> Text
imageName Image
image}) Map Stage Bool
noCacheMap Maybe Bool -> (Maybe Bool -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
|> Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False
         in Map Stage Bool
noCacheMap Map Stage Bool
-> (Map Stage Bool -> Map Stage Bool) -> Map Stage Bool
forall a b. a -> (a -> b) -> b
|> Stage -> Bool -> Map Stage Bool -> Map Stage Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Stage :: Text -> Stage
Stage {stage :: Text
stage = Image -> Text
imageName Image
image}) Bool
parentValue
    }

registerEnv :: Pairs -> Acc -> Acc
registerEnv :: Pairs -> Acc -> Acc
registerEnv Pairs
pairs Acc
Empty
  | Pairs -> Bool
pipNoCacheDirSet Pairs
pairs =
    Acc :: Stage -> Map Stage Bool -> Acc
Acc {current :: Stage
current = Stage
None, noCacheMap :: Map Stage Bool
noCacheMap = Stage -> Bool -> Map Stage Bool -> Map Stage Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Stage
None Bool
True Map Stage Bool
forall k a. Map k a
Map.empty}
  | Bool
otherwise = Acc
Empty
registerEnv Pairs
pairs Acc {Map Stage Bool
Stage
noCacheMap :: Map Stage Bool
current :: Stage
noCacheMap :: Acc -> Map Stage Bool
current :: Acc -> Stage
..}
  | Pairs -> Bool
pipNoCacheDirSet Pairs
pairs =
    Acc :: Stage -> Map Stage Bool -> Acc
Acc {Stage
current :: Stage
current :: Stage
current, noCacheMap :: Map Stage Bool
noCacheMap = Stage -> Bool -> Map Stage Bool -> Map Stage Bool
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Stage
current Bool
True Map Stage Bool
noCacheMap}
  | Bool
otherwise = Acc :: Stage -> Map Stage Bool -> Acc
Acc {Map Stage Bool
Stage
noCacheMap :: Map Stage Bool
current :: Stage
noCacheMap :: Map Stage Bool
current :: Stage
..}

pipNoCacheDirSet :: Pairs -> Bool
pipNoCacheDirSet :: Pairs -> Bool
pipNoCacheDirSet [] = Bool
False
pipNoCacheDirSet Pairs
pairs
  | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> Pairs -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"PIP_NO_CACHE_DIR" Pairs
pairs) = Bool
False
  | Maybe Text
val <- Text -> Pairs -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"PIP_NO_CACHE_DIR" Pairs
pairs,
    Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
val Bool -> Bool -> Bool
&& Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
val Text -> Set Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Set Text
truthy = Bool
False
  | Bool
otherwise = Bool
True

truthy :: Set Text
truthy :: Set Text
truthy = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
"1", Text
"true", Text
"True", Text
"TRUE", Text
"on", Text
"On", Text
"ON", Text
"yes", Text
"Yes", Text
"YES"]