hadolint 1.6.6 → 1.7.0

raw patch · 9 files changed

+232/−191 lines, 9 filesdep +megaparsecdep +voiddep −parsecdep ~ShellCheckdep ~language-dockerPVP ok

version bump matches the API change (PVP)

Dependencies added: megaparsec, void

Dependencies removed: parsec

Dependency ranges changed: ShellCheck, language-docker

API changes (from Hackage documentation)

Files

• app/Main.hs +11/−13
• hadolint.cabal +13/−10
• src/Hadolint/Formatter/Checkstyle.hs +17/−13
• src/Hadolint/Formatter/Codeclimate.hs +18/−13
• src/Hadolint/Formatter/Format.hs +7/−19
• src/Hadolint/Formatter/Json.hs +16/−14
• src/Hadolint/Formatter/TTY.hs +20/−13
• src/Hadolint/Rules.hs +90/−61
• test/Spec.hs +40/−35

@@ -5,8 +5,8 @@ module Main where  import Hadolint.Rules-import Language.Docker.Parser-import Language.Docker.Syntax+import Language.Docker (parseFile)+import Language.Docker.Syntax (Dockerfile)  import Control.Applicative import Control.Monad (filterM)@@ -23,15 +23,15 @@         getXdgDirectory) import System.Exit (exitFailure, exitSuccess) import System.FilePath ((</>))-import Text.Parsec (ParseError) +import Data.Text (Text) import qualified Hadolint.Formatter.Checkstyle as Checkstyle import qualified Hadolint.Formatter.Codeclimate as Codeclimate import Hadolint.Formatter.Format (toResult) import qualified Hadolint.Formatter.Json as Json import qualified Hadolint.Formatter.TTY as TTY -type IgnoreRule = String+type IgnoreRule = Text  data OutputFormat     = Json@@ -144,15 +144,6 @@ parseFilename "-" = "/dev/stdin" parseFilename s = s -lintDockerfile :: [IgnoreRule] -> String -> IO (Either ParseError [RuleCheck])-lintDockerfile ignoreRules dockerFile = do-    ast <- parseFile $ parseFilename dockerFile-    return (processedFile ast)-  where-    processedFile = fmap processRules-    processRules fileLines = filter ignoredRules (analyzeAll fileLines)-    ignoredRules = ignoreFilter ignoreRules- getVersion :: String getVersion     | $(gitDescribe) == "UNKNOWN" =@@ -179,6 +170,13 @@             Json -> Json.printResult res             Checkstyle -> Checkstyle.printResult res             CodeclimateJson -> Codeclimate.printResult res >> exitSuccess+    lintDockerfile ignoreRules dockerFile = do+        ast <- parseFile $ parseFilename dockerFile+        return (processedFile ast)+      where+        processedFile = fmap processRules+        processRules fileLines = filter ignoredRules (analyzeAll fileLines)+        ignoredRules = ignoreFilter ignoreRules  analyzeAll :: Dockerfile -> [RuleCheck] analyzeAll = analyze rules

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 913a53c45d2193a9fb13a8dfb47bf647d985298fc2522ce1e369ab2ed1d1a311+-- hash: f6ff47c57b802a33bbcf1b9944fe11fdf7e5c7913120d5bee6c33d93e69df6e2  name:           hadolint-version:        1.6.6+version:        1.7.0 synopsis:       Dockerfile Linter JavaScript API description:    A smarter Dockerfile linter that helps you build best practice Docker images. category:       Development@@ -29,15 +29,16 @@       src   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:-      ShellCheck >=0.4.7+      ShellCheck >=0.5.0     , aeson     , base >=4.8 && <5     , bytestring     , containers-    , language-docker >=5.0.0 && <6-    , parsec >=3.1+    , language-docker >=6.0.1 && <7+    , megaparsec >=6.4     , split >=0.2     , text+    , void   exposed-modules:       Hadolint.Bash       Hadolint.Rules@@ -61,9 +62,10 @@     , filepath     , gitrev >=1.3.1     , hadolint-    , language-docker >=5.0.0 && <6+    , language-docker >=6.0.1 && <7+    , megaparsec >=6.4     , optparse-applicative-    , parsec >=3.1+    , text     , yaml   if !(os(osx))     ld-options: -static -pthread@@ -79,15 +81,16 @@   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:       HUnit >=1.2-    , ShellCheck >=0.4.7+    , ShellCheck >=0.5.0     , aeson     , base >=4.8 && <5     , bytestring >=0.10     , hadolint     , hspec-    , language-docker >=5.0.0 && <6-    , parsec >=3.1+    , language-docker >=6.0.1 && <7+    , megaparsec >=6.4     , split >=0.2+    , text   other-modules:       Paths_hadolint   default-language: Haskell2010

