module Hadolint.Rule.DL3016 (rule) where

import Data.List (isPrefixOf)
import qualified Data.Text as Text
import Hadolint.Rule
import Hadolint.Shell (ParsedShell)
import qualified Hadolint.Shell as Shell
import Language.Docker.Syntax (Instruction (..), RunArgs (..))

-- | Rule for pinning NPM packages to version, tag, or commit
--  supported formats by Hadolint
--    npm install (with no args, in package dir)
--    npm install [<@scope>/]<name>
--    npm install [<@scope>/]<name>@<tag>
--    npm install [<@scope>/]<name>@<version>
--    npm install git[+http|+https]://<git-host>/<git-user>/<repo-name>[#<commit>|#semver:<semver>]
--    npm install git+ssh://<git-host>:<git-user>/<repo-name>[#<commit>|#semver:<semver>]
rule :: Rule ParsedShell
rule :: Rule ParsedShell
rule = RuleCode
-> DLSeverity
-> Text
-> (Instruction ParsedShell -> Bool)
-> Rule ParsedShell
forall args.
RuleCode
-> DLSeverity -> Text -> (Instruction args -> Bool) -> Rule args
simpleRule RuleCode
code DLSeverity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: RuleCode
code = RuleCode
"DL3016"
    severity :: DLSeverity
severity = DLSeverity
DLWarningC
    message :: Text
message =
      Text
"Pin versions in npm. Instead of `npm install <package>` use `npm install \
      \<package>@<version>`"

    check :: Instruction ParsedShell -> Bool
check (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.noCommands Command -> Bool
forgotToPinVersion) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
{-# INLINEABLE rule #-}


forgotToPinVersion :: Shell.Command -> Bool
forgotToPinVersion :: Command -> Bool
forgotToPinVersion Command
cmd =
  Command -> Bool
isNpmInstall Command
cmd Bool -> Bool -> Bool
&& Command -> Bool
installIsFirst Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed (Command -> [Text]
packages Command
cmd))

isNpmInstall :: Shell.Command -> Bool
isNpmInstall :: Command -> Bool
isNpmInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"npm" [Text
"install"]

installIsFirst :: Shell.Command -> Bool
installIsFirst :: Command -> Bool
installIsFirst Command
cmd = [Text
"install"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Command -> [Text]
Shell.getArgsNoFlags
  ([Text] -> Command -> Command
Shell.dropFlagArg [Text]
ignoreFlags Command
cmd)

packages :: Shell.Command -> [Text.Text]
packages :: Command -> [Text]
packages Command
cmd = [Text] -> [Text]
stripInstallPrefix
  (Command -> [Text]
Shell.getArgsNoFlags ([Text] -> Command -> Command
Shell.dropFlagArg [Text]
ignoreFlags Command
cmd))

versionFixed :: Text.Text -> Bool
versionFixed :: Text -> Bool
versionFixed Text
package
  | Text -> Bool
hasGitPrefix Text
package = Text -> Bool
isVersionedGit Text
package
  | Text -> Bool
hasTarballSuffix Text
package = Bool
True
  | Text -> Bool
isFolder Text
package = Bool
True
  | Bool
otherwise = Text -> Bool
hasVersionSymbol Text
package

hasGitPrefix :: Text.Text -> Bool
hasGitPrefix :: Text -> Bool
hasGitPrefix Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
p Text -> Text -> Bool
`Text.isPrefixOf` Text
package | Text
p <- [Text]
gitPrefixes]

hasTarballSuffix :: Text.Text -> Bool
hasTarballSuffix :: Text -> Bool
hasTarballSuffix Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
p Text -> Text -> Bool
`Text.isSuffixOf` Text
package | Text
p <- [Text]
tarballSuffixes]

isFolder :: Text.Text -> Bool
isFolder :: Text -> Bool
isFolder Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
p Text -> Text -> Bool
`Text.isPrefixOf` Text
package | Text
p <- [Text]
pathPrefixes]

isVersionedGit :: Text.Text -> Bool
isVersionedGit :: Text -> Bool
isVersionedGit Text
package = Text
"#" Text -> Text -> Bool
`Text.isInfixOf` Text
package

hasVersionSymbol :: Text.Text -> Bool
hasVersionSymbol :: Text -> Bool
hasVersionSymbol Text
package = Text
"@" Text -> Text -> Bool
`Text.isInfixOf` Text -> Text
dropScope Text
package
  where
    dropScope :: Text -> Text
dropScope Text
pkg =
      if Text
"@" Text -> Text -> Bool
`Text.isPrefixOf` Text
pkg
        then (Char -> Bool) -> Text -> Text
Text.dropWhile (Char
'/' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<) Text
pkg
        else Text
pkg

stripInstallPrefix :: [Text.Text] -> [Text.Text]
stripInstallPrefix :: [Text] -> [Text]
stripInstallPrefix [Text]
cmd = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"install") ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install") [Text]
cmd)


ignoreFlags :: [Text.Text]
ignoreFlags :: [Text]
ignoreFlags = [Text
"loglevel"]

gitPrefixes :: [Text.Text]
gitPrefixes :: [Text]
gitPrefixes = [Text
"git://", Text
"git+ssh://", Text
"git+http://", Text
"git+https://"]

pathPrefixes :: [Text.Text]
pathPrefixes :: [Text]
pathPrefixes = [Text
"/", Text
"./", Text
"../", Text
"~/"]

tarballSuffixes :: [Text.Text]
tarballSuffixes :: [Text]
tarballSuffixes = [Text
".tar", Text
".tar.gz", Text
".tgz"]