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: 1819127237c882c67c2cc100efbbd0bdc47dd9b03cf32e6381901974028706ab +-- hash: e958774001a0ee7648ae873f3676eeb96096d835bfc0ce02bf292d23c4f1b716 name: language-docker -version: 10.2.0 +version: 10.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. @@ -34,6 +34,11 @@ test/fixtures/6.Dockerfile test/fixtures/7.Dockerfile test/fixtures/8.Dockerfile + test/fixtures/Dockerfile.bom.utf32be + test/fixtures/Dockerfile.bom.utf32le + test/fixtures/Dockerfile.bom.utf16be + test/fixtures/Dockerfile.bom.utf16le + test/fixtures/Dockerfile.bom.utf8 source-repository head type: git diff --git a/src/Language/Docker/Parser/Run.hs b/src/Language/Docker/Parser/Run.hs --- a/src/Language/Docker/Parser/Run.hs +++ b/src/Language/Docker/Parser/Run.hs @@ -46,7 +46,7 @@ runArguments :: (?esc :: Char) => Parser (RunArgs Text) runArguments = do - presentFlags <- choice [runFlags <* requiredWhitespace, pure (RunFlags Nothing Nothing Nothing)] + presentFlags <- choice [runFlags <* requiredWhitespace, pure (RunFlags mempty Nothing Nothing)] args <- arguments return $ RunArgs args presentFlags @@ -56,8 +56,8 @@ return $ foldr toRunFlags emptyFlags flags where flagSeparator = try (requiredWhitespace *> lookAhead (string "--")) <|> fail "expected flag" - emptyFlags = RunFlags Nothing Nothing Nothing - toRunFlags (RunFlagMount m) rf = rf {mount = Just m} + emptyFlags = RunFlags mempty Nothing Nothing + toRunFlags (RunFlagMount m) rf@RunFlags { mount = mnt } = rf {mount = Set.insert m mnt} toRunFlags (RunFlagNetwork n) rf = rf {network = Just n} toRunFlags (RunFlagSecurity s) rf = rf {security = Just s} 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 @@ -9,16 +9,18 @@ module Language.Docker.PrettyPrint where import Data.List.NonEmpty as NonEmpty (NonEmpty (..), toList) +import Data.Set (Set) import Data.String (fromString) import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Lazy as L -import qualified Data.Text.Lazy.Builder as B import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Internal (Doc (Empty)) import Data.Text.Prettyprint.Doc.Render.Text (renderLazy) import Language.Docker.Syntax import Prelude hiding ((<>), (>>)) +import qualified Data.Set as Set +import qualified Data.Text as Text +import qualified Data.Text.Lazy as L +import qualified Data.Text.Lazy.Builder as B data EscapeAccum = EscapeAccum @@ -165,47 +167,48 @@ where pp (Retries r) = "--retries=" <> pretty r -prettyPrintRunMount :: (?esc :: Char) => Maybe RunMount -> Doc ann -prettyPrintRunMount Nothing = mempty -prettyPrintRunMount (Just mount) = "--mount=" - <> case mount of - BindMount BindOpts {..} -> - "type=bind" - <> printTarget bTarget - <> maybe mempty printSource bSource - <> maybe mempty printFromImage bFromImage - <> maybe mempty printReadOnly bReadOnly - CacheMount CacheOpts {..} -> - "type=cache" - <> printTarget cTarget - <> maybe mempty printSharing cSharing - <> maybe mempty printId cCacheId - <> maybe mempty printFromImage cFromImage - <> maybe mempty printSource cSource - <> maybe mempty printMode cMode - <> maybe mempty printUid cUid - <> maybe mempty printGid cGid - <> maybe mempty printReadOnly cReadOnly - SshMount SecretOpts {..} -> - "type=ssh" - <> maybe mempty printTarget sTarget - <> maybe mempty printId sCacheId - <> maybe mempty printSource sSource - <> maybe mempty printMode sMode - <> maybe mempty printUid sUid - <> maybe mempty printGid sGid - <> maybe mempty printRequired sIsRequired - SecretMount SecretOpts {..} -> - "type=secret" - <> maybe mempty printTarget sTarget - <> maybe mempty printId sCacheId - <> maybe mempty printSource sSource - <> maybe mempty printMode sMode - <> maybe mempty printUid sUid - <> maybe mempty printGid sGid - <> maybe mempty printRequired sIsRequired - TmpfsMount TmpOpts {..} -> "type=tmpfs" <> printTarget tTarget +prettyPrintRunMount :: (?esc :: Char) => Set RunMount -> Doc ann +prettyPrintRunMount set = + foldl (<>) "" (map printSingleMount (Set.toList set)) where + printSingleMount mount = "--mount=" + <> case mount of + BindMount BindOpts {..} -> + "type=bind" + <> printTarget bTarget + <> maybe mempty printSource bSource + <> maybe mempty printFromImage bFromImage + <> maybe mempty printReadOnly bReadOnly + CacheMount CacheOpts {..} -> + "type=cache" + <> printTarget cTarget + <> maybe mempty printSharing cSharing + <> maybe mempty printId cCacheId + <> maybe mempty printFromImage cFromImage + <> maybe mempty printSource cSource + <> maybe mempty printMode cMode + <> maybe mempty printUid cUid + <> maybe mempty printGid cGid + <> maybe mempty printReadOnly cReadOnly + SshMount SecretOpts {..} -> + "type=ssh" + <> maybe mempty printTarget sTarget + <> maybe mempty printId sCacheId + <> maybe mempty printSource sSource + <> maybe mempty printMode sMode + <> maybe mempty printUid sUid + <> maybe mempty printGid sGid + <> maybe mempty printRequired sIsRequired + SecretMount SecretOpts {..} -> + "type=secret" + <> maybe mempty printTarget sTarget + <> maybe mempty printId sCacheId + <> maybe mempty printSource sSource + <> maybe mempty printMode sMode + <> maybe mempty printUid sUid + <> maybe mempty printGid sGid + <> maybe mempty printRequired sIsRequired + TmpfsMount TmpOpts {..} -> "type=tmpfs" <> printTarget tTarget printQuotable str | Text.any (== '"') str = doubleQoute str | otherwise = pretty str 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 @@ -12,6 +12,7 @@ import Data.List.Split (endBy) import Data.String (IsString (..)) import Data.Text (Text) +import Data.Set (Set) import qualified Data.Text as Text import Data.Time.Clock (DiffTime) import GHC.Exts (IsList (..)) @@ -288,14 +289,14 @@ data RunFlags = RunFlags - { mount :: !(Maybe RunMount), + { mount :: !(Set RunMount), security :: !(Maybe RunSecurity), network :: !(Maybe RunNetwork) } deriving (Show, Eq, Ord) instance Default RunFlags where - def = RunFlags Nothing Nothing Nothing + def = RunFlags mempty Nothing Nothing data RunArgs args = RunArgs (Arguments args) RunFlags deriving (Show, Eq, Ord, Functor) @@ -305,9 +306,9 @@ RunArgs (ArgumentsText . Text.pack $ s) RunFlags - { security = Nothing, - network = Nothing, - mount = Nothing + { mount = mempty, + security = Nothing, + network = Nothing } newtype EscapeChar diff --git a/test/Language/Docker/ParseRunSpec.hs b/test/Language/Docker/ParseRunSpec.hs --- a/test/Language/Docker/ParseRunSpec.hs +++ b/test/Language/Docker/ParseRunSpec.hs @@ -1,12 +1,13 @@ module Language.Docker.ParseRunSpec where import Data.Default.Class (def) -import qualified Data.Text as Text import Language.Docker.Parser import Language.Docker.Syntax -import TestHelper import Test.HUnit hiding (Label) import Test.Hspec +import TestHelper +import qualified Data.Set as Set +import qualified Data.Text as Text spec :: Spec @@ -35,21 +36,21 @@ describe "RUN with experimental flags" $ do it "--mount=type=bind and target" $ let file = Text.unlines ["RUN --mount=type=bind,target=/foo echo foo"] - flags = def {mount = Just $ BindMount (def {bTarget = "/foo"})} + flags = def {mount = Set.singleton $ BindMount (def {bTarget = "/foo"})} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount default to bind" $ let file = Text.unlines ["RUN --mount=target=/foo echo foo"] - flags = def {mount = Just $ BindMount (def {bTarget = "/foo"})} + flags = def {mount = Set.singleton $ BindMount (def {bTarget = "/foo"})} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount=type=bind all modifiers" $ let file = Text.unlines ["RUN --mount=type=bind,target=/foo,source=/bar,from=ubuntu,ro echo foo"] - flags = def {mount = Just $ BindMount (BindOpts {bTarget = "/foo", bSource = Just "/bar", bFromImage = Just "ubuntu", bReadOnly = Just True})} + flags = def {mount = Set.singleton $ BindMount (BindOpts {bTarget = "/foo", bSource = Just "/bar", bFromImage = Just "ubuntu", bReadOnly = Just True})} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags @@ -61,9 +62,9 @@ "RUN --mount=type=cache,target=/bar echo foo", "RUN --mount=type=cache,target=/baz echo foo" ] - flags1 = def {mount = Just $ CacheMount (def {cTarget = "/foo"})} - flags2 = def {mount = Just $ CacheMount (def {cTarget = "/bar"})} - flags3 = def {mount = Just $ CacheMount (def {cTarget = "/baz"})} + flags1 = def {mount = Set.singleton $ CacheMount (def {cTarget = "/foo"})} + flags2 = def {mount = Set.singleton $ CacheMount (def {cTarget = "/bar"})} + flags3 = def {mount = Set.singleton $ CacheMount (def {cTarget = "/baz"})} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags1, @@ -78,7 +79,7 @@ flags = def { mount = - Just $ + Set.singleton $ CacheMount ( def { cTarget = "/foo", @@ -99,42 +100,42 @@ ] it "--mount=type=tmpfs" $ let file = Text.unlines ["RUN --mount=type=tmpfs,target=/foo echo foo"] - flags = def {mount = Just $ TmpfsMount (def {tTarget = "/foo"})} + flags = def {mount = Set.singleton $ TmpfsMount (def {tTarget = "/foo"})} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount=type=ssh" $ let file = Text.unlines ["RUN --mount=type=ssh echo foo"] - flags = def {mount = Just $ SshMount def} + flags = def {mount = Set.singleton $ SshMount def} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount=type=ssh,required=false" $ let file = Text.unlines ["RUN --mount=type=ssh,required=false echo foo"] - flags = def {mount = Just $ SshMount def {sIsRequired = Just False}} + flags = def {mount = Set.singleton $ SshMount def {sIsRequired = Just False}} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount=type=ssh,required=False" $ let file = Text.unlines ["RUN --mount=type=ssh,required=False echo foo"] - flags = def {mount = Just $ SshMount def {sIsRequired = Just False}} + flags = def {mount = Set.singleton $ SshMount def {sIsRequired = Just False}} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount=type=secret,required=true" $ let file = Text.unlines ["RUN --mount=type=secret,required=true echo foo"] - flags = def {mount = Just $ SecretMount def {sIsRequired = Just True}} + flags = def {mount = Set.singleton $ SecretMount def {sIsRequired = Just True}} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount=type=secret,required=True" $ let file = Text.unlines ["RUN --mount=type=secret,required=True echo foo"] - flags = def {mount = Just $ SecretMount def {sIsRequired = Just True}} + flags = def {mount = Set.singleton $ SecretMount def {sIsRequired = Just True}} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags @@ -144,7 +145,7 @@ flags = def { mount = - Just $ + Set.singleton $ SshMount ( def { sTarget = Just "/foo", @@ -166,7 +167,7 @@ flags = def { mount = - Just $ + Set.singleton $ SshMount ( def { sTarget = Just "/foo", @@ -188,7 +189,7 @@ flags = def { mount = - Just $ + Set.singleton $ SecretMount ( def { sTarget = Just "/foo", @@ -210,7 +211,7 @@ flags = def { mount = - Just $ + Set.singleton $ SecretMount ( def { sTarget = Just "/foo", @@ -232,7 +233,7 @@ flags = def { mount = - Just $ + Set.singleton $ CacheMount ( def { cTarget = TargetPath "/foo", @@ -245,6 +246,42 @@ file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] + it "multiple --mount=type=cache flags" $ + let file = Text.unlines + [ "RUN --mount=type=cache,target=/foo \\", + " --mount=type=cache,target=/bar \\", + " echo foo" + ] + flags = + def + { mount = + Set.fromList + [ CacheMount ( def { cTarget = TargetPath "/foo" } ), + CacheMount ( def { cTarget = TargetPath "/bar" } ) + ] + } + in assertAst + file + [ Run $ RunArgs (ArgumentsText "echo foo") flags + ] + it "multiple different --mount flags" $ + let file = Text.unlines + [ "RUN --mount=type=cache,target=/foo \\", + " --mount=type=secret,target=/bar \\", + " echo foo" + ] + flags = + def + { mount = + Set.fromList + [ CacheMount ( def { cTarget = TargetPath "/foo" } ), + SecretMount ( def { sTarget = Just "/bar" } ) + ] + } + in assertAst + file + [ Run $ RunArgs (ArgumentsText "echo foo") flags + ] it "--network=none" $ let file = Text.unlines ["RUN --network=none echo foo"] flags = def {network = Just NetworkNone} @@ -286,7 +323,7 @@ def { security = Just Sandbox, network = Just NetworkNone, - mount = Just $ BindMount $ def {bTarget = "/foo"} + mount = Set.singleton $ BindMount $ def {bTarget = "/foo"} } in assertAst file diff --git a/test/fixtures/Dockerfile.bom.utf16be b/test/fixtures/Dockerfile.bom.utf16be new file mode 100644 Binary files /dev/null and b/test/fixtures/Dockerfile.bom.utf16be differ diff --git a/test/fixtures/Dockerfile.bom.utf16le b/test/fixtures/Dockerfile.bom.utf16le new file mode 100644 Binary files /dev/null and b/test/fixtures/Dockerfile.bom.utf16le differ diff --git a/test/fixtures/Dockerfile.bom.utf32be b/test/fixtures/Dockerfile.bom.utf32be new file mode 100644 Binary files /dev/null and b/test/fixtures/Dockerfile.bom.utf32be differ diff --git a/test/fixtures/Dockerfile.bom.utf32le b/test/fixtures/Dockerfile.bom.utf32le new file mode 100644 Binary files /dev/null and b/test/fixtures/Dockerfile.bom.utf32le differ diff --git a/test/fixtures/Dockerfile.bom.utf8 b/test/fixtures/Dockerfile.bom.utf8 new file mode 100644 --- /dev/null +++ b/test/fixtures/Dockerfile.bom.utf8 @@ -0,0 +1,3 @@ +FROM debian:11 +USER root +RUN foo bar