parser: allow ${...} expansion in FROM image references

src/Language/Docker/Parser/From.hs

@@ -9,9 +9,9 @@ import Language.Docker.Syntax
 
 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 @@ parsePlatform = do
   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 @@ taggedImage = parseBaseImage tagParser
   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

test/Language/Docker/ParserSpec.hs

@@ -64,6 +64,29 @@ spec = do
       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")]
   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")]]