Merge pull request #73 from m-ildefons/multiple-run-mounts

syntax: handle multiple `RUN` mount flags
hadolint · Oct 25, 2021 · 8f2d1c0 · 8f2d1c0
2 parents 6996136 + 5d42c1b
commit 8f2d1c0
Show file tree

Hide file tree

Showing 6 changed files with 116 additions and 75 deletions.
diff --git a/language-docker.cabal b/language-docker.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1819127237c882c67c2cc100efbbd0bdc47dd9b03cf32e6381901974028706ab
+-- hash: 797bec50cbf30bc384022e539dd06b34fb833631112f23eba227db63e7463312
 
 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 <https://github.com/hadolint/language-docker GitHub project> for the source-code and examples.

diff --git a/package.yaml b/package.yaml
@@ -1,5 +1,5 @@
 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

diff --git a/src/Language/Docker/Parser/Run.hs b/src/Language/Docker/Parser/Run.hs
@@ -46,7 +46,7 @@ parseRun = do
 
 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 @@ runFlags = do
   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
@@ -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 @@ prettyPrintRetries = maybe mempty pp
   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
@@ -12,6 +12,7 @@ import Data.List.NonEmpty (NonEmpty)
 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 RunNetwork
 
 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 @@ instance IsString (RunArgs Text) where
     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
@@ -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 @@ spec = do
   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 @@ spec = do
                 "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 @@ spec = do
           flags =
             def
               { mount =
-                  Just $
+                  Set.singleton $
                     CacheMount
                       ( def
                           { cTarget = "/foo",
@@ -99,42 +100,42 @@ spec = do
             ]
     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 @@ spec = do
           flags =
             def
               { mount =
-                  Just $
+                  Set.singleton $
                     SshMount
                       ( def
                           { sTarget = Just "/foo",
@@ -166,7 +167,7 @@ spec = do
           flags =
             def
               { mount =
-                  Just $
+                  Set.singleton $
                     SshMount
                       ( def
                           { sTarget = Just "/foo",
@@ -188,7 +189,7 @@ spec = do
           flags =
             def
               { mount =
-                  Just $
+                  Set.singleton $
                     SecretMount
                       ( def
                           { sTarget = Just "/foo",
@@ -210,7 +211,7 @@ spec = do
           flags =
             def
               { mount =
-                  Just $
+                  Set.singleton $
                     SecretMount
                       ( def
                           { sTarget = Just "/foo",
@@ -232,7 +233,7 @@ spec = do
           flags =
             def
               { mount =
-                  Just $
+                  Set.singleton $
                     CacheMount
                       ( def
                           { cTarget = TargetPath "/foo",
@@ -245,6 +246,42 @@ spec = do
             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 @@ spec = do
             def
               { security = Just Sandbox,
                 network = Just NetworkNone,
-                mount = Just $ BindMount $ def {bTarget = "/foo"}
+                mount = Set.singleton $ BindMount $ def {bTarget = "/foo"}
               }
        in assertAst
             file