module Hadolint.Rule.DL4001 (rule) where

import qualified Data.IntSet as Set
import Hadolint.Rule
import qualified Hadolint.Shell as Shell
import Language.Docker.Syntax (Instruction (..), RunArgs (..))


rule :: Rule Shell.ParsedShell
rule :: Rule ParsedShell
rule = Rule ParsedShell
dl4001 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
dl4001

dl4001 :: Rule Shell.ParsedShell
dl4001 :: Rule ParsedShell
dl4001 = (Linenumber
 -> State IntSet -> Instruction ParsedShell -> State IntSet)
-> State IntSet -> Rule ParsedShell
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Linenumber
-> State IntSet -> Instruction ParsedShell -> State IntSet
check (IntSet -> State IntSet
forall a. a -> State a
emptyState IntSet
Set.empty)
  where
    code :: RuleCode
code = RuleCode
"DL4001"
    severity :: DLSeverity
severity = DLSeverity
DLWarningC
    message :: Text
message = Text
"Either use Wget or Curl but not both"

    check :: Linenumber
-> State IntSet -> Instruction ParsedShell -> State IntSet
check Linenumber
line State IntSet
st (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      let newArgs :: IntSet
newArgs = (ParsedShell -> IntSet) -> Arguments ParsedShell -> IntSet
forall a b. (a -> b) -> Arguments a -> b
foldArguments ParsedShell -> IntSet
extractCommands Arguments ParsedShell
args
          newState :: State IntSet
newState = State IntSet
st State IntSet -> (State IntSet -> State IntSet) -> State IntSet
forall a b. a -> (a -> b) -> b
|> (IntSet -> IntSet) -> State IntSet -> State IntSet
forall a. (a -> a) -> State a -> State a
modify (IntSet -> IntSet -> IntSet
Set.union IntSet
newArgs)
       in if IntSet -> Linenumber
Set.size IntSet
newArgs Linenumber -> Linenumber -> Bool
forall a. Ord a => a -> a -> Bool
> Linenumber
0 Bool -> Bool -> Bool
&& IntSet -> Linenumber
Set.size (State IntSet -> IntSet
forall a. State a -> a
state State IntSet
newState) Linenumber -> Linenumber -> Bool
forall a. Ord a => a -> a -> Bool
>= Linenumber
2
            then State IntSet
newState State IntSet -> (State IntSet -> State IntSet) -> State IntSet
forall a b. a -> (a -> b) -> b
|> CheckFailure -> State IntSet -> State IntSet
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
..})
            else State IntSet
newState
    -- Reset the state for each stage
    check Linenumber
_ State IntSet
st From {} = State IntSet
st State IntSet -> (State IntSet -> State IntSet) -> State IntSet
forall a b. a -> (a -> b) -> b
|> IntSet -> State IntSet -> State IntSet
forall a. a -> State a -> State a
replaceWith IntSet
Set.empty
    check Linenumber
_ State IntSet
st Instruction ParsedShell
_ = State IntSet
st
{-# INLINEABLE rule #-}

extractCommands :: Shell.ParsedShell -> Set.IntSet
extractCommands :: ParsedShell -> IntSet
extractCommands ParsedShell
args =
  [Linenumber] -> IntSet
Set.fromList
    [ if Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"curl" then Linenumber
0 else Linenumber
1
      | Text
w <- ParsedShell -> [Text]
Shell.findCommandNames ParsedShell
args,
        Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"curl" Bool -> Bool -> Bool
|| Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"wget"
    ]