language-docker 9.2.0 → 9.3.0
raw patch · 6 files changed
+243/−41 lines, 6 files
Files
- language-docker.cabal +3/−2
- src/Language/Docker/Parser/Copy.hs +40/−14
- src/Language/Docker/PrettyPrint.hs +11/−4
- src/Language/Docker/Syntax.hs +14/−1
- test/Language/Docker/ParserSpec.hs +44/−20
- test/Language/Docker/PrettyPrintSpec.hs +131/−0
language-docker.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a83a107737af6beacf2202a2f043950007834c140aad6ae9c656b1c983c129bb+-- hash: 16d9c4402444a128ff719c0f88b1de7b2465020a9f4a721a18aeebf3ef5f276d name: language-docker-version: 9.2.0+version: 9.3.0 synopsis: Dockerfile parser, pretty-printer and embedded DSL description: All functions for parsing and pretty-printing Dockerfiles are exported through @Language.Docker@. For more fine-grained operations look for specific modules that implement a certain functionality. See the <https://github.com/hadolint/language-docker GitHub project> for the source-code and examples.@@ -72,6 +72,7 @@ other-modules: Language.Docker.IntegrationSpec Language.Docker.ParserSpec+ Language.Docker.PrettyPrintSpec Paths_language_docker hs-source-dirs: test
src/Language/Docker/Parser/Copy.hs view
@@ -13,6 +13,7 @@ data CopyFlag = FlagChown Chown+ | FlagChmod Chmod | FlagSource CopySource | FlagInvalid (Text, Text) @@ -21,33 +22,51 @@ reserved "COPY" flags <- copyFlag `sepEndBy` requiredWhitespace let chownFlags = [c | FlagChown c <- flags]+ let chmodFlags = [c | FlagChmod c <- flags] let sourceFlags = [f | FlagSource f <- flags] let invalid = [i | FlagInvalid i <- flags] -- Let's do some validation on the flags- case (invalid, chownFlags, sourceFlags) of- ((k, v) : _, _, _) -> unexpectedFlag k v- (_, _ : _ : _, _) -> customError $ DuplicateFlagError "--chown"- (_, _, _ : _ : _) -> customError $ DuplicateFlagError "--from"+ case (invalid, chownFlags, chmodFlags, sourceFlags) of+ ((k, v) : _, _, _, _) -> unexpectedFlag k v+ (_, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--chown"+ (_, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--chmod"+ (_, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--from" _ -> do- let ch =+ let cho = case chownFlags of [] -> NoChown c : _ -> c+ let chm =+ case chmodFlags of+ [] -> NoChmod+ c : _ -> c let fr = case sourceFlags of [] -> NoSource f : _ -> f- fileList "COPY" (\src dest -> Copy (CopyArgs src dest ch fr))+ fileList "COPY" (\src dest -> Copy (CopyArgs src dest cho chm fr)) parseAdd :: Parser (Instruction Text) parseAdd = do reserved "ADD"- flag <- lexeme copyFlag <|> return (FlagChown NoChown)- notFollowedBy (string "--") <?> "only the --chown flag or the src and dest paths"- case flag of- FlagChown ch -> fileList "ADD" (\src dest -> Add (AddArgs src dest ch))- FlagSource _ -> customError $ InvalidFlagError "--from"- FlagInvalid (k, v) -> unexpectedFlag k v+ flags <- copyFlag `sepEndBy` requiredWhitespace+ let chownFlags = [c | FlagChown c <- flags]+ let chmodFlags = [c | FlagChmod c <- flags]+ let invalidFlags = [i | FlagInvalid i <- flags]+ notFollowedBy (string "--") <?>+ "only the --chown flag, the --chmod flag or the src and dest paths"+ case (invalidFlags, chownFlags, chmodFlags) of+ ((k, v) : _, _, _) -> unexpectedFlag k v+ (_, _ : _ : _, _) -> customError $ DuplicateFlagError "--chown"+ (_, _, _ : _ : _) -> customError $ DuplicateFlagError "--chmod"+ _ -> do+ let cho = case chownFlags of+ [] -> NoChown+ c : _ -> c+ let chm = case chmodFlags of+ [] -> NoChmod+ c : _ -> c+ fileList "ADD" (\src dest -> Add (AddArgs src dest cho chm)) fileList :: Text -> (NonEmpty SourcePath -> TargetPath -> Instruction Text) -> Parser (Instruction Text) fileList name constr = do@@ -69,14 +88,21 @@ copyFlag :: Parser CopyFlag copyFlag = (FlagChown <$> try chown <?> "only one --chown")+ <|> (FlagChmod <$> try chmod <?> "only one --chmod") <|> (FlagSource <$> try copySource <?> "only one --from") <|> (FlagInvalid <$> try anyFlag <?> "no other flags") chown :: Parser Chown chown = do void $ string "--chown="- ch <- someUnless "the user and group for chown" (== ' ')- return $ Chown ch+ cho <- someUnless "the user and group for chown" (== ' ')+ return $ Chown cho++chmod :: Parser Chmod+chmod = do+ void $ string "--chmod="+ chm <- someUnless "the mode for chmod" (== ' ')+ return $ Chmod chm copySource :: Parser CopySource copySource = do
src/Language/Docker/PrettyPrint.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RebindableSyntax #-}@@ -112,7 +111,7 @@ accumulate '\\' EscapeAccum {buffer, escaping = True, count} = EscapeAccum (B.singleton '\\' <> buffer) (count + 1) True accumulate c EscapeAccum {buffer, escaping = True, count}- | count `mod` 2 == 0 = EscapeAccum (B.singleton c <> B.singleton '\\' <> buffer) 0 False+ | even count = EscapeAccum (B.singleton c <> B.singleton '\\' <> buffer) 0 False | otherwise = EscapeAccum (B.singleton c <> buffer) 0 False -- It was already escaped accumulate c EscapeAccum {buffer, escaping = False} = EscapeAccum (B.singleton c <> buffer) 0 False@@ -139,6 +138,12 @@ Chown c -> "--chown=" <> pretty c NoChown -> mempty +prettyPrintChmod :: Chmod -> Doc ann+prettyPrintChmod chmod =+ case chmod of+ Chmod c -> "--chmod=" <> pretty c+ NoChmod -> mempty+ prettyPrintCopySource :: CopySource -> Doc ann prettyPrintCopySource source = case source of@@ -260,9 +265,10 @@ prettyPrintRunNetwork network prettyPrintRunSecurity security pretty c- Copy CopyArgs {sourcePaths, targetPath, chownFlag, sourceFlag} -> do+ Copy CopyArgs {sourcePaths, targetPath, chownFlag, chmodFlag, sourceFlag} -> do "COPY" prettyPrintChown chownFlag+ prettyPrintChmod chmodFlag prettyPrintCopySource sourceFlag prettyPrintFileList sourcePaths targetPath Cmd c -> do@@ -286,9 +292,10 @@ From b -> do "FROM" prettyPrintBaseImage b- Add AddArgs {sourcePaths, targetPath, chownFlag} -> do+ Add AddArgs {sourcePaths, targetPath, chownFlag, chmodFlag} -> do "ADD" prettyPrintChown chownFlag+ prettyPrintChmod chmodFlag prettyPrintFileList sourcePaths targetPath Shell args -> do "SHELL"
src/Language/Docker/Syntax.hs view
@@ -128,6 +128,17 @@ "" -> NoChown _ -> Chown (Text.pack ch) +data Chmod+ = Chmod !Text+ | NoChmod+ deriving (Show, Eq, Ord)++instance IsString Chmod where+ fromString ch =+ case ch of+ "" -> NoChmod+ _ -> Chmod (Text.pack ch)+ data CopySource = CopySource !Text | NoSource@@ -156,6 +167,7 @@ { sourcePaths :: NonEmpty SourcePath, targetPath :: !TargetPath, chownFlag :: !Chown,+ chmodFlag :: !Chmod, sourceFlag :: !CopySource } deriving (Show, Eq, Ord)@@ -164,7 +176,8 @@ = AddArgs { sourcePaths :: NonEmpty SourcePath, targetPath :: !TargetPath,- chownFlag :: !Chown+ chownFlag :: !Chown,+ chmodFlag :: !Chmod } deriving (Show, Eq, Ord)
test/Language/Docker/ParserSpec.hs view
@@ -382,88 +382,112 @@ let file = Text.unlines ["ADD . /app", "ADD http://foo.bar/baz ."] in assertAst file- [ Add $ AddArgs [SourcePath "."] (TargetPath "/app") NoChown,- Add $ AddArgs [SourcePath "http://foo.bar/baz"] (TargetPath ".") NoChown+ [ Add $ AddArgs [SourcePath "."] (TargetPath "/app") NoChown NoChmod,+ Add $ AddArgs [SourcePath "http://foo.bar/baz"] (TargetPath ".") NoChown NoChmod ] it "multifiles ADD" $ let file = Text.unlines ["ADD foo bar baz /app"] in assertAst file- [ Add $ AddArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown+ [ Add $ AddArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown NoChmod ] it "list of quoted files" $ let file = Text.unlines ["ADD [\"foo\", \"bar\", \"baz\", \"/app\"]"] in assertAst file- [ Add $ AddArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown+ [ Add $ AddArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown NoChmod ] it "with chown flag" $ let file = Text.unlines ["ADD --chown=root:root foo bar"] in assertAst file- [ Add $ AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "root:root")+ [ Add $ AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "root:root") NoChmod ]+ it "with chmod flag" $+ let file = Text.unlines ["ADD --chmod=640 foo bar"]+ in assertAst+ file+ [ Add $ AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") NoChown (Chmod "640")+ ]+ it "with chown and chmod flag" $+ let file = Text.unlines ["ADD --chown=root:root --chmod=640 foo bar"]+ in assertAst+ file+ [ Add $ AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "root:root") (Chmod "640")+ ]+ it "with chown and chmod flag other order" $+ let file = Text.unlines ["ADD --chmod=640 --chown=root:root foo bar"]+ in assertAst+ file+ [ Add $ AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "root:root") (Chmod "640")+ ] it "list of quoted files and chown" $ let file = Text.unlines ["ADD --chown=user:group [\"foo\", \"bar\", \"baz\", \"/app\"]"] in assertAst file- [ Add $ AddArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") (Chown "user:group")+ [ Add $ AddArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") (Chown "user:group") NoChmod ] describe "COPY" $ do it "simple COPY" $ let file = Text.unlines ["COPY . /app", "COPY baz /some/long/path"] in assertAst file- [ Copy $ CopyArgs [SourcePath "."] (TargetPath "/app") NoChown NoSource,- Copy $ CopyArgs [SourcePath "baz"] (TargetPath "/some/long/path") NoChown NoSource+ [ Copy $ CopyArgs [SourcePath "."] (TargetPath "/app") NoChown NoChmod NoSource,+ Copy $ CopyArgs [SourcePath "baz"] (TargetPath "/some/long/path") NoChown NoChmod NoSource ] it "multifiles COPY" $ let file = Text.unlines ["COPY foo bar baz /app"] in assertAst file- [ Copy $ CopyArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown NoSource+ [ Copy $ CopyArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown NoChmod NoSource ] it "list of quoted files" $ let file = Text.unlines ["COPY [\"foo\", \"bar\", \"baz\", \"/app\"]"] in assertAst file- [ Copy $ CopyArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown NoSource+ [ Copy $ CopyArgs (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") NoChown NoChmod NoSource ] it "with chown flag" $ let file = Text.unlines ["COPY --chown=user:group foo bar"] in assertAst file- [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "user:group") NoSource+ [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "user:group") NoChmod NoSource ]+ it "with chmod flag" $+ let file = Text.unlines ["COPY --chmod=777 foo bar"]+ in assertAst+ file+ [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") NoChown (Chmod "777") NoSource+ ] it "with from flag" $ let file = Text.unlines ["COPY --from=node foo bar"] in assertAst file- [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") NoChown (CopySource "node")+ [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") NoChown NoChmod (CopySource "node") ]- it "with both flags" $- let file = Text.unlines ["COPY --from=node --chown=user:group foo bar"]+ it "with all three flags" $+ let file = Text.unlines ["COPY --from=node --chmod=751 --chown=user:group foo bar"] in assertAst file- [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "user:group") (CopySource "node")+ [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "user:group") (Chmod "751") (CopySource "node") ]- it "with both flags in different order" $- let file = Text.unlines ["COPY --chown=user:group --from=node foo bar"]+ it "with all three flags in different order" $+ let file = Text.unlines ["COPY --chown=user:group --from=node --chmod=644 foo bar"] in assertAst file- [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "user:group") (CopySource "node")+ [ Copy $ CopyArgs (fmap SourcePath ["foo"]) (TargetPath "bar") (Chown "user:group") (Chmod "644") (CopySource "node") ] it "supports windows paths" $ let file = Text.unlines ["COPY C:\\\\go C:\\\\go"] in assertAst file- [ Copy $ CopyArgs (fmap SourcePath ["C:\\\\go"]) (TargetPath "C:\\\\go") NoChown NoSource+ [ Copy $ CopyArgs (fmap SourcePath ["C:\\\\go"]) (TargetPath "C:\\\\go") NoChown NoChmod NoSource ] it "does not get confused with trailing whitespace" $ let file = Text.unlines ["COPY a b "] in assertAst file- [ Copy $ CopyArgs [SourcePath "a"] (TargetPath "b") NoChown NoSource+ [ Copy $ CopyArgs [SourcePath "a"] (TargetPath "b") NoChown NoChmod NoSource ] describe "RUN with experimental flags" $ do it "--mount=type=bind and target" $
+ test/Language/Docker/PrettyPrintSpec.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}++module Language.Docker.PrettyPrintSpec where+++import Data.Default.Class (def)+import qualified Data.Text as Text+import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Text+import Language.Docker.Parser+import Language.Docker.Syntax+import Language.Docker.PrettyPrint+import Test.HUnit hiding (Label)+import Test.Hspec+import Text.Megaparsec hiding (Label)+++spec :: Spec+spec = do+ describe "pretty print ADD" $ do+ it "with just copy" $ do+ let add = Add+ ( AddArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ NoChown+ NoChmod+ )+ in assertPretty "ADD foo bar" add+ it "with just chown" $ do+ let add = Add+ ( AddArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ (Chown "root:root")+ NoChmod+ )+ in assertPretty "ADD --chown=root:root foo bar" add+ it "with just chmod" $ do+ let add = Add+ ( AddArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ NoChown+ (Chmod "751")+ )+ in assertPretty "ADD --chmod=751 foo bar" add+ it "with both chown and chmod" $ do+ let add = Add+ ( AddArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ (Chown "root:root")+ (Chmod "751")+ )+ in assertPretty "ADD --chown=root:root --chmod=751 foo bar" add+ describe "pretty print COPY" $ do+ it "with just copy" $ do+ let copy = Copy+ ( CopyArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ NoChown+ NoChmod+ NoSource+ )+ in assertPretty "COPY foo bar" copy+ it "with just chown" $ do+ let copy = Copy+ ( CopyArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ (Chown "root:root")+ NoChmod+ NoSource+ )+ in assertPretty "COPY --chown=root:root foo bar" copy+ it "with just chmod" $ do+ let copy = Copy+ ( CopyArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ NoChown+ (Chmod "751")+ NoSource+ )+ in assertPretty "COPY --chmod=751 foo bar" copy+ it "with source baseimage" $ do+ let copy = Copy+ ( CopyArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ NoChown+ NoChmod+ (CopySource "baseimage")+ )+ in assertPretty "COPY --from=baseimage foo bar" copy+ it "with both chown and chmod" $ do+ let copy = Copy+ ( CopyArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ (Chown "root:root")+ (Chmod "751")+ NoSource+ )+ in assertPretty "COPY --chown=root:root --chmod=751 foo bar" copy+ it "with all three: from, chown and chmod" $ do+ let copy = Copy+ ( CopyArgs+ [SourcePath "foo"]+ (TargetPath "bar")+ (Chown "root:root")+ (Chmod "751")+ (CopySource "baseimage")+ )+ in assertPretty "COPY --chown=root:root --chmod=751 --from=baseimage foo bar" copy+++assertPretty :: Text.Text -> Instruction Text.Text -> Assertion+assertPretty expected instruction = assertEqual+ "prettyfied instruction not pretty enough"+ expected+ (prettyPrintStrict instruction)++prettyPrintStrict :: Instruction Text.Text -> Text.Text+prettyPrintStrict =+ renderStrict . layoutPretty (LayoutOptions Unbounded) . prettyPrintInstruction