From cd95daa001c190aa182d9356b3e1ef88f064ee89 Mon Sep 17 00:00:00 2001 From: Mattias Lindvall Date: Wed, 12 Jun 2024 18:40:08 +0200 Subject: [PATCH 1/5] Add support for healthcheck argument start-interval --- src/Language/Docker/Parser/Healthcheck.hs | 7 ++++++- src/Language/Docker/PrettyPrint.hs | 1 + src/Language/Docker/Syntax.hs | 1 + test/Language/Docker/ParseHealthcheckSpec.hs | 10 +++++++++- 4 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/Language/Docker/Parser/Healthcheck.hs b/src/Language/Docker/Parser/Healthcheck.hs index c478d97..50827d3 100644 --- a/src/Language/Docker/Parser/Healthcheck.hs +++ b/src/Language/Docker/Parser/Healthcheck.hs @@ -16,6 +16,7 @@ data CheckFlag = FlagInterval Duration | FlagTimeout Duration | FlagStartPeriod Duration + | FlagStartInterval Duration | FlagRetries Retries | CFlagInvalid (Text, Text) @@ -42,20 +43,23 @@ parseHealthcheck = do let intervals = [x | FlagInterval x <- flags] let timeouts = [x | FlagTimeout x <- flags] let startPeriods = [x | FlagStartPeriod x <- flags] + let startIntervals = [x | FlagStartInterval x <- flags] let retriesD = [x | FlagRetries x <- flags] let invalid = [x | CFlagInvalid x <- flags] -- Let's do some validation on the flags - case (invalid, intervals, timeouts, startPeriods, retriesD) of + case (invalid, intervals, timeouts, startPeriods, startIntervals, retriesD) of ((k, v) : _, _, _, _, _) -> unexpectedFlag k v (_, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--interval" (_, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--timeout" (_, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--start-period" + (_, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--start-interval" (_, _, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--retries" _ -> do Cmd checkCommand <- parseCmd let interval = listToMaybe intervals let timeout = listToMaybe timeouts let startPeriod = listToMaybe startPeriods + let startInterval = listToMaybe startIntervals let retries = listToMaybe retriesD return $ Check CheckArgs {..} @@ -64,6 +68,7 @@ checkFlag = (FlagInterval <$> durationFlag "--interval=" "--interval") <|> (FlagTimeout <$> durationFlag "--timeout=" "--timeout") <|> (FlagStartPeriod <$> durationFlag "--start-period=" "--start-period") + <|> (FlagStartInteval <$> durationFlag "--start-interval=" "--start-interval") <|> (FlagRetries <$> retriesFlag "--retries") <|> (CFlagInvalid <$> anyFlag "no flags") diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs index a0a1bc9..70cd15b 100644 --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -337,6 +337,7 @@ prettyPrintInstruction i = prettyPrintDuration "--interval=" interval prettyPrintDuration "--timeout=" timeout prettyPrintDuration "--start-period=" startPeriod + prettyPrintDuration "--start-interval" startInterval prettyPrintRetries retries "CMD" prettyPrintArguments checkCommand diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs index 58588f1..52ddcc2 100644 --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -243,6 +243,7 @@ data CheckArgs args interval :: !(Maybe Duration), timeout :: !(Maybe Duration), startPeriod :: !(Maybe Duration), + startInterval :: !(Maybe Duration), retries :: !(Maybe Retries) } deriving (Show, Eq, Ord, Functor) diff --git a/test/Language/Docker/ParseHealthcheckSpec.hs b/test/Language/Docker/ParseHealthcheckSpec.hs index 3021326..6801ba2 100644 --- a/test/Language/Docker/ParseHealthcheckSpec.hs +++ b/test/Language/Docker/ParseHealthcheckSpec.hs @@ -39,9 +39,16 @@ spec = do Check $ CheckArgs "curl -f http://localhost/" Nothing Nothing (Just 120) Nothing ] + it "parse healthcheck with start-interval" $ + assertAst + "HEALTHCHECK --start-interval=5m 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 --start-period=2s --start-interval=10s --timeout=1m --retries=3 --interval=5s CMD curl -f http://localhost/" [ Healthcheck $ Check $ CheckArgs @@ -66,6 +73,7 @@ spec = do " --interval=0.5s \\", " --timeout=0.1s \\", " --start-period=0.2s \\", + " --start-interval=0.5s \\", " CMD curl -f http://localhost" ] in assertAst From 7423d8958bd7479f8765db400105e8e163775ca0 Mon Sep 17 00:00:00 2001 From: Mattias Lindvall Date: Wed, 12 Jun 2024 19:02:47 +0200 Subject: [PATCH 2/5] Update tests --- test/Language/Docker/ParseHealthcheckSpec.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/test/Language/Docker/ParseHealthcheckSpec.hs b/test/Language/Docker/ParseHealthcheckSpec.hs index 6801ba2..cb64134 100644 --- a/test/Language/Docker/ParseHealthcheckSpec.hs +++ b/test/Language/Docker/ParseHealthcheckSpec.hs @@ -16,35 +16,35 @@ spec = do "HEALTHCHECK --interval=5m \\\nCMD curl -f http://localhost/" [ Healthcheck $ Check $ - CheckArgs "curl -f http://localhost/" (Just 300) Nothing Nothing Nothing + CheckArgs "curl -f http://localhost/" (Just 300) Nothing 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) + CheckArgs "curl -f http://localhost/" Nothing 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 + CheckArgs "curl -f http://localhost/" Nothing (Just 10) Nothing 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 + CheckArgs "curl -f http://localhost/" Nothing Nothing (Just 120) Nothing Nothing ] it "parse healthcheck with start-interval" $ assertAst - "HEALTHCHECK --start-interval=5m CMD curl -f http://localhost/" + "HEALTHCHECK --start-interval=4m CMD curl -f http://localhost/" [ Healthcheck $ Check $ - CheckArgs "curl -f http://localhost/" Nothing Nothing (Just 120) Nothing + CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing (Just 240) Nothing ] it "parse healthcheck with all flags" $ assertAst @@ -54,6 +54,7 @@ spec = do CheckArgs "curl -f http://localhost/" (Just 5) + (Just 10) (Just 60) (Just 2) (Just $ Retries 3) @@ -63,7 +64,7 @@ spec = do "HEALTHCHECK CMD curl -f http://localhost/" [ Healthcheck $ Check $ - CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing Nothing + CheckArgs "curl -f http://localhost/" Nothing Nothing Nothing Nothing Nothing ] it "fractional arguments to flags" $ @@ -85,5 +86,6 @@ spec = do ( Just 0.5 ) ( Just 0.10000000149 ) ( Just 0.20000000298 ) + ( Just 0.5 ) Nothing ] From c8b71a99e747cec78b661331899576bb19d5441d Mon Sep 17 00:00:00 2001 From: Mattias Lindvall Date: Wed, 12 Jun 2024 22:56:03 +0200 Subject: [PATCH 3/5] Fix validation parameters --- src/Language/Docker/Parser/Healthcheck.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Language/Docker/Parser/Healthcheck.hs b/src/Language/Docker/Parser/Healthcheck.hs index 50827d3..01cea74 100644 --- a/src/Language/Docker/Parser/Healthcheck.hs +++ b/src/Language/Docker/Parser/Healthcheck.hs @@ -48,12 +48,12 @@ parseHealthcheck = do let invalid = [x | CFlagInvalid x <- flags] -- Let's do some validation on the flags case (invalid, intervals, timeouts, startPeriods, startIntervals, retriesD) of - ((k, v) : _, _, _, _, _) -> unexpectedFlag k v - (_, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--interval" - (_, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--timeout" - (_, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--start-period" - (_, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--start-interval" - (_, _, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--retries" + ((k, v) : _, _, _, _, _, _) -> unexpectedFlag k v + (_, _ : _ : _, _, _, _, _) -> customError $ DuplicateFlagError "--interval" + (_, _, _ : _ : _, _, _, _) -> customError $ DuplicateFlagError "--timeout" + (_, _, _, _ : _ : _, _, _) -> customError $ DuplicateFlagError "--start-period" + (_, _, _, _, _ : _ : _, _) -> customError $ DuplicateFlagError "--start-interval" + (_, _, _, _, _, _ : _ : _) -> customError $ DuplicateFlagError "--retries" _ -> do Cmd checkCommand <- parseCmd let interval = listToMaybe intervals From 00caba244f6594d046cacc419e65b03e86aaa056 Mon Sep 17 00:00:00 2001 From: Mattias Lindvall Date: Wed, 12 Jun 2024 22:56:09 +0200 Subject: [PATCH 4/5] Fix typo --- src/Language/Docker/Parser/Healthcheck.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Docker/Parser/Healthcheck.hs b/src/Language/Docker/Parser/Healthcheck.hs index 01cea74..7333582 100644 --- a/src/Language/Docker/Parser/Healthcheck.hs +++ b/src/Language/Docker/Parser/Healthcheck.hs @@ -68,7 +68,7 @@ checkFlag = (FlagInterval <$> durationFlag "--interval=" "--interval") <|> (FlagTimeout <$> durationFlag "--timeout=" "--timeout") <|> (FlagStartPeriod <$> durationFlag "--start-period=" "--start-period") - <|> (FlagStartInteval <$> durationFlag "--start-interval=" "--start-interval") + <|> (FlagStartInterval <$> durationFlag "--start-interval=" "--start-interval") <|> (FlagRetries <$> retriesFlag "--retries") <|> (CFlagInvalid <$> anyFlag "no flags") From 70acdb55a17e068370fae0172b767f39934f89b8 Mon Sep 17 00:00:00 2001 From: Mattias Lindvall Date: Wed, 12 Jun 2024 22:56:31 +0200 Subject: [PATCH 5/5] Fix value order in test --- test/Language/Docker/ParseHealthcheckSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Language/Docker/ParseHealthcheckSpec.hs b/test/Language/Docker/ParseHealthcheckSpec.hs index cb64134..a3c20dc 100644 --- a/test/Language/Docker/ParseHealthcheckSpec.hs +++ b/test/Language/Docker/ParseHealthcheckSpec.hs @@ -54,9 +54,9 @@ spec = do CheckArgs "curl -f http://localhost/" (Just 5) - (Just 10) (Just 60) (Just 2) + (Just 10) (Just $ Retries 3) ] it "parse healthcheck with no flags" $