module Hadolint.Rule.DL3041 (rule) where

import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import Hadolint.Rule
import qualified Hadolint.Shell as Shell
import Language.Docker.Syntax
import Data.Char (isDigit, isAsciiUpper, isAsciiLower)


data Acc
  = Acc { Acc -> Int
stageIdx :: Int,
          Acc -> Map Int Text
stageAliases :: Map.Map Int Text.Text,
          Acc -> Map Int (Set Text)
envs :: Map.Map Int (Set.Set Text.Text),
          Acc -> Set Text
args :: Set.Set Text.Text
        }
  | 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
dl3041 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
dl3041
{-# INLINEABLE rule #-}

dl3041 :: Rule Shell.ParsedShell
dl3041 :: Rule ParsedShell
dl3041 = (Int -> State Acc -> Instruction ParsedShell -> State Acc)
-> State Acc -> Rule ParsedShell
forall a args.
(Int -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Int -> State Acc -> Instruction ParsedShell -> State Acc
check (Acc -> State Acc
forall a. a -> State a
emptyState Acc
Empty)
  where
    code :: RuleCode
code = RuleCode
"DL3041"
    severity :: DLSeverity
severity = DLSeverity
DLWarningC
    message :: Text
message = Text
"Specify version with `dnf install -y <package>-<version>`."

    check :: Int -> State Acc -> Instruction ParsedShell -> State Acc
check Int
line State Acc
st (Run (RunArgs Arguments ParsedShell
a RunFlags
_))
      | (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( Acc -> Text -> Bool
packageVersionFixed ( State Acc -> Acc
forall a. State a -> a
state State Acc
st ) ) ([Text] -> Bool) -> (ParsedShell -> [Text]) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Text]
dnfPackages) Arguments ParsedShell
a
          Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a b. (a -> b) -> Arguments a -> b
foldArguments ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
moduleVersionFixed ([Text] -> Bool) -> (ParsedShell -> [Text]) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Text]
dnfModules) Arguments ParsedShell
a = 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 {Int
Text
RuleCode
DLSeverity
code :: RuleCode
severity :: DLSeverity
message :: Text
line :: Int
line :: Int
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
    check Int
_ 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
registerEnvs Pairs
pairs)
    check Int
_ State Acc
st (Arg Text
arg Maybe Text
_) = 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 (Text -> Acc -> Acc
registerArg Text
arg)
    check Int
_ State Acc
st (From BaseImage
bi) = 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
newStage BaseImage
bi)
    check Int
_ State Acc
st Instruction ParsedShell
_ = State Acc
st
{-# INLINEABLE dl3041 #-}


dnfCmds :: [Text.Text]
dnfCmds :: [Text]
dnfCmds = [Text
"dnf", Text
"microdnf"]

dnfPackages :: Shell.ParsedShell -> [Text.Text]
dnfPackages :: ParsedShell -> [Text]
dnfPackages ParsedShell
args =
    [ Text
arg
      | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args,
        Bool -> Bool
not ([Text] -> [Text] -> Command -> Bool
Shell.cmdsHaveArgs [Text]
dnfCmds [Text
"module", Text
"group"] Command
cmd),
        Text
arg <- Command -> [Text]
installFilter Command
cmd
    ]

packageVersionFixed :: Acc -> Text.Text -> Bool
packageVersionFixed :: Acc -> Text -> Bool
packageVersionFixed Acc
acc Text
package
  | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
parts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Bool
False  -- No dashes, definitively no version
  | Text
".rpm" Text -> Text -> Bool
`Text.isSuffixOf` Text
package = Bool
True  -- rpm files always have a version
  | Text
"$" Text -> Text -> Bool
`Text.isInfixOf` Text
package = Acc -> Text -> Bool
envDefined Acc
acc Text
package
  | Bool
otherwise = [Text] -> Bool
isVersionLike ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 [Text]
parts
  where
    parts :: [Text]
parts = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"-" Text
package

envDefined :: Acc -> Text.Text -> Bool
envDefined :: Acc -> Text -> Bool
envDefined Acc
Empty Text
_ = Bool
False
envDefined (Acc Int
stageIdx Map Int Text
_ Map Int (Set Text)
envs Set Text
args) Text
package =
  (Text -> Bool) -> Set Text -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`varInText` Text
package) (Map Int (Set Text) -> Set Text
forall {a}. Map Int (Set a) -> Set a
thisStage Map Int (Set Text)
envs)
    Bool -> Bool -> Bool
|| (Text -> Bool) -> Set Text -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`varInText` Text
package) Set Text
args
  where
    thisStage :: Map Int (Set a) -> Set a
