diff --git a/language-docker.cabal b/language-docker.cabal --- a/language-docker.cabal +++ b/language-docker.cabal @@ -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 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 diff --git a/src/Language/Docker/Parser/Copy.hs b/src/Language/Docker/Parser/Copy.hs --- a/src/Language/Docker/Parser/Copy.hs +++ b/src/Language/Docker/Parser/Copy.hs @@ -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 diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -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" diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -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) diff --git a/test/Language/Docker/ParserSpec.hs b/test/Language/Docker/ParserSpec.hs --- a/test/Language/Docker/ParserSpec.hs +++ b/test/Language/Docker/ParserSpec.hs @@ -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" $ diff --git a/test/Language/Docker/PrettyPrintSpec.hs b/test/Language/Docker/PrettyPrintSpec.hs new file mode 100644 --- /dev/null +++ b/test/Language/Docker/PrettyPrintSpec.hs @@ -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