From c9bf271f84a0f5ce4e5cb2f76343351e9d4d510b Mon Sep 17 00:00:00 2001 From: Rick van Hoef Date: Wed, 7 Jan 2026 14:08:44 +0100 Subject: [PATCH 1/5] Disallow plain 'merge' command when deployments are enabled --- src/Configuration.hs | 1 + src/Logic.hs | 20 +++++++++++++++++++- src/Parser.hs | 7 +++++-- src/Project.hs | 4 ++++ tests/EventLoopSpec.hs | 1 + tests/ParserSpec.hs | 1 + tests/Spec.hs | 1 + 7 files changed, 32 insertions(+), 3 deletions(-) diff --git a/src/Configuration.hs b/src/Configuration.hs index 208682f1..80d74fd2 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -43,6 +43,7 @@ data ProjectConfiguration = ProjectConfiguration , deployEnvironments :: Maybe [Text] -- The environments which the `deploy to ` command should be enabled for , deploySubprojects :: Maybe [Text] -- The subprojects which the `deploy` command should be enabled for , safeForFriday :: Maybe Bool -- Whether it's safe to deploy this project on Friday without an "on Friday" check. default False + , allowPlainMerge :: Maybe Bool -- Whether to allow plain merges without explicitly saying the PR shouldn't be deployed. default True } deriving (Generic) diff --git a/src/Logic.hs b/src/Logic.hs index 6eb06ca4..03376eb0 100644 --- a/src/Logic.hs +++ b/src/Logic.hs @@ -719,6 +719,8 @@ handleCommentAdded triggerConfig mergeWindowExemption featureFreezeWindow prId a then isReviewer author else pure False + let plainMergeAllowed = fromMaybe True (Config.allowPlainMerge projectConfig) + dateTime <- getDateTime -- To guard against accidental merges we make use of a merge window. @@ -739,6 +741,22 @@ handleCommentAdded triggerConfig mergeWindowExemption featureFreezeWindow prId a let (Config.MergeWindowExemptionConfiguration users) = mergeWindowExemption in elem user users + verifyMergeType :: MergeCommand -> Eff es ProjectState -> Eff es ProjectState + verifyMergeType (Approve Merge) action = + if not plainMergeAllowed + then do + () <- + leaveComment + prId + ( "Your merge request has been denied because \ + \this project can be automatically deployed. Use '" + <> Pr.displayMergeCommand (Approve MergeWithoutDeploy) + <> "' if you really don't want to deploy after merging." + ) + pure state + else action + verifyMergeType _ action = action + verifyMergeWindow :: MergeCommand -> MergeWindow -> Eff es ProjectState -> Eff es ProjectState verifyMergeWindow _ _ action | exempted author = action verifyMergeWindow command DuringFeatureFreeze action @@ -816,7 +834,7 @@ handleCommentAdded triggerConfig mergeWindowExemption featureFreezeWindow prId a -- Cases where the parse was successful Success (command, mergeWindow, priority) -- Author is a reviewer - | isAllowed -> verifyMergeWindow command mergeWindow $ case command of + | isAllowed -> verifyMergeType command $ verifyMergeWindow command mergeWindow $ case command of Approve approval -> handleMergeRequested projectConfig prId author source state pr approval priority Nothing Retry -> handleMergeRetry projectConfig prId author source priority state pr -- Author is not a reviewer, so we ignore diff --git a/src/Parser.hs b/src/Parser.hs index 30357125..ef139753 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -239,10 +239,10 @@ parseMergeCommand projectConfig triggerConfig = cvtParseResult . P.parse pCommen -- messages megaparsec gives us, and the parser will instead error out in -- 'pCommandSuffix' which would be confusing. -- - -- When the comment isn't folowed by @ and @ this is treated as a plain + -- When the comment isn't followed by @ and @ this is treated as a plain -- merge command. pMergeApproval :: Parser ApprovedFor - pMergeApproval = P.string' "merge" *> P.option Merge pMergeAnd + pMergeApproval = P.string' "merge" *> P.option Merge (pMergeWithoutDeploy <|> pMergeAnd) -- NOTE: As mentioned above, only the @ and @ part will backtrack. This is -- needed so a) the custom error message in pDeploy works and b) so @@ -250,6 +250,9 @@ parseMergeCommand projectConfig triggerConfig = cvtParseResult . P.parse pCommen pMergeAnd :: Parser ApprovedFor pMergeAnd = P.try (pSpace1 *> P.string' "and" *> pSpace1) *> (pTag <|> pDeploy) + pMergeWithoutDeploy :: Parser ApprovedFor + pMergeWithoutDeploy = P.try (pSpace1 *> P.string' "without" *> (MergeWithoutDeploy <$ (pSpace1 *> P.string' "deploying"))) + -- Parses @merge and tag@ commands. pTag :: Parser ApprovedFor pTag = MergeAndTag <$ P.string' "tag" diff --git a/src/Project.hs b/src/Project.hs index 08378074..89e1dc56 100644 --- a/src/Project.hs +++ b/src/Project.hs @@ -200,6 +200,7 @@ data DeploySubprojects -- This enumeration distinguishes these cases. data ApprovedFor = Merge + | MergeWithoutDeploy | MergeAndDeploy DeploySubprojects DeployEnvironment | MergeAndTag deriving (Eq, Show, Generic) @@ -595,6 +596,7 @@ candidatePullRequests state = -- friday@ merge window suffix. displayMergeCommand :: MergeCommand -> Text displayMergeCommand (Approve Merge) = "merge" +displayMergeCommand (Approve MergeWithoutDeploy) = "merge without deploying" displayMergeCommand (Approve (MergeAndDeploy subprojects (DeployEnvironment env))) = case subprojects of EntireProject -> format "merge and deploy to {}" [env] @@ -612,11 +614,13 @@ alwaysAddMergeCommit = needsTag needsDeploy :: ApprovedFor -> Bool needsDeploy Merge = False +needsDeploy MergeWithoutDeploy = False needsDeploy MergeAndDeploy{} = True needsDeploy MergeAndTag = False needsTag :: ApprovedFor -> Bool needsTag Merge = False +needsTag MergeWithoutDeploy = False needsTag MergeAndDeploy{} = True needsTag MergeAndTag = True diff --git a/tests/EventLoopSpec.hs b/tests/EventLoopSpec.hs index ca12c947..0c6ced57 100644 --- a/tests/EventLoopSpec.hs +++ b/tests/EventLoopSpec.hs @@ -208,6 +208,7 @@ buildProjectConfig repoDir stateFile = , Config.deployEnvironments = Just ["staging", "production"] , Config.deploySubprojects = Nothing , Config.safeForFriday = Nothing + , Config.allowPlainMerge = Just True } -- Dummy user configuration used in test environment. diff --git a/tests/ParserSpec.hs b/tests/ParserSpec.hs index 3e80eb04..1c5f3999 100644 --- a/tests/ParserSpec.hs +++ b/tests/ParserSpec.hs @@ -228,6 +228,7 @@ dummyProject = , deployEnvironments = Just ["production", "staging"] , deploySubprojects = Just ["aaa", "bbb"] , safeForFriday = Just True + , allowPlainMerge = Just True } dummyTrigger :: TriggerConfiguration diff --git a/tests/Spec.hs b/tests/Spec.hs index 51893443..815dd173 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -98,6 +98,7 @@ testProjectConfig = , Config.deployEnvironments = Just ["staging", "production"] , Config.deploySubprojects = Just ["aaa", "bbb"] , Config.safeForFriday = Nothing + , Config.allowPlainMerge = Just True } testmergeWindowExemptionConfig :: Config.MergeWindowExemptionConfiguration From 4368b611a7b53069bf4507f10e5c70a377039429 Mon Sep 17 00:00:00 2001 From: Rick van Hoef Date: Tue, 27 Jan 2026 10:57:52 +0100 Subject: [PATCH 2/5] Add tests for the allowPlainMerge setting --- tests/Spec.hs | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/tests/Spec.hs b/tests/Spec.hs index 815dd173..7037c16b 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -6562,3 +6562,70 @@ main = hspec $ do } , ALeaveComment (PullRequestId 1) "\nRebased as 1b3, waiting for CI …" ] + + it "disallows plain merge on a repo configured with ProjectConfiguration.allowPlainMerge=False" $ do + let + prId = PullRequestId 1 + state = singlePullRequestState prId (Branch "p") masterBranch (Sha "abc1234") "tyrell" + + event = CommentAdded prId "deckard" Nothing "@bot merge" + + results = defaultResults{resultIntegrate = [Right (Sha "def2345")]} + (_, actions) = runActionCustom' results (testProjectConfig{Config.allowPlainMerge = Just False}) $ handleEventTest event state + + actions + `shouldBe` [ AIsReviewer "deckard" + , ALeaveComment prId "Your merge request has been denied because this project can be automatically deployed. Use 'merge without deploying' if you really don't want to deploy after merging." + ] + + it "allows merge without deploying on a repo configured with ProjectConfiguration.allowPlainMerge=False" $ do + let + prId = PullRequestId 1 + state = singlePullRequestState prId (Branch "p") masterBranch (Sha "abc1234") "tyrell" + + event = CommentAdded prId "deckard" Nothing "@bot merge without deploying" + + results = defaultResults{resultIntegrate = [Right (Sha "def2345")]} + (_, actions) = runActionCustom' results (testProjectConfig{Config.allowPlainMerge = Just False}) $ handleEventTest event state + + actions + `shouldBe` [ AIsReviewer "deckard" + , ALeaveComment + prId + "\nPull request approved for merge without deploying by @deckard, rebasing now." + , ATryIntegrate + "Merge #1: Untitled\n\n\ + \Approved-by: deckard\n\ + \Priority: Normal\n\ + \Auto-deploy: false\n" + (prId, Branch "refs/pull/1/head", Sha "abc1234") + [] + False + , ALeaveComment prId "\nRebased as def2345, waiting for CI …" + ] + + it "allows merge without deploying on a repo configured with ProjectConfiguration.allowPlainMerge=True" $ do + let + prId = PullRequestId 1 + state = singlePullRequestState prId (Branch "p") masterBranch (Sha "abc1234") "tyrell" + + event = CommentAdded prId "deckard" Nothing "@bot merge without deploying" + + results = defaultResults{resultIntegrate = [Right (Sha "def2345")]} + (_, actions) = runActionCustom results $ handleEventTest event state + + actions + `shouldBe` [ AIsReviewer "deckard" + , ALeaveComment + prId + "\nPull request approved for merge without deploying by @deckard, rebasing now." + , ATryIntegrate + "Merge #1: Untitled\n\n\ + \Approved-by: deckard\n\ + \Priority: Normal\n\ + \Auto-deploy: false\n" + (prId, Branch "refs/pull/1/head", Sha "abc1234") + [] + False + , ALeaveComment prId "\nRebased as def2345, waiting for CI …" + ] From 71eb616a9ce2b49c356b4b04e382d83d40060e1d Mon Sep 17 00:00:00 2001 From: Rick van Hoef Date: Thu, 29 Jan 2026 14:09:35 +0100 Subject: [PATCH 3/5] Allow using 'merge without deploy' as an alias to 'merge without deploying' --- src/Parser.hs | 2 +- tests/Spec.hs | 26 ++++++++++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/src/Parser.hs b/src/Parser.hs index ef139753..a825ca9f 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -251,7 +251,7 @@ parseMergeCommand projectConfig triggerConfig = cvtParseResult . P.parse pCommen pMergeAnd = P.try (pSpace1 *> P.string' "and" *> pSpace1) *> (pTag <|> pDeploy) pMergeWithoutDeploy :: Parser ApprovedFor - pMergeWithoutDeploy = P.try (pSpace1 *> P.string' "without" *> (MergeWithoutDeploy <$ (pSpace1 *> P.string' "deploying"))) + pMergeWithoutDeploy = P.try (pSpace1 *> P.string' "without" *> (MergeWithoutDeploy <$ (pSpace1 *> P.string' "deploy" <|> P.string' "deploying"))) -- Parses @merge and tag@ commands. pTag :: Parser ApprovedFor diff --git a/tests/Spec.hs b/tests/Spec.hs index 7037c16b..e26e668d 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -6629,3 +6629,29 @@ main = hspec $ do False , ALeaveComment prId "\nRebased as def2345, waiting for CI …" ] + + it "allows the 'merge without deploy' alias" $ do + let + prId = PullRequestId 1 + state = singlePullRequestState prId (Branch "p") masterBranch (Sha "abc1234") "tyrell" + + event = CommentAdded prId "deckard" Nothing "@bot merge without deploy" + + results = defaultResults{resultIntegrate = [Right (Sha "def2345")]} + (_, actions) = runActionCustom results $ handleEventTest event state + + actions + `shouldBe` [ AIsReviewer "deckard" + , ALeaveComment + prId + "\nPull request approved for merge without deploying by @deckard, rebasing now." + , ATryIntegrate + "Merge #1: Untitled\n\n\ + \Approved-by: deckard\n\ + \Priority: Normal\n\ + \Auto-deploy: false\n" + (prId, Branch "refs/pull/1/head", Sha "abc1234") + [] + False + , ALeaveComment prId "\nRebased as def2345, waiting for CI …" + ] From 827bf1a42b2c608e0a1f0c474dae4c5cfb26a73a Mon Sep 17 00:00:00 2001 From: Rick van Hoef Date: Thu, 29 Jan 2026 15:04:02 +0100 Subject: [PATCH 4/5] fixup! Allow using 'merge without deploy' as an alias to 'merge without deploying' --- src/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Parser.hs b/src/Parser.hs index a825ca9f..d8b80645 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -251,7 +251,7 @@ parseMergeCommand projectConfig triggerConfig = cvtParseResult . P.parse pCommen pMergeAnd = P.try (pSpace1 *> P.string' "and" *> pSpace1) *> (pTag <|> pDeploy) pMergeWithoutDeploy :: Parser ApprovedFor - pMergeWithoutDeploy = P.try (pSpace1 *> P.string' "without" *> (MergeWithoutDeploy <$ (pSpace1 *> P.string' "deploy" <|> P.string' "deploying"))) + pMergeWithoutDeploy = P.try (pSpace1 *> P.string' "without" *> (MergeWithoutDeploy <$ (pSpace1 *> P.string' "deploying" <|> P.string' "deploy"))) -- Parses @merge and tag@ commands. pTag :: Parser ApprovedFor From d94a2d5c6579e72330e225ddcc8e0b1f3207f24b Mon Sep 17 00:00:00 2001 From: Rick van Hoef Date: Fri, 30 Jan 2026 11:29:12 +0100 Subject: [PATCH 5/5] fixup! fixup! Allow using 'merge without deploy' as an alias to 'merge without deploying' --- src/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Parser.hs b/src/Parser.hs index d8b80645..e7298d7b 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -251,7 +251,7 @@ parseMergeCommand projectConfig triggerConfig = cvtParseResult . P.parse pCommen pMergeAnd = P.try (pSpace1 *> P.string' "and" *> pSpace1) *> (pTag <|> pDeploy) pMergeWithoutDeploy :: Parser ApprovedFor - pMergeWithoutDeploy = P.try (pSpace1 *> P.string' "without" *> (MergeWithoutDeploy <$ (pSpace1 *> P.string' "deploying" <|> P.string' "deploy"))) + pMergeWithoutDeploy = P.try (pSpace1 *> P.string' "without" *> (MergeWithoutDeploy <$ (pSpace1 *> (P.string' "deploying" <|> P.string' "deploy")))) -- Parses @merge and tag@ commands. pTag :: Parser ApprovedFor