language-docker 15.0.0 → 16.0.0
raw patch · 12 files changed
+515/−104 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Language.Docker.PrettyPrint: prettyPrintLink :: Link -> Doc ann
- Language.Docker.Syntax: newtype TmpOpts
+ Language.Docker.Syntax: KeepGitDir :: !Bool -> KeepGitDir
+ Language.Docker.Syntax: NoKeepGitDir :: KeepGitDir
+ Language.Docker.Syntax: NoParents :: Parents
+ Language.Docker.Syntax: NoUnpack :: Unpack
+ Language.Docker.Syntax: Parents :: !Bool -> Parents
+ Language.Docker.Syntax: Unpack :: !Bool -> Unpack
+ Language.Docker.Syntax: [keepGitDirFlag] :: AddFlags -> !KeepGitDir
+ Language.Docker.Syntax: [parentsFlag] :: CopyFlags -> !Parents
+ Language.Docker.Syntax: [tSize] :: TmpOpts -> !Maybe Text
+ Language.Docker.Syntax: [unpackFlag] :: AddFlags -> !Unpack
+ Language.Docker.Syntax: data KeepGitDir
+ Language.Docker.Syntax: data Parents
+ Language.Docker.Syntax: data TmpOpts
+ Language.Docker.Syntax: data Unpack
+ Language.Docker.Syntax: instance GHC.Classes.Eq Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance GHC.Classes.Eq Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance GHC.Classes.Eq Language.Docker.Syntax.Unpack
+ Language.Docker.Syntax: instance GHC.Classes.Ord Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance GHC.Classes.Ord Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance GHC.Classes.Ord Language.Docker.Syntax.Unpack
+ Language.Docker.Syntax: instance GHC.Internal.Show.Show Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance GHC.Internal.Show.Show Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance GHC.Internal.Show.Show Language.Docker.Syntax.Unpack
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.KeepGitDir
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.Link
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.Parents
+ Language.Docker.Syntax: instance Prettyprinter.Internal.Pretty Language.Docker.Syntax.Unpack
- Language.Docker.Syntax: AddFlags :: !Checksum -> !Chown -> !Chmod -> !Link -> ![Exclude] -> AddFlags
+ Language.Docker.Syntax: AddFlags :: !Checksum -> !Chown -> !Chmod -> !Link -> !KeepGitDir -> !Unpack -> ![Exclude] -> AddFlags
- Language.Docker.Syntax: CopyFlags :: !Chown -> !Chmod -> !Link -> !CopySource -> ![Exclude] -> CopyFlags
+ Language.Docker.Syntax: CopyFlags :: !Chown -> !Chmod -> !Link -> !Parents -> !CopySource -> ![Exclude] -> CopyFlags
- Language.Docker.Syntax: Link :: Link
+ Language.Docker.Syntax: Link :: !Bool -> Link
- Language.Docker.Syntax: TmpOpts :: TargetPath -> TmpOpts
+ Language.Docker.Syntax: TmpOpts :: TargetPath -> !Maybe Text -> TmpOpts
Files
- language-docker.cabal +1/−1
- src/Language/Docker/Parser.hs +26/−17
- src/Language/Docker/Parser/Copy.hs +90/−20
- src/Language/Docker/Parser/From.hs +36/−4
- src/Language/Docker/Parser/Run.hs +16/−2
- src/Language/Docker/PrettyPrint.hs +12/−11
- src/Language/Docker/Syntax.hs +49/−6
- test/Language/Docker/ParseAddSpec.hs +91/−12
- test/Language/Docker/ParseCopySpec.hs +60/−11
- test/Language/Docker/ParseRunSpec.hs +13/−0
- test/Language/Docker/ParserSpec.hs +26/−0
- test/Language/Docker/PrettyPrintSpec.hs +95/−20
language-docker.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: language-docker-version: 15.0.0+version: 16.0.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.
src/Language/Docker/Parser.hs view
@@ -16,6 +16,21 @@ import Language.Docker.Parser.Prelude import Language.Docker.Syntax +bomUtf32LE :: B.ByteString+bomUtf32LE = "\255\254\NUL\NUL"++bomUtf32BE :: B.ByteString+bomUtf32BE = "\NUL\NUL\254\255"++bomUtf16LE :: B.ByteString+bomUtf16LE = "\255\254"++bomUtf16BE :: B.ByteString+bomUtf16BE = "\254\255"++bomUtf8 :: B.ByteString+bomUtf8 = "\239\187\191"+ contents :: Parser a -> Parser a contents p = do void onlyWhitespaces@@ -63,23 +78,17 @@ let ?esc = findEscapePragma (T.lines src) in parse (contents dockerfile) path src where- src =- case B.take 4 txt of- "\255\254\NUL\NUL" ->- dos2unix (E.decodeUtf32LEWith E.lenientDecode $ B.drop 4 txt)- "\NUL\NUL\254\255" ->- dos2unix (E.decodeUtf32BEWith E.lenientDecode $ B.drop 4 txt)- _ ->- case B.take 2 txt of- "\255\254" ->- dos2unix (E.decodeUtf16LEWith E.lenientDecode $ B.drop 2 txt)- "\254\255" ->- dos2unix (E.decodeUtf16BEWith E.lenientDecode $ B.drop 2 txt)- _ ->- case B.take 3 txt of- "\239\187\191" ->- dos2unix (E.decodeUtf8With E.lenientDecode $ B.drop 3 txt)- _ -> dos2unix (E.decodeUtf8With E.lenientDecode txt)+ src = dos2unix $ decode txt++-- | Determine encoding from byte order mark and decode+decode :: B.ByteString -> T.Text+decode txt+ | bomUtf32LE `B.isPrefixOf` txt = E.decodeUtf32LEWith E.lenientDecode $ B.drop 4 txt+ | bomUtf32BE `B.isPrefixOf` txt = E.decodeUtf32BEWith E.lenientDecode $ B.drop 4 txt+ | bomUtf16LE `B.isPrefixOf` txt = E.decodeUtf16LEWith E.lenientDecode $ B.drop 2 txt+ | bomUtf16BE `B.isPrefixOf` txt = E.decodeUtf16BEWith E.lenientDecode $ B.drop 2 txt+ | bomUtf8 `B.isPrefixOf` txt = E.decodeUtf8With E.lenientDecode $ B.drop 3 txt+ | otherwise = E.decodeUtf8With E.lenientDecode txt -- | Changes crlf line endings to simple line endings dos2unix :: T.Text -> T.Text
src/Language/Docker/Parser/Copy.hs view
@@ -14,6 +14,9 @@ | FlagChown Chown | FlagChmod Chmod | FlagLink Link+ | FlagKeepGitDir KeepGitDir+ | FlagParents Parents+ | FlagUnpack Unpack | FlagSource CopySource | FlagExclude Exclude | FlagInvalid (Text, Text)@@ -25,16 +28,18 @@ let chownFlags = [c | FlagChown c <- flags] let chmodFlags = [c | FlagChmod c <- flags] let linkFlags = [l | FlagLink l <- flags]+ let parentsFlags = [p | FlagParents p <- flags] let sourceFlags = [f | FlagSource f <- flags] let excludeFlags = [e | FlagExclude e <- flags] let invalid = [i | FlagInvalid i <- flags] -- Let's do some validation on the flags- case (invalid, chownFlags, chmodFlags, linkFlags, sourceFlags, excludeFlags) of- ((k, v) : _, _, _, _, _, _) -> unexpectedFlag k v- (_, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--chown"- (_, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--chmod"- (_, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--link"- (_, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--from"+ case (invalid, chownFlags, chmodFlags, linkFlags, parentsFlags, sourceFlags, excludeFlags) of+ ((k, v) : _, _, _, _, _, _, _) -> unexpectedFlag k v+ (_, _ : _ : _, _, _, _, _, _) -> customError $ DuplicateFlagError "--chown"+ (_, _, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--chmod"+ (_, _, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--link"+ (_, _, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--parents"+ (_, _, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--from" _ -> do let cho = case chownFlags of@@ -48,12 +53,16 @@ case linkFlags of [] -> NoLink l : _ -> l+ let par =+ case parentsFlags of+ [] -> NoParents+ p : _ -> p let fr = case sourceFlags of [] -> NoSource f : _ -> f- try (heredocList (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr excludeFlags)))- <|> fileList "COPY" (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk fr excludeFlags))+ try (heredocList (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk par fr excludeFlags)))+ <|> fileList "COPY" (\src dest -> Copy (CopyArgs src dest) (CopyFlags cho chm lnk par fr excludeFlags)) parseAdd :: (?esc :: Char) => Parser (Instruction Text) parseAdd = do@@ -63,16 +72,20 @@ let chownFlags = [c | FlagChown c <- flags] let chmodFlags = [c | FlagChmod c <- flags] let linkFlags = [l | FlagLink l <- flags]+ let keepGitDirFlags = [k | FlagKeepGitDir k <- flags]+ let unpackFlags = [u | FlagUnpack u <- flags] let excludeFlags = [e | FlagExclude e <- flags] let invalidFlags = [i | FlagInvalid i <- flags] notFollowedBy (string "--") <?>- "only the --checksum, --chown, --chmod, --link, --exclude flags or the src and dest paths"- case (invalidFlags, checksumFlags, chownFlags, linkFlags, chmodFlags, excludeFlags) of- ((k, v) : _, _, _, _, _, _) -> unexpectedFlag k v- (_, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--checksum"- (_, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--chown"- (_, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--chmod"- (_, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--link"+ "only the --checksum, --chown, --chmod, --link, --exclude, --keep-git-dir, --unpack flags or the src and dest paths"+ case (invalidFlags, checksumFlags, chownFlags, linkFlags, chmodFlags, keepGitDirFlags, unpackFlags, excludeFlags) of+ ((k, v) : _, _, _, _, _, _, _, _) -> unexpectedFlag k v+ (_, _ : _ : _, _, _, _, _, _, _) -> customError $ DuplicateFlagError "--checksum"+ (_, _, _ : _ : _, _, _, _, _, _) -> customError $ DuplicateFlagError "--chown"+ (_, _, _, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--chmod"+ (_, _, _, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--link"+ (_, _, _, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--keep-git-dir"+ (_, _, _, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--unpack" _ -> do let chk = case checksumFlags of [] -> NoChecksum@@ -86,7 +99,13 @@ let lnk = case linkFlags of [] -> NoLink l : _ -> l- fileList "ADD" (\src dest -> Add (AddArgs src dest) (AddFlags chk cho chm lnk excludeFlags))+ let kgd = case keepGitDirFlags of+ [] -> NoKeepGitDir+ k : _ -> k+ let unp = case unpackFlags of+ [] -> NoUnpack+ u : _ -> u+ fileList "ADD" (\src dest -> Add (AddArgs src dest) (AddFlags chk cho chm lnk kgd unp excludeFlags)) heredocList :: (?esc :: Char) => (NonEmpty SourcePath -> TargetPath -> Instruction Text) ->@@ -119,13 +138,21 @@ unexpectedFlag name _ = customFailure $ InvalidFlagError (T.unpack name) copyFlag :: (?esc :: Char) => Parser Flag-copyFlag = (FlagSource <$> try copySource <?> "only one --from") <|> addFlag+copyFlag = (FlagSource <$> try copySource <?> "only one --from")+ <|> (FlagChown <$> try chown <?> "--chown")+ <|> (FlagChmod <$> try chmod <?> "--chmod")+ <|> (FlagLink <$> try link <?> "--link")+ <|> (FlagParents <$> try parents <?> "--parents")+ <|> (FlagExclude <$> try exclude <?> "--exclude")+ <|> (FlagInvalid <$> try anyFlag <?> "other flag") addFlag :: (?esc :: Char) => Parser Flag addFlag = (FlagChecksum <$> try checksum <?> "--checksum") <|> (FlagChown <$> try chown <?> "--chown") <|> (FlagChmod <$> try chmod <?> "--chmod") <|> (FlagLink <$> try link <?> "--link")+ <|> (FlagKeepGitDir <$> try keepGitDir <?> "--keep-git-dir")+ <|> (FlagUnpack <$> try unpack <?> "--unpack") <|> (FlagExclude <$> try exclude <?> "--exclude") <|> (FlagInvalid <$> try anyFlag <?> "other flag") @@ -148,9 +175,52 @@ return $ Chmod chm link :: Parser Link-link = do- void $ string "--link"- return Link+link = ( try linkExplicit <?> "explicit --link" )+ <|> ( try linkImplicit <?> "implicit --link" )+ where+ linkExplicit = do+ void $ string "--link="+ val <- string "true" <|> string "false"+ return $ Link ( val == "true" )+ linkImplicit = do+ void $ string "--link"+ return $ Link True++parents :: Parser Parents+parents = ( try parentsExplicit <?> "explicit --parents")+ <|> ( try parentsImplicit <?> "implicit --parents")+ where+ parentsExplicit = do+ void $ string "--parents="+ val <- string "true" <|> string "false"+ return $ Parents (val == "true")+ parentsImplicit = do+ void $ string "--parents"+ return $ Parents True++keepGitDir :: Parser KeepGitDir+keepGitDir = ( try keepGitDirExplicit <?> "explicit --keep-git-dir" )+ <|> ( try keepGitDirImplicit <?> "implicit --keep-git-dir" )+ where+ keepGitDirExplicit = do+ void $ string "--keep-git-dir="+ val <- string "true" <|> string "false"+ return $ KeepGitDir (val == "true")+ keepGitDirImplicit = do+ void $ string "--keep-git-dir"+ return $ KeepGitDir True++unpack :: Parser Unpack+unpack = ( try unpackExplicit <?> "explicit --unpack" )+ <|> ( try unpackImplicit <?> "implicit --unpack" )+ where+ unpackExplicit = do+ void $ string "--unpack="+ val <- string "true" <|> string "false"+ return $ Unpack (val == "true")+ unpackImplicit = do+ void $ string "--unpack"+ return $ Unpack True copySource :: (?esc :: Char) => Parser CopySource copySource = do
src/Language/Docker/Parser/From.hs view
@@ -9,9 +9,9 @@ parseRegistry :: (?esc :: Char) => Parser Registry parseRegistry = do- domain <- someUnless "a domain name" (== '.')+ domain <- someUnlessExpanded "a domain name" (== '.') void $ char '.'- tld <- someUnless "a TLD" (== '/')+ tld <- someUnlessExpanded "a TLD" (== '/') void $ char '/' return $ Registry (domain <> "." <> tld) @@ -22,12 +22,44 @@ requiredWhitespace return p +-- | Like someUnless, but a ${...} parameter expansion is opaque: a ':' or '@'+-- inside it (the :- :? :+ operators) is not read as the tag or digest+-- separator. One linear pass, bounded to the current line.+someUnlessExpanded :: (?esc :: Char) => String -> (Char -> Bool) -> Parser Text+someUnlessExpanded name predicate =+ mconcat <$> some (variableExpansion <|> literalRun) <?> name+ where+ literalRun = someUnless name (\c -> predicate c || c == '$')++-- | A '$' and, when it opens one, the balanced ${...} that follows. The scan+-- stops at whitespace, so an unterminated '${' stays literal text bounded like+-- any image reference (it cannot swallow a same-line 'AS' alias or a later+-- instruction, nor backtrack). Fragments are collected in a list and joined+-- once, so deep nesting stays linear.+variableExpansion :: Parser Text+variableExpansion = do+ void $ char '$'+ brace <- optional (char '{')+ case brace of+ Nothing -> return "$"+ Just _ -> ("${" <>) <$> braces [] (1 :: Int)+ where+ braces acc depth = do+ piece <- takeWhileP Nothing (\c -> c `notElem` ['{', '}', ' ', '\t', '\n'])+ next <- optional (char '{' <|> char '}')+ case next of+ Just '{' -> braces ("{" : piece : acc) $! depth + 1+ Just '}'+ | depth <= 1 -> return $ mconcat (reverse ("}" : piece : acc))+ | otherwise -> braces ("}" : piece : acc) $! depth - 1+ _ -> return $ mconcat (reverse (piece : acc))+ parseBaseImage :: (?esc :: Char) => (Text -> Parser (Maybe Tag)) -> Parser BaseImage parseBaseImage tagParser = do maybePlatform <- (Just <$> try parsePlatform) <|> return Nothing notFollowedBy (string "--") regName <- (Just <$> try parseRegistry) <|> return Nothing- name <- someUnless "the image name with a tag" (\c -> c == '@' || c == ':')+ name <- someUnlessExpanded "the image name with a tag" (\c -> c == '@' || c == ':') maybeTag <- tagParser name <|> return Nothing maybeDigest <- (Just <$> try parseDigest) <|> return Nothing maybeAlias <- (Just <$> try (requiredWhitespace *> imageAlias)) <|> return Nothing@@ -38,7 +70,7 @@ where tagParser _ = do void $ char ':'- t <- someUnless "the image tag" (\c -> c == '@' || c == ':')+ t <- someUnlessExpanded "the image tag" (\c -> c == '@' || c == ':') return (Just . Tag $ t) parseDigest :: (?esc :: Char) => Parser Digest
src/Language/Docker/Parser/Run.hs view
@@ -26,6 +26,7 @@ | MountArgReadOnly Bool | MountArgRequired Bool | MountArgSharing CacheSharing+ | MountArgSize Text | MountArgSource SourcePath | MountArgTarget TargetPath | MountArgType MountType@@ -147,13 +148,15 @@ tmpfsMount :: [RunMountArg] -> Parser TmpOpts tmpfsMount args =- case validArgs "tmpfs" required required args of+ case validArgs "tmpfs" allowed required args of Left e -> customError e Right as -> return $ foldr tmpOpts def as where+ allowed = Set.fromList [ "target", "size" ] required = Set.singleton "target" tmpOpts :: RunMountArg -> TmpOpts -> TmpOpts tmpOpts (MountArgTarget path) t = t {tTarget = path}+ tmpOpts (MountArgSize size) t = t {tSize = Just size} tmpOpts invalid _ = error $ "unhandled " <> show invalid <> " please report this bug" secretMount :: [RunMountArg] -> Parser SecretOpts@@ -209,6 +212,7 @@ mountArgRelabel, mountArgRequired, mountArgSharing,+ mountArgSize, mountArgSource, mountArgTarget, mountArgType,@@ -295,6 +299,9 @@ mountArgSharing :: Parser RunMountArg mountArgSharing = MountArgSharing <$> key "sharing" cacheSharing +mountArgSize :: (?esc :: Char) => Parser RunMountArg+mountArgSize = MountArgSize <$> key "size" stringArg+ mountArgSource :: (?esc :: Char) => Parser RunMountArg mountArgSource = do label "source=" $ choice [string "source=", string "src="]@@ -322,7 +329,13 @@ mountArgUid = MountArgUid <$> key "uid" stringArg mountArgRelabel :: Parser RunMountArg-mountArgRelabel = MountArgRelabel <$> key "relabel" relabel+mountArgRelabel =+ MountArgRelabel+ <$> choice+ [ key "relabel" relabel,+ RelabelShared <$ string "z",+ RelabelPrivate <$ string "Z"+ ] relabel :: Parser Relabel relabel = choice [RelabelShared <$ string "shared", RelabelPrivate <$ string "private"]@@ -336,6 +349,7 @@ toArgName (MountArgReadOnly _) = "ro" toArgName (MountArgRequired _) = "required" toArgName (MountArgSharing _) = "sharing"+toArgName (MountArgSize _) = "size" toArgName (MountArgSource _) = "source" toArgName (MountArgTarget _) = "target" toArgName (MountArgType _) = "type"
src/Language/Docker/PrettyPrint.hs view
@@ -154,12 +154,6 @@ Chmod c -> "--chmod=" <> pretty c NoChmod -> mempty -prettyPrintLink :: Link -> Doc ann-prettyPrintLink link =- case link of- Link -> "--link"- NoLink -> mempty- prettyPrintCopySource :: CopySource -> Doc ann prettyPrintCopySource source = case source of@@ -218,7 +212,10 @@ <> maybe mempty printUid sUid <> maybe mempty printGid sGid <> maybe mempty printRequired sIsRequired- TmpfsMount TmpOpts {..} -> "type=tmpfs" <> printTarget tTarget+ TmpfsMount TmpOpts {..} ->+ "type=tmpfs"+ <> printTarget tTarget+ <> maybe mempty printSize tSize printQuotable str | Text.any (== '"') str = doubleQoute str | otherwise = pretty str@@ -242,6 +239,7 @@ <> case r of RelabelShared -> printQuotable "shared" RelabelPrivate -> printQuotable "private"+ printSize s = ",size=" <> pretty s prettyPrintRunNetwork :: Maybe RunNetwork -> Doc ann prettyPrintRunNetwork Nothing = mempty@@ -293,11 +291,12 @@ prettyPrintArguments c Copy CopyArgs {sourcePaths, targetPath}- CopyFlags {chmodFlag, chownFlag, linkFlag, sourceFlag, excludeFlags} -> do+ CopyFlags {chmodFlag, chownFlag, linkFlag, parentsFlag, sourceFlag, excludeFlags} -> do "COPY" prettyPrintChown chownFlag prettyPrintChmod chmodFlag- prettyPrintLink linkFlag+ pretty linkFlag+ pretty parentsFlag prettyPrintCopySource sourceFlag prettyPrintExcludes excludeFlags prettyPrintFileList sourcePaths targetPath@@ -327,12 +326,14 @@ prettyPrintBaseImage b Add AddArgs {sourcePaths, targetPath}- AddFlags {checksumFlag, chownFlag, chmodFlag, linkFlag, excludeFlags} -> do+ AddFlags {checksumFlag, chownFlag, chmodFlag, linkFlag, keepGitDirFlag, unpackFlag, excludeFlags} -> do "ADD" prettyPrintChecksum checksumFlag prettyPrintChown chownFlag prettyPrintChmod chmodFlag- prettyPrintLink linkFlag+ pretty linkFlag+ pretty keepGitDirFlag+ pretty unpackFlag prettyPrintExcludes excludeFlags prettyPrintFileList sourcePaths targetPath Shell args -> do
src/Language/Docker/Syntax.hs view
@@ -22,9 +22,9 @@ import qualified Data.Text as Text import Data.Time.Clock (DiffTime) import GHC.Exts (IsList (..))+import Prettyprinter import Text.Printf - import Language.Docker.Syntax.Port import Language.Docker.Syntax.PortRange import Language.Docker.Syntax.Protocol@@ -158,10 +158,45 @@ _ -> Chmod (Text.pack ch) data Link- = Link+ = Link !Bool | NoLink deriving (Show, Eq, Ord) +instance Pretty Link where+ pretty ( Link True ) = "--link"+ pretty ( Link False ) = "--link=false"+ pretty NoLink = ""++data KeepGitDir+ = KeepGitDir !Bool+ | NoKeepGitDir+ deriving (Show, Eq, Ord)++instance Pretty KeepGitDir where+ pretty ( KeepGitDir True ) = "--keep-git-dir"+ pretty ( KeepGitDir False ) = "--keep-git-dir=false"+ pretty NoKeepGitDir = ""++data Parents+ = Parents !Bool+ | NoParents+ deriving (Show, Eq, Ord)++instance Pretty Parents where+ pretty ( Parents True ) = "--parents"+ pretty ( Parents False ) = "--parents=false"+ pretty NoParents = ""++data Unpack+ = Unpack !Bool+ | NoUnpack+ deriving (Show, Eq, Ord)++instance Pretty Unpack where+ pretty ( Unpack True ) = "--unpack"+ pretty ( Unpack False ) = "--unpack=false"+ pretty NoUnpack = ""+ data CopySource = CopySource !Text | NoSource@@ -197,13 +232,14 @@ { chownFlag :: !Chown, chmodFlag :: !Chmod, linkFlag :: !Link,+ parentsFlag :: !Parents, sourceFlag :: !CopySource, excludeFlags :: ![Exclude] } deriving (Show, Eq, Ord) instance Default CopyFlags where- def = CopyFlags NoChown NoChmod NoLink NoSource []+ def = CopyFlags NoChown NoChmod NoLink NoParents NoSource [] data AddArgs = AddArgs@@ -218,12 +254,14 @@ chownFlag :: !Chown, chmodFlag :: !Chmod, linkFlag :: !Link,+ keepGitDirFlag :: !KeepGitDir,+ unpackFlag :: !Unpack, excludeFlags :: ![Exclude] } deriving (Show, Eq, Ord) instance Default AddFlags where- def = AddFlags NoChecksum NoChown NoChmod NoLink []+ def = AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [] newtype Exclude = Exclude@@ -301,10 +339,15 @@ instance Default CacheOpts where def = CacheOpts "" Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -newtype TmpOpts = TmpOpts {tTarget :: TargetPath} deriving (Eq, Show, Ord)+data TmpOpts+ = TmpOpts+ { tTarget :: TargetPath,+ tSize :: !(Maybe Text)+ }+ deriving (Eq, Show, Ord) instance Default TmpOpts where- def = TmpOpts ""+ def = TmpOpts "" Nothing data SecretOpts = SecretOpts
test/Language/Docker/ParseAddSpec.hs view
@@ -47,7 +47,7 @@ file [ Add ( AddArgs (fmap SourcePath ["http://www.example.com/foo"]) (TargetPath "bar") )- ( AddFlags (Checksum "sha256:24454f830cdd") NoChown NoChmod NoLink [] )+ ( AddFlags (Checksum "sha256:24454f830cdd") NoChown NoChmod NoLink NoKeepGitDir NoUnpack [] ) ] it "with chown flag" $ let file = Text.unlines ["ADD --chown=root:root foo bar"]@@ -55,7 +55,7 @@ file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink [] )+ ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink NoKeepGitDir NoUnpack [] ) ] it "with chmod flag" $ let file = Text.unlines ["ADD --chmod=640 foo bar"]@@ -63,23 +63,70 @@ file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags NoChecksum NoChown (Chmod "640") NoLink [] )+ ( AddFlags NoChecksum NoChown (Chmod "640") NoLink NoKeepGitDir NoUnpack [] ) ]+ it "with link flag" $ let file = Text.unlines ["ADD --link foo bar"] in assertAst file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags NoChecksum NoChown NoChmod Link [])+ ( AddFlags NoChecksum NoChown NoChmod ( Link True ) NoKeepGitDir NoUnpack [] ) ]++ it "with link flag explicit true" $+ let file = Text.unlines ["ADD --link=true foo bar"]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod ( Link True ) NoKeepGitDir NoUnpack [] )+ ]++ it "with link flag explicit false" $+ let file = Text.unlines ["ADD --link=false foo bar"]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod ( Link False ) NoKeepGitDir NoUnpack [] )+ ]++ it "with keep-git-dir flag" $+ let file = Text.unlines ["ADD --keep-git-dir foo bar"]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir True ) NoUnpack [] )+ ]++ it "with keep-git-dir flag explicit true" $+ let file = Text.unlines ["ADD --keep-git-dir=true foo bar"]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir True ) NoUnpack [] )+ ]++ it "with keep-git-dir flag explicit false" $+ let file = Text.unlines ["ADD --keep-git-dir=false foo bar"]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir False ) NoUnpack [] )+ ]+ 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") )- ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink [] )+ ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink NoKeepGitDir NoUnpack [] ) ] it "with chown and chmod flag other order" $ let file = Text.unlines ["ADD --chmod=640 --chown=root:root foo bar"]@@ -87,16 +134,24 @@ file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink [] )+ ( AddFlags NoChecksum (Chown "root:root") (Chmod "640") NoLink NoKeepGitDir NoUnpack [] ) ] it "with all flags" $ let file =- Text.unlines ["ADD --chmod=640 --chown=root:root --checksum=sha256:24454f830cdd --link foo bar"]+ Text.unlines ["ADD --chmod=640 --chown=root:root --checksum=sha256:24454f830cdd --link --keep-git-dir --unpack foo bar"] in assertAst file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags (Checksum "sha256:24454f830cdd") (Chown "root:root") (Chmod "640") Link [] )+ ( AddFlags+ ( Checksum "sha256:24454f830cdd" )+ ( Chown "root:root" )+ ( Chmod "640" )+ ( Link True )+ ( KeepGitDir True )+ ( Unpack True )+ []+ ) ] it "list of quoted files and chown" $ let file =@@ -109,15 +164,39 @@ (fmap SourcePath ["foo", "bar", "baz"]) (TargetPath "/app") )- ( AddFlags NoChecksum (Chown "user:group") NoChmod NoLink [] )+ ( AddFlags NoChecksum (Chown "user:group") NoChmod NoLink NoKeepGitDir NoUnpack [] ) ]+ it "with unpack flag" $+ let file = Text.unlines ["ADD --unpack http://www.example.com/archive.tar.gz /download"]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["http://www.example.com/archive.tar.gz"]) (TargetPath "/download") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack True) [] )+ ]+ it "with unpack flag explicit true" $+ let file = Text.unlines ["ADD --unpack=true http://www.example.com/archive.tar.gz /download"]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["http://www.example.com/archive.tar.gz"]) (TargetPath "/download") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack True) [] )+ ]+ it "with unpack flag explicit false" $+ let file = Text.unlines ["ADD --unpack=false my-archive.tar.gz ."]+ in assertAst+ file+ [ Add+ ( AddArgs (fmap SourcePath ["my-archive.tar.gz"]) (TargetPath ".") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack False) [] )+ ] it "with exclude flag" $ let file = Text.unlines ["ADD --exclude=*.tmp foo bar"] in assertAst file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp"] )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp"] ) ] it "with multiple exclude flags" $ let file = Text.unlines ["ADD --exclude=*.tmp --exclude=*.log foo bar"]@@ -125,7 +204,7 @@ file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp", Exclude "*.log"] )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp", Exclude "*.log"] ) ] it "with exclude and other flags" $ let file = Text.unlines ["ADD --chown=root:root --exclude=*.tmp foo bar"]@@ -133,5 +212,5 @@ file [ Add ( AddArgs (fmap SourcePath ["foo"]) (TargetPath "bar") )- ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink [Exclude "*.tmp"] )+ ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp"] ) ]
test/Language/Docker/ParseCopySpec.hs view
@@ -68,7 +68,7 @@ file [ Copy ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )- ( CopyFlags ( Chown "user:group" ) NoChmod NoLink NoSource [])+ ( CopyFlags ( Chown "user:group" ) NoChmod NoLink NoParents NoSource []) ] it "with chmod flag" $ let file = Text.unlines ["COPY --chmod=777 foo bar"]@@ -76,28 +76,75 @@ file [ Copy ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )- ( CopyFlags NoChown ( Chmod "777" ) NoLink NoSource [])+ ( CopyFlags NoChown ( Chmod "777" ) NoLink NoParents NoSource []) ]+ it "with link flag" $ let file = Text.unlines [ "COPY --link source /target" ] in assertAst file [ Copy ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )- ( CopyFlags NoChown NoChmod Link NoSource [])+ ( CopyFlags NoChown NoChmod ( Link True ) NoParents NoSource []) ]++ it "with link flag explicit true" $+ let file = Text.unlines [ "COPY --link=true source /target" ]+ in assertAst+ file+ [ Copy+ ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+ ( CopyFlags NoChown NoChmod ( Link True ) NoParents NoSource [])+ ]++ it "with link flag explicit false" $+ let file = Text.unlines [ "COPY --link=false source /target" ]+ in assertAst+ file+ [ Copy+ ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+ ( CopyFlags NoChown NoChmod ( Link False ) NoParents NoSource [])+ ]++ it "with parents flag" $+ let file = Text.unlines [ "COPY --parents source /target" ]+ in assertAst+ file+ [ Copy+ ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+ ( CopyFlags NoChown NoChmod NoLink ( Parents True ) NoSource [])+ ]++ it "with parents flag explicit true" $+ let file = Text.unlines [ "COPY --parents=true source /target" ]+ in assertAst+ file+ [ Copy+ ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+ ( CopyFlags NoChown NoChmod NoLink ( Parents True ) NoSource [])+ ]++ it "with parents flag explicit false" $+ let file = Text.unlines [ "COPY --parents=false source /target" ]+ in assertAst+ file+ [ Copy+ ( CopyArgs [ SourcePath "source" ] ( TargetPath "/target" ) )+ ( CopyFlags NoChown NoChmod NoLink ( Parents False ) NoSource [])+ ]+ it "with from flag" $ let file = Text.unlines ["COPY --from=node foo bar"] in assertAst file [ Copy ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )- ( CopyFlags NoChown NoChmod NoLink ( CopySource "node" ) [])+ ( CopyFlags NoChown NoChmod NoLink NoParents ( CopySource "node" ) []) ] it "with all flags" $ let file = Text.unlines- [ "COPY --from=node --chmod=751 --link --chown=user:group foo bar" ]+ [ "COPY --from=node --chmod=751 --link --chown=user:group --parents foo bar" ] in assertAst file [ Copy@@ -105,7 +152,8 @@ ( CopyFlags (Chown "user:group") (Chmod "751")- Link+ ( Link True )+ ( Parents True ) (CopySource "node") [] )@@ -113,7 +161,7 @@ it "with all flags in different order" $ let file = Text.unlines- [ "COPY --link --chown=user:group --from=node --chmod=644 foo bar" ]+ [ "COPY --link --parents --chown=user:group --from=node --chmod=644 foo bar" ] in assertAst file [ Copy@@ -121,7 +169,8 @@ ( CopyFlags (Chown "user:group") (Chmod "644")- Link+ ( Link True )+ ( Parents True ) (CopySource "node") [] )@@ -132,7 +181,7 @@ file [ Copy ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )- ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp"] )+ ( CopyFlags NoChown NoChmod NoLink NoParents NoSource [Exclude "*.tmp"] ) ] it "with multiple exclude flags" $ let file = Text.unlines ["COPY --exclude=*.tmp --exclude=*.log foo bar"]@@ -140,7 +189,7 @@ file [ Copy ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )- ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp", Exclude "*.log"] )+ ( CopyFlags NoChown NoChmod NoLink NoParents NoSource [Exclude "*.tmp", Exclude "*.log"] ) ] it "with exclude and other flags" $ let file = Text.unlines ["COPY --chown=root:root --exclude=*.tmp foo bar"]@@ -148,7 +197,7 @@ file [ Copy ( CopyArgs [ SourcePath "foo" ] (TargetPath "bar") )- ( CopyFlags (Chown "root:root") NoChmod NoLink NoSource [Exclude "*.tmp"] )+ ( CopyFlags (Chown "root:root") NoChmod NoLink NoParents NoSource [Exclude "*.tmp"] ) ] describe "Copy with Heredocs" $ do
test/Language/Docker/ParseRunSpec.hs view
@@ -168,6 +168,11 @@ file [ Run $ RunArgs (ArgumentsText "echo foo") flags ]+ it "--mount=type=tmpfs,size=12G" $+ let file = Text.unlines ["RUN --mount=type=tmpfs,target=/foo,size=12G foo bar"]+ flags = def { mount = Set.singleton $ TmpfsMount (def {tTarget = "/foo", tSize = Just "12G"}) }+ in assertAst file [ Run $ RunArgs ( ArgumentsText "foo bar" ) flags ]+ it "--mount=type=ssh" $ let file = Text.unlines ["RUN --mount=type=ssh echo foo"] flags = def {mount = Set.singleton $ SshMount def}@@ -733,4 +738,12 @@ it "RUN with --relabel=private" $ let file = Text.unlines ["RUN --mount=type=bind,target=/bar,relabel=private echo foo"]+ in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelPrivate ]+ it "RUN with short SELinux relabel z" $+ let file = Text.unlines+ ["RUN --mount=type=bind,target=/bar,z echo foo"]+ in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelShared ]+ it "RUN with short SELinux relabel Z" $+ let file = Text.unlines+ ["RUN --mount=type=bind,target=/bar,Z echo foo"] in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelPrivate ]
test/Language/Docker/ParserSpec.hs view
@@ -64,6 +64,32 @@ assertAst "FROM myfolder/imagename:5.12-dev" [From (taggedImage (Image Nothing "myfolder/imagename") "5.12-dev")]+ describe "parse FROM with variable expansion" $ do+ it "keeps ':' inside an expansion out of the tag" $+ assertAst+ "FROM ${IMAGE_PREFIX:?}${DISTRO:?}:${VERSION_DISTRO:?}"+ [From (taggedImage "${IMAGE_PREFIX:?}${DISTRO:?}" "${VERSION_DISTRO:?}")]+ it "handles :- and :+ operators" $+ assertAst+ "FROM ${BASE:-alpine}:${TAG:+edge}"+ [From (taggedImage "${BASE:-alpine}" "${TAG:+edge}")]+ it "handles a nested expansion" $+ assertAst "FROM ${BASE:-${DEFAULT}}" [From (untaggedImage "${BASE:-${DEFAULT}}")]+ it "keeps expansion with a slash in the registry" $+ assertAst+ "FROM ${REGISTRY:-docker.io/library}/myimage:tag"+ [From (taggedImage (Image Nothing "${REGISTRY:-docker.io/library}/myimage") "tag")]+ it "an unterminated ${ stays on its line" $+ assertAst+ "FROM ${BASE:x\nRUN y"+ [From (untaggedImage "${BASE:x"), Run "y"]+ it "an unterminated ${ keeps a following alias" $+ assertAst+ "FROM ${BASE AS build"+ [From (untaggedImage "${BASE" `withAlias` "build")]+ it "nested expansion with unterminated ${" $+ assertAst "FROM ${BASE:-${DEFAULT}" [From (untaggedImage "${BASE:-${DEFAULT}")]+ describe "parse LABEL" $ do it "parse label" $ assertAst "LABEL foo=bar" [Label [("foo", "bar")]] it "parse space separated label" $ assertAst "LABEL foo bar baz" [Label [("foo", "bar baz")]]
test/Language/Docker/PrettyPrintSpec.hs view
@@ -4,6 +4,7 @@ module Language.Docker.PrettyPrintSpec where import Data.Default+import qualified Data.Set as Set import qualified Data.Text as Text import Prettyprinter import Prettyprinter.Render.Text@@ -24,42 +25,77 @@ it "with just checksum" $ do let add = Add ( AddArgs [SourcePath "http://www.example.com/foo"] (TargetPath "bar") )- ( AddFlags ( Checksum "sha256:24454f830cdd" ) NoChown NoChmod NoLink [])+ ( AddFlags ( Checksum "sha256:24454f830cdd" ) NoChown NoChmod NoLink NoKeepGitDir NoUnpack []) in assertPretty "ADD --checksum=sha256:24454f830cdd http://www.example.com/foo bar" add it "with just chown" $ do let add = Add ( AddArgs [SourcePath "foo"] (TargetPath "bar") )- ( AddFlags NoChecksum ( Chown "root:root" ) NoChmod NoLink [] )+ ( AddFlags NoChecksum ( Chown "root:root" ) NoChmod NoLink NoKeepGitDir NoUnpack [] ) in assertPretty "ADD --chown=root:root foo bar" add it "with just chmod" $ do let add = Add ( AddArgs [SourcePath "foo"] (TargetPath "bar") )- ( AddFlags NoChecksum NoChown ( Chmod "751" ) NoLink [] )+ ( AddFlags NoChecksum NoChown ( Chmod "751" ) NoLink NoKeepGitDir NoUnpack [] ) in assertPretty "ADD --chmod=751 foo bar" add- it "with just link" $ do+ it "with just link (true)" $ do let add = Add ( AddArgs [SourcePath "foo"] (TargetPath "bar") )- ( AddFlags NoChecksum NoChown NoChmod Link [] )+ ( AddFlags NoChecksum NoChown NoChmod ( Link True ) NoKeepGitDir NoUnpack [] ) in assertPretty "ADD --link foo bar" add++ it "with just link (false)" $ do+ let add = Add+ ( AddArgs [SourcePath "foo"] (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod ( Link False ) NoKeepGitDir NoUnpack [] )+ in assertPretty "ADD --link=false foo bar" add++ it "with just keep-git-dir" $ do+ let add = Add+ ( AddArgs [SourcePath "foo"] (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink ( KeepGitDir True ) NoUnpack [] )+ in assertPretty "ADD --keep-git-dir foo bar" add it "with chown, chmod and link" $ do let add = Add ( AddArgs [SourcePath "foo"] (TargetPath "bar") )- ( AddFlags NoChecksum ( Chown "root:root" ) ( Chmod "751" ) Link [] )+ ( AddFlags NoChecksum ( Chown "root:root" ) ( Chmod "751" ) ( Link True ) NoKeepGitDir NoUnpack [] ) in assertPretty "ADD --chown=root:root --chmod=751 --link foo bar" add+ it "with all flags" $ do+ let add = Add+ ( AddArgs [SourcePath "foo"] (TargetPath "bar") )+ ( AddFlags+ ( Checksum "sha256:24454f830cdd" )+ ( Chown "root:root" )+ ( Chmod "751" )+ ( Link True )+ ( KeepGitDir True )+ ( Unpack True )+ []+ )+ in assertPretty "ADD --checksum=sha256:24454f830cdd --chown=root:root --chmod=751 --link --keep-git-dir --unpack foo bar" add+ it "with unpack true" $ do+ let add = Add+ ( AddArgs [SourcePath "foo"] (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack True) [] )+ in assertPretty "ADD --unpack foo bar" add+ it "with unpack false" $ do+ let add = Add+ ( AddArgs [SourcePath "foo"] (TargetPath "bar") )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir (Unpack False) [] )+ in assertPretty "ADD --unpack=false foo bar" add it "with just exclude" $ do let add = Add ( AddArgs [SourcePath "foo"] (TargetPath "bar") )- ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp"] )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp"] ) in assertPretty "ADD --exclude=*.tmp foo bar" add it "with multiple exclude flags" $ do let add = Add ( AddArgs [SourcePath "foo"] (TargetPath "bar") )- ( AddFlags NoChecksum NoChown NoChmod NoLink [Exclude "*.tmp", Exclude "*.log"] )+ ( AddFlags NoChecksum NoChown NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp", Exclude "*.log"] ) in assertPretty "ADD --exclude=*.tmp --exclude=*.log foo bar" add it "with exclude and other flags" $ do let add = Add ( AddArgs [SourcePath "foo"] (TargetPath "bar") )- ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink [Exclude "*.tmp"] )+ ( AddFlags NoChecksum (Chown "root:root") NoChmod NoLink NoKeepGitDir NoUnpack [Exclude "*.tmp"] ) in assertPretty "ADD --chown=root:root --exclude=*.tmp foo bar" add describe "pretty print COPY" $ do@@ -71,32 +107,46 @@ it "with just chown" $ do let copy = Copy ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )- ( CopyFlags ( Chown "root:root" ) NoChmod NoLink NoSource [] )+ ( CopyFlags ( Chown "root:root" ) NoChmod NoLink NoParents NoSource [] ) in assertPretty "COPY --chown=root:root foo bar" copy it "with just chmod" $ do let copy = Copy ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )- ( CopyFlags NoChown ( Chmod "751" ) NoLink NoSource [] )+ ( CopyFlags NoChown ( Chmod "751" ) NoLink NoParents NoSource [] ) in assertPretty "COPY --chmod=751 foo bar" copy- it "with just link" $ do+ it "with just link (true)" $ do let copy = Copy ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )- ( CopyFlags NoChown NoChmod Link NoSource [] )+ ( CopyFlags NoChown NoChmod ( Link True ) NoParents NoSource [] ) in assertPretty "COPY --link foo bar" copy++ it "with just link (false)" $ do+ let copy = Copy+ ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )+ ( CopyFlags NoChown NoChmod ( Link False ) NoParents NoSource [] )+ in assertPretty "COPY --link=false foo bar" copy++ it "with just parents" $ do+ let copy = Copy+ ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )+ ( CopyFlags NoChown NoChmod NoLink ( Parents True ) NoSource [] )+ in assertPretty "COPY --parents foo bar" copy+ it "with source baseimage" $ do let copy = Copy ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )- ( CopyFlags NoChown NoChmod NoLink ( CopySource "baseimage" ) [])+ ( CopyFlags NoChown NoChmod NoLink NoParents ( 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") ) ( CopyFlags- ( Chown "root:root" ) ( Chmod "751" ) NoLink NoSource []+ ( Chown "root:root" ) ( Chmod "751" ) NoLink NoParents NoSource [] ) in assertPretty "COPY --chown=root:root --chmod=751 foo bar" copy+ it "with all flags" $ do let copy = Copy@@ -104,28 +154,53 @@ ( CopyFlags ( Chown "root:root") ( Chmod "751")- Link+ ( Link True )+ ( Parents True ) ( CopySource "baseimage" ) [] ) in assertPretty- "COPY --chown=root:root --chmod=751 --link --from=baseimage foo bar"+ "COPY --chown=root:root --chmod=751 --link --parents --from=baseimage foo bar" copy+ it "with just exclude" $ do let copy = Copy ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )- ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp"] )+ ( CopyFlags NoChown NoChmod NoLink NoParents NoSource [Exclude "*.tmp"] ) in assertPretty "COPY --exclude=*.tmp foo bar" copy it "with multiple exclude flags" $ do let copy = Copy ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )- ( CopyFlags NoChown NoChmod NoLink NoSource [Exclude "*.tmp", Exclude "*.log"] )+ ( CopyFlags NoChown NoChmod NoLink NoParents NoSource [Exclude "*.tmp", Exclude "*.log"] ) in assertPretty "COPY --exclude=*.tmp --exclude=*.log foo bar" copy it "with exclude and other flags" $ do let copy = Copy ( CopyArgs [SourcePath "foo"] (TargetPath "bar") )- ( CopyFlags (Chown "root:root") NoChmod NoLink NoSource [Exclude "*.tmp"] )+ ( CopyFlags (Chown "root:root") NoChmod NoLink NoParents NoSource [Exclude "*.tmp"] ) in assertPretty "COPY --chown=root:root --exclude=*.tmp foo bar" copy++ describe "pretty print RUN" $ do+ it "just a simple RUN" $ do+ let run = Run ( RunArgs ( ArgumentsText "foobar" ) def )+ in assertPretty "RUN foobar" run++ it "RUN in JSON format" $ do+ let run = Run ( RunArgs ( ArgumentsList "foobar barfoo" ) def )+ in assertPretty "RUN [\"foobar\", \"barfoo\"]" run++ it "RUN with --mount=type=tmpfs" $ do+ let run =+ Run+ ( RunArgs+ ( ArgumentsText "foobar" )+ ( RunFlags+ { mount = Set.singleton ( TmpfsMount ( TmpOpts "/tgt" (Just "4G") ) ),+ security = Nothing,+ network = Nothing+ }+ )+ )+ in assertPretty "RUN --mount=type=tmpfs,target=/tgt,size=4G foobar" run describe "pretty print # escape" $ do it "# escape = \\" $ do