Merge pull request #110 from m-ildefons/wip/tmpfs-size-flag

Tmpfs mount: Size option

Author: m-ildefons

src/Language/Docker/Parser/Run.hs

@@ -26,6 +26,7 @@ data RunMountArg
   | MountArgReadOnly Bool
   | MountArgRequired Bool
   | MountArgSharing CacheSharing
+  | MountArgSize Text
   | MountArgSource SourcePath
   | MountArgTarget TargetPath
   | MountArgType MountType
@@ -147,13 +148,15 @@ cacheMount args =
 
 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 @@ mountArgs =
       mountArgRelabel,
       mountArgRequired,
       mountArgSharing,
+      mountArgSize,
       mountArgSource,
       mountArgTarget,
       mountArgType,
@@ -295,6 +299,9 @@ mountArgRequired = MountArgRequired <$> choice
 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="]
@@ -342,6 +349,7 @@ toArgName (MountArgMode _) = "mode"
 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

@@ -212,7 +212,10 @@ prettyPrintRunMount set =
             <> 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
@@ -236,6 +239,7 @@ prettyPrintRunMount set =
       <> case r of
         RelabelShared -> printQuotable "shared"
         RelabelPrivate -> printQuotable "private"
+    printSize s = ",size=" <> pretty s
 
 prettyPrintRunNetwork :: Maybe RunNetwork -> Doc ann
 prettyPrintRunNetwork Nothing = mempty

src/Language/Docker/Syntax.hs

@@ -339,10 +339,15 @@ data CacheOpts
 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/ParseRunSpec.hs

@@ -168,6 +168,11 @@ spec = do
             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}

test/Language/Docker/PrettyPrintSpec.hs

@@ -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
@@ -178,6 +179,29 @@ spec = do
                   ( 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
       let esc = Pragma (Escape (EscapeChar '\\'))