fix: parse fractional arguments to flags

Parse fractional numbers as arguments to flags for the `HEALTHCHECK`
instruction.

The `HEALTHCHECK` instruction can take an `--interval`, `--timeout` or
`--start-period` flag specifying details to the healthcheck repetition
behaviour. This can also be specified with fractions (of secods, minutes
or hours), e.g.:

```Dockerfile
HEALTHCHECK \
  --interval=0.5s \
  CMD curl -f http://localhost
```

With the caveat that somewhere from parsing to conversion to a DiffTime
some precision is lost (DiffTime has a precision of 10^-12s), this
change adds support for the arguments to these interval flags to be
specified as fractional numbers.

fixes: hadolint/hadolint#893
Signed-off-by: Moritz Röhrich <[email protected]>

language-docker.cabal

@@ -1,10 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.7.
+-- This file has been generated from package.yaml by hpack version 0.35.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: f800aba94b9f6bbf2894ac78e2f4a135d3e9e89e04d9a7b0549bdd0941e97cbd
+-- hash: 6dd65f0e037c77c03ca426e9eb406447cd875dec192604e5975a8ad0056e3345
 
 name:           language-docker
 version:        12.0.0
@@ -94,6 +94,7 @@ test-suite hspec
       Language.Docker.ParseCmdSpec
       Language.Docker.ParseCopySpec
       Language.Docker.ParseExposeSpec
+      Language.Docker.ParseHealthcheckSpec
       Language.Docker.ParsePragmaSpec
       Language.Docker.ParserSpec
       Language.Docker.ParseRunSpec

src/Language/Docker/Parser/Healthcheck.hs

@@ -70,12 +70,14 @@ checkFlag =
 durationFlag :: Text -> Parser Duration
 durationFlag flagName = do
   void $ try (string flagName)
-  scale <- natural
+  value <- try ( fromRational . realToFrac <$> fractional )
+              <|> ( secondsToDiffTime . fromInteger <$> natural )
+              <?> "a natural or fractional number"
   unit <- char 's' <|> char 'm' <|> char 'h' <?> "either 's', 'm' or 'h' as the unit"
   case unit of
-    's' -> return $ Duration (secondsToDiffTime scale)
-    'm' -> return $ Duration (secondsToDiffTime (scale * 60))
-    'h' -> return $ Duration (secondsToDiffTime (scale * 60 * 60))
+    's' -> return $ Duration value
+    'm' -> return $ Duration (value * 60)
+    'h' -> return $ Duration (value * 60 * 60)
     _ -> fail "only 's', 'm' or 'h' are allowed as the duration"
 
 retriesFlag :: Parser Retries

src/Language/Docker/Parser/Prelude.hs

@@ -15,6 +15,7 @@ module Language.Docker.Parser.Prelude
     doubleQuotedStringEscaped,
     eol,
     escapedLineBreaks',
+    fractional,
     heredoc,
     heredocContent,
     heredocMarker,