thisStage Map Int (Set a)
envsMap = Set a -> Maybe (Set a) -> Set a
forall a. a -> Maybe a -> a
Maybe.fromMaybe Set a
forall a. Set a
Set.empty (Maybe (Set a) -> Set a) -> Maybe (Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
stageIdx Map Int (Set a)
envsMap

varInText :: Text.Text -> Text.Text -> Bool
varInText :: Text -> Text -> Bool
varInText Text
var Text
txt =
  ( String -> Text
Text.pack String
"${" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"}" ) Text -> Text -> Bool
`Text.isInfixOf` Text
txt

isVersionLike :: [Text.Text] -> Bool
isVersionLike :: [Text] -> Bool
isVersionLike [Text]
parts =
  case [Text]
parts of
    [] -> Bool
False  -- No parts after splitting by hyphen
    [Text]
_ -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
partIsValid [Text]
parts Bool -> Bool -> Bool
&& (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
partStartsWithDigit [Text]
parts
  where
    partIsValid :: Text -> Bool
partIsValid = (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isVersionChar
    partStartsWithDigit :: Text -> Bool
partStartsWithDigit Text
part = case Text -> Maybe (Char, Text)
Text.uncons Text
part of
                                 Just (Char
c, Text
_) -> Char -> Bool
isDigit Char
c
                                 Maybe (Char, Text)
Nothing -> Bool
False -- Empty Text

isVersionChar :: Char -> Bool
isVersionChar :: Char -> Bool
isVersionChar Char
c =
  Char -> Bool
isDigit Char
c
    Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c
    Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
c
    Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'.', Char
'~', Char
'^', Char
'_', Char
':', Char
'+']

dnfModules :: Shell.ParsedShell -> [Text.Text]
dnfModules :: ParsedShell -> [Text]
dnfModules ParsedShell
args =
  [ Text
arg
    | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args,
      [Text] -> [Text] -> Command -> Bool
Shell.cmdsHaveArgs [Text]
dnfCmds [Text
"module"] Command
cmd,
      Text
arg <- Command -> [Text]
installFilter Command
cmd
  ]

moduleVersionFixed :: Text.Text -> Bool
moduleVersionFixed :: Text -> Bool
moduleVersionFixed = Text -> Text -> Bool
Text.isInfixOf Text
":"

installFilter :: Shell.Command -> [Text.Text]
installFilter :: Command -> [Text]
installFilter Command
cmd =
  [ Text
arg
    | [Text] -> [Text] -> Command -> Bool
Shell.cmdsHaveArgs [Text]
dnfCmds [Text
"install"] Command
cmd,
      Text
arg <- Command -> [Text]
Shell.getArgsNoFlags Command
cmd,
      Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install",
      Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"module"
  ]

registerEnvs :: Pairs -> Acc -> Acc
registerEnvs :: Pairs -> Acc -> Acc
registerEnvs Pairs
pairs Acc
Empty =
  Acc
    { stageIdx :: Int
stageIdx = Int
0,
      stageAliases :: Map Int Text
stageAliases = Int -> Text -> Map Int Text
forall k a. k -> a -> Map k a
Map.singleton Int
0 (String -> Text
Text.pack String
""),
      envs :: Map Int (Set Text)
envs = Int -> Set Text -> Map Int (Set Text)
forall k a. k -> a -> Map k a
Map.singleton Int
0 ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList (((Text, Text) -> Text) -> Pairs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst Pairs
pairs)),
      args :: Set Text
args = Set Text
forall a. Set a
Set.empty
    }
registerEnvs Pairs
pairs (Acc Int
stageIdx Map Int Text
stageAliases Map Int (Set Text)
envs Set Text
args) =
  Acc
    { Int
stageIdx :: Int
stageIdx :: Int
stageIdx,
      Map Int Text
stageAliases :: Map Int Text
stageAliases :: Map Int Text
stageAliases,
      envs :: Map Int (Set Text)
envs = (Set Text -> Set Text)
-> Int -> Map Int (Set Text) -> Map Int (Set Text)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Set Text -> Set Text
stageEnvs Int
stageIdx Map Int (Set Text)
envs,
      Set Text
args :: Set Text
args :: Set Text
args
    }
  where
    stageEnvs :: Set Text -> Set Text
stageEnvs = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList (((Text, Text) -> Text) -> Pairs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst Pairs
pairs))

registerArg :: Text.Text -> Acc -> Acc
registerArg :: Text -> Acc -> Acc
registerArg Text
arg Acc
Empty =
  Acc
    { stageIdx :: Int
stageIdx = Int
0,
      stageAliases :: Map Int Text
stageAliases = Int -> Text -> Map Int Text
forall k a. k -> a -> Map k a
Map.singleton Int
0 (String -> Text
Text.pack String
""),
      envs :: Map Int (Set Text)
envs = Int -> Set Text -> Map Int (Set Text)
forall k a. k -> a -> Map k a
Map.singleton Int
0 Set Text
forall a. Set a
Set.empty,
      args :: Set Text
args = Text -> Set Text
forall a. a -> Set a
Set.singleton Text
arg
    }