@@ -11,13 +11,17 @@ import Data.Char import Data.Foldable (toList) import Data.List (groupBy)+import qualified Data.List.NonEmpty as NE import Data.Monoid ((<>), mconcat)+import qualified Data.Text as Text import Hadolint.Formatter.Format import Hadolint.Rules (Metadata(..), RuleCheck(..)) import ShellCheck.Interface-import Text.Parsec (ParseError)-import Text.Parsec.Error (errorPos)-import Text.Parsec.Pos+import Text.Megaparsec.Error+       (ParseError, ShowErrorComponent, ShowToken, errorPos,+        parseErrorTextPretty)+import Text.Megaparsec.Pos+       (sourceColumn, sourceLine, sourceName, unPos)  data CheckStyle = CheckStyle     { file :: String@@ -28,28 +32,28 @@     , source :: String     } -errorToCheckStyle :: ParseError -> CheckStyle+errorToCheckStyle :: (ShowToken t, Ord t, ShowErrorComponent e) => ParseError t e -> CheckStyle errorToCheckStyle err =     CheckStyle     { file = sourceName pos-    , line = sourceLine pos-    , column = sourceColumn pos+    , line = unPos (sourceLine pos)+    , column = unPos (sourceColumn pos)     , impact = severityText ErrorC-    , msg = stripNewlines (formatErrorReason err)+    , msg = stripNewlines (parseErrorTextPretty err)     , source = "DL1000"     }   where-    pos = errorPos err+    pos = NE.head (errorPos err)  ruleToCheckStyle :: RuleCheck -> CheckStyle ruleToCheckStyle RuleCheck {..} =     CheckStyle-    { file = filename+    { file = Text.unpack filename     , line = linenumber     , column = 1     , impact = severityText (severity metadata)-    , msg = message metadata-    , source = code metadata+    , msg = Text.unpack (message metadata)+    , source = Text.unpack (code metadata)     }  toXml :: [CheckStyle] -> Builder.Builder@@ -81,7 +85,7 @@             else "&#" ++ show (ord c) ++ ";"     isOk x = any (\check -> check x) [isAsciiUpper, isAsciiLower, isDigit, (`elem` [' ', '.', '/'])] -formatResult :: Result -> Builder.Builder+formatResult :: (ShowToken t, Ord t, ShowErrorComponent e) => Result t e -> Builder.Builder formatResult (Result errors checks) =     "<?xml version='1.0' encoding='UTF-8'?><checkstyle version='4.3'>" <> xmlBody <> "</checkstyle>"   where@@ -92,5 +96,5 @@     checkstyleChecks = fmap ruleToCheckStyle checks     sameFileName CheckStyle {file = f1} CheckStyle {file = f2} = f1 == f2 -printResult :: Result -> IO ()+printResult :: (ShowToken t, Ord t, ShowErrorComponent e) => Result t e -> IO () printResult result = B.putStr (Builder.toLazyByteString (formatResult result))

@@ -9,14 +9,19 @@  import Data.Aeson hiding (Result) import qualified Data.ByteString.Lazy as B+import qualified Data.List.NonEmpty as NE import Data.Monoid ((<>)) import Data.Sequence (Seq)+import qualified Data.Text as Text import GHC.Generics-import Hadolint.Formatter.Format (Result(..), formatErrorReason)+import Hadolint.Formatter.Format (Result(..)) import Hadolint.Rules (Metadata(..), RuleCheck(..)) import ShellCheck.Interface-import Text.Parsec.Error (ParseError, errorPos)-import Text.Parsec.Pos+import Text.Megaparsec.Error+       (ParseError, ShowErrorComponent, ShowToken, errorPos,+        parseErrorTextPretty)+import Text.Megaparsec.Pos+       (sourceColumn, sourceLine, sourceName, unPos)  data Issue = Issue     { checkName :: String@@ -54,25 +59,25 @@             , "severity" .= impact             ] -errorToIssue :: ParseError -> Issue+errorToIssue :: (ShowToken t, Ord t, ShowErrorComponent e) => ParseError t e -> Issue errorToIssue err =     Issue     { checkName = "DL1000"-    , description = formatErrorReason err+    , description = parseErrorTextPretty err     , location = LocPos (sourceName pos) Pos {..}     , impact = severityText ErrorC     }   where-    pos = errorPos err-    line = sourceLine pos-    column = sourceColumn pos+    pos = NE.head (errorPos err)+    line = unPos (sourceLine pos)+    column = unPos (sourceColumn pos)  checkToIssue :: RuleCheck -> Issue checkToIssue RuleCheck {..} =     Issue-    { checkName = code metadata-    , description = message metadata-    , location = LocLine filename linenumber+    { checkName = Text.unpack (code metadata)+    , description = Text.unpack (message metadata)+    , location = LocLine (Text.unpack filename) linenumber     , impact = severityText (severity metadata)     } @@ -84,14 +89,14 @@         InfoC -> "info"         StyleC -> "minor" -formatResult :: Result -> Seq Issue+formatResult :: (ShowToken t, Ord t, ShowErrorComponent e) => Result t e -> Seq Issue formatResult (Result errors checks) = allIssues   where     allIssues = errorMessages <> checkMessages     errorMessages = fmap errorToIssue errors     checkMessages = fmap checkToIssue checks -printResult :: Result -> IO ()+printResult :: (ShowToken t, Ord t, ShowErrorComponent e) => Result t e -> IO () printResult result = mapM_ output (formatResult result)   where     output value = do

@@ -1,6 +1,5 @@ module Hadolint.Formatter.Format-    ( formatErrorReason-    , severityText+    ( severityText     , stripNewlines     , Result(..)     , toResult@@ -12,22 +11,21 @@ import Data.Sequence (Seq, fromList, singleton) import Hadolint.Rules import ShellCheck.Interface-import Text.Parsec.Error-       (ParseError, errorMessages, showErrorMessages)+import Text.Megaparsec.Error (ParseError) -data Result = Result-    { errors :: Seq ParseError+data Result t e = Result+    { errors :: Seq (ParseError t e)     , checks :: Seq RuleCheck     } deriving (Eq) -instance Semigroup Result where+instance Semigroup (Result t e) where     (Result e1 c1) <> (Result e2 c2) = Result (e1 <> e2) (c1 <> c2) -instance Monoid Result where+instance Monoid (Result t e) where     mappend = (<>)     mempty = Result mempty mempty -toResult :: Either ParseError [RuleCheck] -> Result+toResult :: Either (ParseError t e) [RuleCheck] -> Result t e toResult res =     case res of         Left err -> Result (singleton err) mempty@@ -40,16 +38,6 @@         WarningC -> "warning"         InfoC -> "info"         StyleC -> "style"--formatErrorReason :: ParseError -> String-formatErrorReason err =-    showErrorMessages-        "or"-        "unknown parse error"-        "expecting"-        "unexpected"-        "end of input"-        (errorMessages err)  stripNewlines :: String -> String stripNewlines =

@@ -8,20 +8,22 @@  import Data.Aeson hiding (Result) import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.List.NonEmpty as NE import Data.Monoid ((<>))-import Hadolint.Formatter.Format-       (Result(..), formatErrorReason, severityText)+import Hadolint.Formatter.Format (Result(..), severityText) import Hadolint.Rules (Metadata(..), RuleCheck(..)) import ShellCheck.Interface-import Text.Parsec (ParseError)-import Text.Parsec.Error (errorPos)-import Text.Parsec.Pos+import Text.Megaparsec.Error+       (ParseError, ShowErrorComponent, ShowToken, errorPos,+        parseErrorTextPretty)+import Text.Megaparsec.Pos+       (sourceColumn, sourceLine, sourceName, unPos) -data JsonFormat+data JsonFormat t e     = JsonCheck RuleCheck-    | JsonParseError ParseError+    | JsonParseError (ParseError t e) -instance ToJSON JsonFormat where+instance (ShowToken t, Ord t, ShowErrorComponent e) => ToJSON (JsonFormat t e) where     toJSON (JsonCheck RuleCheck {..}) =         object             [ "file" .= filename@@ -34,21 +36,21 @@     toJSON (JsonParseError err) =         object             [ "file" .= sourceName pos-            , "line" .= sourceLine pos-            , "column" .= sourceColumn pos+            , "line" .= unPos (sourceLine pos)+            , "column" .= unPos (sourceColumn pos)             , "level" .= severityText ErrorC             , "code" .= ("DL1000" :: String)-            , "message" .= formatErrorReason err+            , "message" .= parseErrorTextPretty err             ]       where-        pos = errorPos err+        pos = NE.head (errorPos err) -formatResult :: Result -> Value+formatResult :: (ShowToken t, Ord t, ShowErrorComponent e) => Result t e -> Value formatResult (Result errors checks) = toJSON allMessages   where     allMessages = errorMessages <> checkMessages     errorMessages = fmap JsonParseError errors     checkMessages = fmap JsonCheck checks -printResult :: Result -> IO ()+printResult :: (ShowToken t, Ord t, ShowErrorComponent e) => Result t e -> IO () printResult result = B.putStrLn (encode (formatResult result))

@@ -1,36 +1,43 @@ {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}  module Hadolint.Formatter.TTY     ( printResult     , formatError     ) where +import qualified Data.List.NonEmpty as NE+import Data.Semigroup ((<>))+import qualified Data.Text as Text import Hadolint.Formatter.Format import Hadolint.Rules import Language.Docker.Syntax-import Text.Parsec.Error (ParseError, errorPos)-import Text.Parsec.Pos+import Text.Megaparsec.Error+       (ParseError, ShowErrorComponent, ShowToken, errorPos,+        parseErrorTextPretty)+import Text.Megaparsec.Pos (sourcePosPretty) -formatErrors :: Functor t => t ParseError -> t String+formatErrors ::+       (ShowToken t, Ord t, ShowErrorComponent e, Functor f) => f (ParseError t e) -> f String formatErrors = fmap formatError -formatError :: ParseError -> String-formatError err = posPart ++ stripNewlines (formatErrorReason err)+formatError :: (ShowToken t, Ord t, ShowErrorComponent e) => ParseError t e -> String+formatError err = posPart ++ " " ++ stripNewlines (parseErrorTextPretty err)   where-    pos = errorPos err-    posPart = sourceName pos ++ ":" ++ show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)+    pos = NE.head (errorPos err)+    posPart = sourcePosPretty pos -formatChecks :: Functor t => t RuleCheck -> t String+formatChecks :: Functor f => f RuleCheck -> f Text.Text formatChecks = fmap formatCheck   where     formatCheck (RuleCheck meta source line _) =-        formatPos source line ++ code meta ++ " " ++ message meta+        formatPos source line <> code meta <> " " <> message meta -formatPos :: Filename -> Linenumber -> String-formatPos source line = source ++ ":" ++ show line ++ " "+formatPos :: Filename -> Linenumber -> Text.Text+formatPos source line = source <> ":" <> Text.pack (show line) <> " " -printResult :: Result -> IO ()+printResult :: (ShowToken t, Ord t, ShowErrorComponent e) => Result t e -> IO () printResult Result {errors, checks} = printErrors >> printChecks   where     printErrors = mapM_ putStrLn (formatErrors errors)-    printChecks = mapM_ putStrLn (formatChecks checks)+    printChecks = mapM_ (putStrLn . Text.unpack) (formatChecks checks)

@@ -1,25 +1,28 @@ {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}  module Hadolint.Rules where  import Control.Arrow ((&&&))-import Data.List-       (dropWhile, isInfixOf, isPrefixOf, isSuffixOf, mapAccumL)+import Data.List (dropWhile, isInfixOf, isPrefixOf, mapAccumL) import Data.List.NonEmpty (toList) import Data.List.Split (splitOneOf) import Hadolint.Bash import Language.Docker.Syntax +import Data.Semigroup ((<>)) import qualified Data.Set as Set+import qualified Data.Text as Text+import Data.Void (Void) import qualified ShellCheck.Interface import ShellCheck.Interface (Severity(..))-import qualified Text.Parsec as Parsec-import Text.Parsec ((<|>))+import qualified Text.Megaparsec as Megaparsec+import qualified Text.Megaparsec.Char as Megaparsec  data Metadata = Metadata-    { code :: String+    { code :: Text.Text     , severity :: Severity-    , message :: String+    , message :: Text.Text     } deriving (Eq)  -- a check is the application of a rule on a specific part of code@@ -37,10 +40,12 @@ instance Ord RuleCheck where     a `compare` b = linenumber a `compare` linenumber b -link :: Metadata -> String+type IgnoreRuleParser = Megaparsec.Parsec Void Text.Text++link :: Metadata -> Text.Text link (Metadata code _ _)-    | "SC" `isPrefixOf` code = "https://github.com/koalaman/shellcheck/wiki/" ++ code-    | "DL" `isPrefixOf` code = "https://github.com/hadolint/hadolint/wiki/" ++ code+    | "SC" `Text.isPrefixOf` code = "https://github.com/koalaman/shellcheck/wiki/" <> code+    | "DL" `Text.isPrefixOf` code = "https://github.com/hadolint/hadolint/wiki/" <> code     | otherwise = "https://github.com/hadolint/hadolint"  -- a Rule takes a Dockerfile and returns the executed checks@@ -49,7 +54,7 @@ -- Apply a function on each instruction and create a check -- for the according line number mapInstructions ::-       Metadata -> (state -> Linenumber -> Instruction -> (state, Bool)) -> state -> Rule+       Metadata -> (state -> Linenumber -> Instruction Text.Text -> (state, Bool)) -> state -> Rule mapInstructions metadata f initialState dockerfile =     let (_, results) = mapAccumL applyRule initialState dockerfile     in results@@ -58,21 +63,22 @@         let (newState, res) = f state linenumber i         in (newState, RuleCheck metadata source linenumber res) -instructionRule :: String -> Severity -> String -> (Instruction -> Bool) -> Rule+instructionRule :: Text.Text -> Severity -> Text.Text -> (Instruction Text.Text -> Bool) -> Rule instructionRule code severity message check =     instructionRuleLine code severity message (const check) -instructionRuleLine :: String -> Severity -> String -> (Linenumber -> Instruction -> Bool) -> Rule+instructionRuleLine ::+       Text.Text -> Severity -> Text.Text -> (Linenumber -> Instruction Text.Text -> Bool) -> Rule instructionRuleLine code severity message check =     instructionRuleState code severity message checkAndDropState ()   where     checkAndDropState state line instr = (state, check line instr)  instructionRuleState ::-       String+       Text.Text     -> Severity-    -> String-    -> (state -> Linenumber -> Instruction -> (state, Bool))+    -> Text.Text+    -> (state -> Linenumber -> Instruction Text.Text -> (state, Bool))     -> state     -> Rule instructionRuleState code severity message = mapInstructions (Metadata code severity message)@@ -80,6 +86,14 @@ withState :: a -> b -> (a, b) withState st res = (st, res) +argumentsRule :: ([String] -> a) -> Arguments Text.Text -> a+argumentsRule applyRule args =+    case args of+        ArgumentsText as -> applyRule . normalizeArgs $ as+        ArgumentsList as -> applyRule . normalizeArgs $ as+  where+    normalizeArgs = words . Text.unpack+ -- Enforce rules on a dockerfile and return failed checks analyze :: [Rule] -> Dockerfile -> [RuleCheck] analyze list dockerfile = filter failed $ concat [r dockerfile | r <- list]@@ -89,25 +103,29 @@     wasIgnored c ln = not $ null [line | (line, codes) <- allIgnores, line == ln, c `elem` codes]     allIgnores = ignored dockerfile -ignored :: Dockerfile -> [(Linenumber, [String])]+ignored :: Dockerfile -> [(Linenumber, [Text.Text])] ignored dockerfile =     [(l + 1, ignores) | (l, Just ignores) <- map (lineNumber &&& extractIgnored) dockerfile]   where     extractIgnored = ignoreFromInstruction . instruction-    ignoreFromInstruction (Comment comment) = either (const Nothing) Just (parseComment comment)+    ignoreFromInstruction (Comment comment) = parseComment comment     ignoreFromInstruction _ = Nothing     -- | Parses the comment text and extracts the ignored rule names-    parseComment :: String -> Either Parsec.ParseError [String]-    parseComment = Parsec.parse commentParser ""+    parseComment :: Text.Text -> Maybe [Text.Text]+    parseComment = Megaparsec.parseMaybe commentParser+    commentParser :: IgnoreRuleParser [Text.Text]     commentParser =-        Parsec.skipMany space >> -- The parser for the ignored rules-        Parsec.string "hadolint" >>-        Parsec.skipMany1 space >>-        Parsec.string "ignore=" >>-        Parsec.skipMany space >>-        Parsec.sepBy1 ruleName (Parsec.many space >> Parsec.char ',' >> Parsec.many space)-    space = Parsec.char ' ' <|> Parsec.char '\t'-    ruleName = Parsec.many1 (Parsec.choice $ map Parsec.char "DLSC0123456789")+        spaces >> -- The parser for the ignored rules+        string "hadolint" >>+        spaces1 >>+        string "ignore=" >>+        spaces >>+        Megaparsec.sepBy1 ruleName (spaces >> string "," >> spaces)+    string = Megaparsec.string+    spaces = Megaparsec.takeWhileP Nothing space+    spaces1 = Megaparsec.takeWhile1P Nothing space+    space c = c == ' ' || c == '\t'+    ruleName = Megaparsec.takeWhile1P Nothing (\c -> c `elem` ("DLSC0123456789" :: String))  rules :: [Rule] rules =@@ -145,14 +163,16 @@  commentMetadata :: ShellCheck.Interface.Comment -> Metadata commentMetadata (ShellCheck.Interface.Comment severity code message) =-    Metadata ("SC" ++ show code) severity message+    Metadata (Text.pack ("SC" ++ show code)) severity (Text.pack message)  shellcheckBash :: Dockerfile -> [RuleCheck] shellcheckBash = concatMap check   where-    check (InstructionPos (Run (Arguments args)) source linenumber) =-        rmDup [RuleCheck m source linenumber False | m <- convert args]+    check (InstructionPos (Run args) source linenumber) =+        argumentsRule (applyRule source linenumber) args     check _ = []+    applyRule source linenumber args =+        rmDup [RuleCheck m source linenumber False | m <- convert args]     convert args = [commentMetadata c | c <- shellcheck $ unwords args]     rmDup :: [RuleCheck] -> [RuleCheck]     rmDup [] = []@@ -173,19 +193,19 @@   where     extractAlias (l, f) = (l, fromAlias f) -allImageNames :: Dockerfile -> [(Linenumber, String)]+allImageNames :: Dockerfile -> [(Linenumber, Text.Text)] allImageNames dockerfile = [(l, fromName baseImage) | (l, baseImage) <- allFromImages dockerfile]  -- | Returns a list of all image aliases in FROM instructions that --  are defined before the given line number.-previouslyDefinedAliases :: Linenumber -> Dockerfile -> [String]+previouslyDefinedAliases :: Linenumber -> Dockerfile -> [Text.Text] previouslyDefinedAliases line dockerfile =     [i | (l, ImageAlias i) <- allAliasedImages dockerfile, l < line]  -- | Returns the result of running the check function on the image alias --   name, if the passed instruction is a FROM instruction with a stage alias. --   Otherwise, returns True.-aliasMustBe :: (String -> Bool) -> Instruction -> Bool+aliasMustBe :: (Text.Text -> Bool) -> Instruction a -> Bool aliasMustBe predicate fromInstr =     case fromInstr of         From (UntaggedImage _ (Just (ImageAlias alias))) -> predicate alias@@ -193,7 +213,7 @@         From (DigestedImage _ _ (Just (ImageAlias alias))) -> predicate alias         _ -> True -fromName :: BaseImage -> String+fromName :: BaseImage -> Text.Text fromName (UntaggedImage Image {imageName} _) = imageName fromName (TaggedImage Image {imageName} _ _) = imageName fromName (DigestedImage Image {imageName} _ _) = imageName@@ -209,9 +229,10 @@     code = "DL3000"     severity = ErrorC     message = "Use absolute WORKDIR"-    check (Workdir ('$':_)) = True-    check (Workdir ('/':_)) = True-    check (Workdir _) = False+    check (Workdir loc)+        | "$" `Text.isPrefixOf` loc = True+        | "/" `Text.isPrefixOf` loc = True+        | otherwise = False     check _ = True  hasNoMaintainer :: Rule@@ -257,7 +278,7 @@     code = "DL4001"     severity = WarningC     message = "Either use Wget or Curl but not both"-    check state _ (Run (Arguments args)) = detectDoubleUsage state args+    check state _ (Run args) = argumentsRule (detectDoubleUsage state) args     check state _ _ = withState state True     detectDoubleUsage state args =         let newArgs = extractCommands args@@ -273,8 +294,10 @@     message =         "For some bash commands it makes no sense running them in a Docker container like `ssh`, \         \`vim`, `shutdown`, `service`, `ps`, `free`, `top`, `kill`, `mount`, `ifconfig`"-    check (Run (Arguments (arg:_))) = arg `notElem` invalidCmds+    check (Run args) = argumentsRule applyRule args     check _ = True+    applyRule (arg:_) = arg `notElem` invalidCmds+    applyRule _ = True     invalidCmds = ["ssh", "vim", "shutdown", "service", "ps", "free", "top", "kill", "mount"]  noRootUser :: Rule@@ -284,7 +307,9 @@     severity = WarningC     message = "Do not switch to root USER"     check (User user) =-        not (isPrefixOf "root:" user || isPrefixOf "0:" user || user == "root" || user == "0")+        not+            (Text.isPrefixOf "root:" user ||+             Text.isPrefixOf "0:" user || user == "root" || user == "0")     check _ = True  noCd :: Rule@@ -293,7 +318,7 @@     code = "DL3003"     severity = WarningC     message = "Use WORKDIR to switch to a directory"-    check (Run (Arguments args)) = not $ usingProgram "cd" args+    check (Run args) = argumentsRule (not . usingProgram "cd") args     check _ = True  noSudo :: Rule@@ -304,7 +329,7 @@     message =         "Do not use sudo as it leads to unpredictable behavior. Use a tool like gosu to enforce \         \root"-    check (Run (Arguments args)) = not $ usingProgram "sudo" args+    check (Run args) = argumentsRule (not . usingProgram "sudo") args     check _ = True  noAptGetUpgrade :: Rule@@ -313,7 +338,7 @@     code = "DL3005"     severity = ErrorC     message = "Do not use apt-get upgrade or dist-upgrade"-    check (Run (Arguments args)) = not $ isInfixOf ["apt-get", "upgrade"] args+    check (Run args) = argumentsRule (not . isInfixOf ["apt-get", "upgrade"]) args     check _ = True  noUntagged :: Rule@@ -346,7 +371,7 @@     message =         "Pin versions in apt get install. Instead of `apt-get install <package>` use `apt-get \         \install <package>=<version>`"-    check (Run (Arguments args)) = and [versionFixed p | p <- aptGetPackages args]+    check (Run args) = argumentsRule (\as -> and [versionFixed p | p <- aptGetPackages as]) args     check _ = True     versionFixed package = "=" `isInfixOf` package @@ -372,10 +397,12 @@     --   We only care for users to delete the lists folder if the FROM clase we're is is the last one     --   or if it is used as the base image for another FROM clause.     check _ line f@(From _) = withState (Just (line, f)) True -- Remember the last FROM instruction found-    check st@(Just (line, From baseimage)) _ (Run (Arguments args))-        | not (hasUpdate args) || not (imageIsUsed line baseimage) = withState st True-        | otherwise = withState st (hasCleanup args)+    check st@(Just (line, From baseimage)) _ (Run args) =+        withState st (argumentsRule (applyRule line baseimage) args)     check st _ _ = withState st True+    applyRule line baseimage args+        | not (hasUpdate args) || not (imageIsUsed line baseimage) = True+        | otherwise = hasCleanup args     hasCleanup cmd = ["rm", "-rf", "/var/lib/apt/lists/*"] `isInfixOf` cmd     hasUpdate cmd = ["apt-get", "update"] `isInfixOf` cmd     imageIsUsed line baseimage = isLastImage line baseimage || imageIsUsedLater line baseimage@@ -401,7 +428,7 @@     code = "DL3017"     severity = ErrorC     message = "Do not use apk upgrade"-    check (Run (Arguments args)) = not $ isInfixOf ["apk", "upgrade"] args+    check (Run args) = argumentsRule (not . isInfixOf ["apk", "upgrade"]) args     check _ = True  isApkAdd :: [String] -> Bool@@ -414,7 +441,7 @@     severity = WarningC     message =         "Pin versions in apk add. Instead of `apk add <package>` use `apk add <package>=<version>`"-    check (Run (Arguments args)) = and [versionFixed p | p <- apkAddPackages args]+    check (Run args) = argumentsRule (\as -> and [versionFixed p | p <- apkAddPackages as]) args     check _ = True     versionFixed package = "=" `isInfixOf` package @@ -437,7 +464,7 @@     message =         "Use the `--no-cache` switch to avoid the need to use `--update` and remove \         \`/var/cache/apk/*` when done installing packages"-    check (Run (Arguments args)) = not (isApkAdd args) || hasNoCacheOption args+    check (Run args) = argumentsRule (\as -> not (isApkAdd as) || hasNoCacheOption as) args     check _ = True     hasNoCacheOption cmd = ["--no-cache"] `isInfixOf` cmd @@ -449,7 +476,7 @@     message = "Use ADD for extracting archives into an image"     check (Copy (CopyArgs srcs _ _ _)) =         and-            [ not (format `isSuffixOf` src)+            [ not (format `Text.isSuffixOf` src)             | SourcePath src <- toList srcs             , format <- archiveFormats             ]@@ -475,7 +502,8 @@     message =         "Pin versions in pip. Instead of `pip install <package>` use `pip install \         \<package>==<version>`"-    check (Run (Arguments args)) = not (isPipInstall args) || all versionFixed (packages args)+    check (Run args) =+        argumentsRule (\as -> not (isPipInstall as) || all versionFixed (packages as)) args     check _ = True     isPipInstall :: [String] -> Bool     isPipInstall cmd =@@ -533,7 +561,7 @@     message =         "Pin versions in npm. Instead of `npm install <package>` use `npm install \         \<package>@<version>`"-    check (Run (Arguments args)) = all versionFixed (packages args)+    check (Run args) = argumentsRule (all versionFixed . packages) args     check _ = True     packages cmd =         case getInstallArgs cmd of@@ -563,7 +591,7 @@     code = "DL3014"     severity = WarningC     message = "Use the `-y` switch to avoid manual input `apt-get -y install <package>`"-    check (Run (Arguments args)) = not (isAptGetInstall args) || hasYesOption args+    check (Run args) = argumentsRule (\as -> not (isAptGetInstall as) || hasYesOption as) args     check _ = True     hasYesOption cmd =         ["-y"] `isInfixOf` cmd ||@@ -576,14 +604,15 @@     code = "DL3015"     severity = InfoC     message = "Avoid additional packages by specifying `--no-install-recommends`"-    check (Run (Arguments args)) = not (isAptGetInstall args) || hasNoRecommendsOption args+    check (Run args) =+        argumentsRule (\as -> not (isAptGetInstall as) || hasNoRecommendsOption as) args     check _ = True     hasNoRecommendsOption cmd = ["--no-install-recommends"] `isInfixOf` cmd -isArchive :: String -> Bool+isArchive :: Text.Text -> Bool isArchive path =     True `elem`-    [ ftype `isSuffixOf` path+    [ ftype `Text.isSuffixOf` path     | ftype <-           [ ".tar"           , ".gz"@@ -603,8 +632,8 @@           ]     ] -isUrl :: String -> Bool-isUrl path = True `elem` [proto `isPrefixOf` path | proto <- ["https://", "http://"]]+isUrl :: Text.Text -> Bool+isUrl path = True `elem` [proto `Text.isPrefixOf` path | proto <- ["https://", "http://"]]  copyInsteadAdd :: Rule copyInsteadAdd = instructionRule code severity message check@@ -626,7 +655,7 @@         | length sources > 1 = endsWithSlash t         | otherwise = True     check _ = True-    endsWithSlash (TargetPath t) = last t == '/' -- it is safe to use last, as the target is never empty+    endsWithSlash (TargetPath t) = Text.last t == '/' -- it is safe to use last, as the target is never empty  copyFromExists :: Rule copyFromExists dockerfile = instructionRuleLine code severity message check dockerfile@@ -666,6 +695,6 @@     code = "DL4005"     severity = WarningC     message = "Use SHELL to change the default shell"-    check (Run (Arguments args)) = not $ any shellSymlink (bashCommands args)+    check (Run args) = argumentsRule (not . any shellSymlink . bashCommands) args     check _ = True     shellSymlink args = usingProgram "ln" args && isInfixOf ["/bin/sh"] args

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} import Test.HUnit hiding (Label) import Test.Hspec @@ -5,6 +6,8 @@ import Hadolint.Rules  import Language.Docker.Parser+import Data.Semigroup ((<>))+import qualified Data.Text as Text  main :: IO () main =@@ -30,7 +33,7 @@                         , "FROM alpine:3.7"                         , "RUN baz"                         ]-                in ruleCatchesNot noUntagged $ unlines dockerFile+                in ruleCatchesNot noUntagged $ Text.unlines dockerFile             it "other untagged cases are not ok" $                 let dockerFile =                         [ "FROM golang:1.9.3-alpine3.7 AS build"@@ -40,7 +43,7 @@                         , "FROM alpine:3.7"                         , "RUN baz"                         ]-                in ruleCatches noUntagged $ unlines dockerFile+                in ruleCatches noUntagged $ Text.unlines dockerFile         --         describe "no root or sudo rules" $ do             it "sudo" $ ruleCatches noSudo "RUN sudo apt-get update"@@ -66,7 +69,7 @@                         [ "FROM scratch"                         , "RUN apt-get update && apt-get install python"                         ]-                in ruleCatches aptGetCleanup $ unlines dockerFile+                in ruleCatches aptGetCleanup $ Text.unlines dockerFile             it "apt-get cleanup in stage image" $                 let dockerFile =                         [ "FROM ubuntu as foo"@@ -74,7 +77,7 @@                         , "FROM scratch"                         , "RUN echo hey!"                         ]-                in ruleCatchesNot aptGetCleanup $ unlines dockerFile+                in ruleCatchesNot aptGetCleanup $ Text.unlines dockerFile             it "apt-get no cleanup in last stage" $                 let dockerFile =                         [ "FROM ubuntu as foo"@@ -82,7 +85,7 @@                         , "FROM scratch"                         , "RUN apt-get update && apt-get install python"                         ]-                in ruleCatches aptGetCleanup $ unlines dockerFile+                in ruleCatches aptGetCleanup $ Text.unlines dockerFile             it "apt-get no cleanup in intermediate stage" $                 let dockerFile =                         [ "FROM ubuntu as foo"@@ -90,7 +93,7 @@                         , "FROM foo"                         , "RUN hey!"                         ]-                in ruleCatches aptGetCleanup $ unlines dockerFile+                in ruleCatches aptGetCleanup $ Text.unlines dockerFile             it "now warn apt-get cleanup in intermediate stage that cleans lists" $                 let dockerFile =                         [ "FROM ubuntu as foo"@@ -98,7 +101,7 @@                         , "FROM foo"                         , "RUN hey!"                         ]-                in ruleCatchesNot aptGetCleanup $ unlines dockerFile+                in ruleCatchesNot aptGetCleanup $ Text.unlines dockerFile             it "no warn apt-get cleanup in intermediate stage when stage not used later" $                 let dockerFile =                         [ "FROM ubuntu as foo"@@ -106,13 +109,13 @@                         , "FROM scratch"                         , "RUN hey!"                         ]-                in ruleCatchesNot aptGetCleanup $ unlines dockerFile+                in ruleCatchesNot aptGetCleanup $ Text.unlines dockerFile             it "apt-get cleanup" $                 let dockerFile =                         [ "FROM scratch"                         , "RUN apt-get update && apt-get install python && rm -rf /var/lib/apt/lists/*"                         ]-                in ruleCatchesNot aptGetCleanup $ unlines dockerFile+                in ruleCatchesNot aptGetCleanup $ Text.unlines dockerFile              it "apt-get pinned chained" $                 let dockerFile =@@ -120,7 +123,7 @@                         , " && apt-get -yqq --no-install-recommends install nodejs=0.10 \\"                         , " && rm -rf /var/lib/apt/lists/*"                         ]-                in ruleCatchesNot aptGetVersionPinned $ unlines dockerFile+                in ruleCatchesNot aptGetVersionPinned $ Text.unlines dockerFile             it "apt-get pinned regression" $                 let dockerFile =                         [ "RUN apt-get update && apt-get install --no-install-recommends -y \\"@@ -129,7 +132,7 @@                         , "git=1:2.5.0* \\"                         , "ruby=1:2.1.*"                         ]-                in ruleCatchesNot aptGetVersionPinned $ unlines dockerFile+                in ruleCatchesNot aptGetVersionPinned $ Text.unlines dockerFile             it "has deprecated maintainer" $                 ruleCatches hasNoMaintainer "FROM busybox\nMAINTAINER hudu@mail.com"         --@@ -143,7 +146,7 @@                         [ "RUN apk add --no-cache flex=2.6.4-r1 \\"                         , " && pip install -r requirements.txt"                         ]-                in ruleCatchesNot apkAddVersionPinned $ unlines dockerFile+                in ruleCatchesNot apkAddVersionPinned $ Text.unlines dockerFile             it "apk add version pinned regression" $                 let dockerFile =                         [ "RUN apk add --no-cache \\"@@ -152,7 +155,7 @@                         , "python2=2.7.13-r1 \\"                         , "libbz2=1.0.6-r5"                         ]-                in ruleCatchesNot apkAddVersionPinned $ unlines dockerFile+                in ruleCatchesNot apkAddVersionPinned $ Text.unlines dockerFile             it "apk add version pinned regression - one missed" $                 let dockerFile =                         [ "RUN apk add --no-cache \\"@@ -161,7 +164,7 @@                         , "python2=2.7.13-r1 \\"                         , "libbz2=1.0.6-r5"                         ]-                in ruleCatches apkAddVersionPinned $ unlines dockerFile+                in ruleCatches apkAddVersionPinned $ Text.unlines dockerFile             it "apk add with --no-cache" $ ruleCatches apkAddNoCache "RUN apk add flex=2.6.4-r1"             it "apk add without --no-cache" $                 ruleCatchesNot apkAddNoCache "RUN apk add --no-cache flex=2.6.4-r1"@@ -174,7 +177,7 @@                         , "&& python setup.py install \\"                         , "&& apk del build-dependencies"                         ]-                in ruleCatchesNot apkAddVersionPinned $ unlines dockerFile+                in ruleCatchesNot apkAddVersionPinned $ Text.unlines dockerFile         --         describe "EXPOSE rules" $ do             it "invalid port" $ ruleCatches invalidPort "EXPOSE 80000"@@ -317,7 +320,7 @@                           \openjdk-8-jdk=8u131-b11-1~bpo8+1 &&\\"                         , " rm -rf /var/lib/apt/lists/*"                         ]-                in ruleCatchesNot aptGetVersionPinned $ unlines dockerFile+                in ruleCatchesNot aptGetVersionPinned $ Text.unlines dockerFile              it "has maintainer" $ ruleCatches hasNoMaintainer "FROM debian\nMAINTAINER Lukas"             it "has maintainer first" $ ruleCatches hasNoMaintainer "MAINTAINER Lukas\nFROM DEBIAN"@@ -356,7 +359,7 @@                         , "FROM node as build"                         , "RUN baz"                         ]-                in ruleCatches copyFromExists $ unlines dockerFile+                in ruleCatches copyFromExists $ Text.unlines dockerFile             it "don't warn on correctly defined aliases" $                 let dockerFile =                         [ "FROM scratch as build"@@ -365,7 +368,7 @@                         , "COPY --from=build foo ."                         , "RUN baz"                         ]-                in ruleCatchesNot copyFromExists $ unlines dockerFile+                in ruleCatchesNot copyFromExists $ Text.unlines dockerFile         --         describe "copy from own FROM" $ do             it "warn on copying from your the same FROM" $@@ -373,7 +376,7 @@                         [ "FROM node as foo"                         , "COPY --from=foo bar ."                         ]-                in ruleCatches copyFromAnother $ unlines dockerFile+                in ruleCatches copyFromAnother $ Text.unlines dockerFile             it "don't warn on copying form other sources" $                 let dockerFile =                         [ "FROM scratch as build"@@ -382,7 +385,7 @@                         , "COPY --from=build foo ."                         , "RUN baz"                         ]-                in ruleCatchesNot copyFromAnother $ unlines dockerFile+                in ruleCatchesNot copyFromAnother $ Text.unlines dockerFile         --         describe "Duplicate aliases" $ do             it "warn on duplicate aliases" $@@ -392,7 +395,7 @@                         , "FROM scratch as foo"                         , "RUN something"                         ]-                in ruleCatches fromAliasUnique $ unlines dockerFile+                in ruleCatches fromAliasUnique $ Text.unlines dockerFile             it "don't warn on unique aliases" $                 let dockerFile =                         [ "FROM scratch as build"@@ -400,12 +403,14 @@                         , "FROM node as run"                         , "RUN baz"                         ]-                in ruleCatchesNot fromAliasUnique $ unlines dockerFile+                in ruleCatchesNot fromAliasUnique $ Text.unlines dockerFile         --         describe "format error" $             it "display error after line pos" $ do-                let ast = parseString "FOM debian:jessie"-                    expectedMsg = "<string>:1:2 unexpected \"O\" expecting FROM"+                let ast = parseText "FOM debian:jessie"+                    expectedMsg = "<string>:1:1 unexpected 'F' expecting '#', ADD, ARG, CMD, COPY, ENTRYPOINT, " <>+                                  "ENV, EXPOSE, FROM, HEALTHCHECK, LABEL, MAINTAINER, ONBUILD, RUN, SHELL, STOPSIGNAL, " <>+                                  "USER, VOLUME, WORKDIR, or end of input "                 case ast of                     Left err -> assertEqual "Unexpected error msg" expectedMsg (formatError err)                     Right _ -> assertFailure "AST should fail parsing"@@ -417,32 +422,32 @@                         , "# hadolint ignore=DL3002"                         , "USER root"                         ]-                in ruleCatchesNot noRootUser $ unlines dockerFile+                in ruleCatchesNot noRootUser $ Text.unlines dockerFile             it "ignores only the given rule" $                 let dockerFile =                         [ "# hadolint ignore=DL3001"                         , "USER root"                         ]-                in ruleCatches noRootUser $ unlines dockerFile+                in ruleCatches noRootUser $ Text.unlines dockerFile             it "ignores only the given rule, when multiple passed" $                 let dockerFile =                         [ "# hadolint ignore=DL3001,DL3002"                         , "USER root"                         ]-                in ruleCatchesNot noRootUser $ unlines dockerFile+                in ruleCatchesNot noRootUser $ Text.unlines dockerFile             it "ignores the rule only if directly above the instruction" $                 let dockerFile =                         [ "# hadolint ignore=DL3001,DL3002"                         , "FROM ubuntu"                         , "USER root"                         ]-                in ruleCatches noRootUser $ unlines dockerFile+                in ruleCatches noRootUser $ Text.unlines dockerFile             it "won't ignore the rule if passed invalid rule names" $                 let dockerFile =                         [ "# hadolint ignore=crazy,DL3002"                         , "USER root"                         ]-                in ruleCatches noRootUser $ unlines dockerFile+                in ruleCatches noRootUser $ Text.unlines dockerFile             it "ignores multiple rules correctly, even with some extra whitespace" $                 let dockerFile =                         [ "FROM node as foo"@@ -450,24 +455,24 @@                         , "COPY --from=foo bar baz ."                         ]                 in do-                  ruleCatchesNot copyFromAnother $ unlines dockerFile-                  ruleCatchesNot copyEndingSlash $ unlines dockerFile+                  ruleCatchesNot copyFromAnother $ Text.unlines dockerFile+                  ruleCatchesNot copyEndingSlash $ Text.unlines dockerFile -assertChecks :: HasCallStack => Rule -> String -> ([RuleCheck] -> IO a) -> IO a+assertChecks :: HasCallStack => Rule -> Text.Text -> ([RuleCheck] -> IO a) -> IO a assertChecks rule s makeAssertions =-    case parseString (s ++ "\n") of+    case parseText (s <> "\n") of         Left err -> assertFailure $ show err         Right dockerFile -> makeAssertions $ analyze [rule] dockerFile  -- Assert a failed check exists for rule-ruleCatches :: HasCallStack => Rule -> String -> Assertion+ruleCatches :: HasCallStack => Rule -> Text.Text -> Assertion ruleCatches rule s = assertChecks rule s f   where     f checks = do       assertEqual "No check for rule found" 1 $ length checks       assertBool "Incorrect line number for result" $ null [c | c <- checks, linenumber c <= 0] -ruleCatchesNot :: HasCallStack => Rule -> String -> Assertion+ruleCatchesNot :: HasCallStack => Rule -> Text.Text -> Assertion ruleCatchesNot rule s = assertChecks rule s f   where     f checks = assertEqual "Found check of rule" 0 $ length checks