@@ -134,6 +135,9 @@ reserved name = void (lexeme (string' name) <?> T.unpack name)
 natural :: Parser Integer
 natural = L.decimal <?> "positive number"
 
+fractional :: Parser Float
+fractional = L.float <?> "fractional number"
+
 commaSep :: (?esc :: Char) => Parser a -> Parser [a]
 commaSep p = sepBy (p <* whitespace) (symbol ",")
 

src/Language/Docker/Syntax.hs

@@ -161,7 +161,7 @@ newtype Duration
   = Duration
       { durationTime :: DiffTime
       }
-  deriving (Show, Eq, Ord, Num)
+  deriving (Show, Eq, Ord, Num, Fractional)
 
 newtype Retries
   = Retries

test/Language/Docker/ParseHealthcheckSpec.hs

@@ -0,0 +1,81 @@
+module Language.Docker.ParseHealthcheckSpec where
+
+import Data.Default.Class (def)
+import Language.Docker.Syntax
+import Test.Hspec
+import TestHelper
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+
+
+spec :: Spec
+spec = do
+  describe "parse HEALTHCHECK" $ do
+    it "parse healthcheck with interval" $
+      assertAst
+        "HEALTHCHECK --interval=5m \\\nCMD curl -f http://localhost/"
+        [ Healthcheck $
+            Check $
+              CheckArgs "curl -f http://localhost/" (Just 300) Nothing Nothing Nothing
+        ]
+    it "parse healthcheck with retries" $
+      assertAst
+        "HEALTHCHECK --retries=10 CMD curl -f http://localhost/"
+        [ Healthcheck $
+            Check $
+              CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing (Just $ Retries 10)
+        ]
+    it "parse healthcheck with timeout" $
+      assertAst
+        "HEALTHCHECK --timeout=10s CMD curl -f http://localhost/"
+        [ Healthcheck $
+            Check $
+              CheckArgs "curl -f http://localhost/" Nothing (Just 10) Nothing Nothing
+        ]
+    it "parse healthcheck with start-period" $
+      assertAst
+        "HEALTHCHECK --start-period=2m CMD curl -f http://localhost/"
+        [ Healthcheck $
+            Check $
+              CheckArgs "curl -f http://localhost/" Nothing Nothing (Just 120) Nothing
+        ]
+    it "parse healthcheck with all flags" $
+      assertAst
+        "HEALTHCHECK --start-period=2s --timeout=1m --retries=3 --interval=5s    CMD curl -f http://localhost/"
+        [ Healthcheck $
+            Check $
+              CheckArgs
+                "curl -f http://localhost/"
+                (Just 5)
+                (Just 60)
+                (Just 2)
+                (Just $ Retries 3)
+        ]
+    it "parse healthcheck with no flags" $
+      assertAst
+        "HEALTHCHECK CMD curl -f http://localhost/"
+        [ Healthcheck $
+            Check $
+              CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing Nothing
+        ]
+
+    it "fractional arguments to flags" $
+      let file =
+            Text.unlines
+              [ "HEALTHCHECK \\",
+                "  --interval=0.5s \\",
+                "  --timeout=0.1s \\",
+                "  --start-period=0.2s \\",
+                "  CMD curl -f http://localhost"
+              ]
+       in assertAst
+            file
+            [ Healthcheck $
+                Check $
+                  CheckArgs
+                    "curl -f http://localhost"
+                    ( Just 0.5 )
+                    ( Just 0.10000000149 )
+                    ( Just 0.20000000298 )
+                    Nothing
+            ]

test/Language/Docker/ParserSpec.hs

@@ -174,54 +174,6 @@ spec = do
   describe "parse SHELL" $
     it "quoted shell params" $
       assertAst "SHELL [\"/bin/bash\",  \"-c\"]" [Shell ["/bin/bash", "-c"]]
-  describe "parse HEALTHCHECK" $ do
-    it "parse healthcheck with interval" $
-      assertAst
-        "HEALTHCHECK --interval=5m \\\nCMD curl -f http://localhost/"
-        [ Healthcheck $
-            Check $
-              CheckArgs "curl -f http://localhost/" (Just 300) Nothing Nothing Nothing
-        ]
-    it "parse healthcheck with retries" $
-      assertAst
-        "HEALTHCHECK --retries=10 CMD curl -f http://localhost/"
-        [ Healthcheck $
-            Check $
-              CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing (Just $ Retries 10)
-        ]
-    it "parse healthcheck with timeout" $
-      assertAst
-        "HEALTHCHECK --timeout=10s CMD curl -f http://localhost/"
-        [ Healthcheck $
-            Check $
-              CheckArgs "curl -f http://localhost/" Nothing (Just 10) Nothing Nothing
-        ]
-    it "parse healthcheck with start-period" $
-      assertAst
-        "HEALTHCHECK --start-period=2m CMD curl -f http://localhost/"
-        [ Healthcheck $
-            Check $
-              CheckArgs "curl -f http://localhost/" Nothing Nothing (Just 120) Nothing
-        ]
-    it "parse healthcheck with all flags" $
-      assertAst
-        "HEALTHCHECK --start-period=2s --timeout=1m --retries=3 --interval=5s    CMD curl -f http://localhost/"
-        [ Healthcheck $
-            Check $
-              CheckArgs
-                "curl -f http://localhost/"
-                (Just 5)
-                (Just 60)
-                (Just 2)
-                (Just $ Retries 3)
-        ]
-    it "parse healthcheck with no flags" $
-      assertAst
-        "HEALTHCHECK CMD curl -f http://localhost/"
-        [ Healthcheck $
-            Check $
-              CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing Nothing
-        ]
   describe "parse MAINTAINER" $ do
     it "maintainer of untagged scratch image" $
       assertAst