registerArg Text
arg (Acc Int
stageIdx Map Int Text
stageAliases Map Int (Set Text)
envs Set Text
args) =
  Acc
    { Int
stageIdx :: Int
stageIdx :: Int
stageIdx,
      Map Int Text
stageAliases :: Map Int Text
stageAliases :: Map Int Text
stageAliases,
      Map Int (Set Text)
envs :: Map Int (Set Text)
envs :: Map Int (Set Text)
envs,
      args :: Set Text
args = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
arg Set Text
args
    }

newStage :: BaseImage -> Acc -> Acc
newStage :: BaseImage -> Acc -> Acc
newStage (BaseImage Image
_ Maybe Tag
_ Maybe Digest
_ Maybe ImageAlias
Nothing Maybe Text
_) Acc
Empty =
  Acc
    { stageIdx :: Int
stageIdx = Int
1,
      stageAliases :: Map Int Text
stageAliases = Int -> Text -> Map Int Text
forall k a. k -> a -> Map k a
Map.singleton Int
1 (String -> Text
Text.pack String
""),
      envs :: Map Int (Set Text)
envs = Int -> Set Text -> Map Int (Set Text)
forall k a. k -> a -> Map k a
Map.singleton Int
1 Set Text
forall a. Set a
Set.empty,
      args :: Set Text
args = Set Text
forall a. Set a
Set.empty
    }
newStage (BaseImage Image
_ Maybe Tag
_ Maybe Digest
_ (Just ImageAlias
alias) Maybe Text
_) Acc
Empty =
  Acc
    { stageIdx :: Int
stageIdx = Int
1,
      stageAliases :: Map Int Text
stageAliases = Int -> Text -> Map Int Text
forall k a. k -> a -> Map k a
Map.singleton Int
1 (ImageAlias -> Text
unImageAlias ImageAlias
alias),
      envs :: Map Int (Set Text)
envs = Int -> Set Text -> Map Int (Set Text)
forall k a. k -> a -> Map k a
Map.singleton Int
1 Set Text
forall a. Set a
Set.empty,
      args :: Set Text
args = Set Text
forall a. Set a
Set.empty
    }
newStage (BaseImage Image
image Maybe Tag
_ Maybe Digest
_ Maybe ImageAlias
alias Maybe Text
_) (Acc Int
stageIdx Map Int Text
stageAliases Map Int (Set Text)
envs Set Text
args) =
  Acc
    { stageIdx :: Int
stageIdx = Int
stageIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
      stageAliases :: Map Int Text
stageAliases = Int -> Text -> Map Int Text -> Map Int Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int
stageIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Maybe ImageAlias -> Text
als Maybe ImageAlias
alias) Map Int Text
stageAliases,
      envs :: Map Int (Set Text)
envs = Int -> Set Text -> Map Int (Set Text) -> Map Int (Set Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int
stageIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Set Text
stageEnvs Int
stageIdxOfAlias) Map Int (Set Text)
envs,
      Set Text
args :: Set Text
args :: Set Text
args
    }
  where
    als :: Maybe ImageAlias -> Text.Text
    als :: Maybe ImageAlias -> Text
als Maybe ImageAlias
Nothing = String -> Text
Text.pack String
""
    als (Just ImageAlias
a) = ImageAlias -> Text
unImageAlias ImageAlias
a

    stageIdxOfAlias :: Int
    stageIdxOfAlias :: Int
stageIdxOfAlias = do
      let l :: [(Int, Text)]
l = Map Int Text -> [(Int, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList ((Text -> Bool) -> Map Int Text -> Map Int Text
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Image -> Text
imageName Image
image) Map Int Text
stageAliases)
       in case [(Int, Text)]
l of
            [] -> Int
stageIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            (Int, Text)
x:[(Int, Text)]
_ -> (Int, Text) -> Int
forall a b. (a, b) -> a
fst (Int, Text)
x

    stageEnvs :: Int -> Set.Set Text.Text
    stageEnvs :: Int -> Set Text
stageEnvs Int
idx = Set Text -> Maybe (Set Text) -> Set Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Set Text
forall a. Set a
Set.empty (Maybe (Set Text) -> Set Text) -> Maybe (Set Text) -> Set Text
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (Set Text) -> Maybe (Set Text)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
idx Map Int (Set Text)
envs