From fb39e7c5c431ca9d23a9766050ac41cc166b188f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9o=20Zimmermann?= Date: Tue, 2 Jul 2024 16:11:10 +0200 Subject: [PATCH] Subscribe to pull request card editions. --- bot-components/GitHub_queries.mli | 5 ++- bot-components/GitHub_subscriptions.ml | 47 ++++++++++++------------- bot-components/GitHub_subscriptions.mli | 2 +- bot-components/GitHub_types.mli | 10 ++++-- src/bot.ml | 22 ++++++++---- 5 files changed, 51 insertions(+), 35 deletions(-) diff --git a/bot-components/GitHub_queries.mli b/bot-components/GitHub_queries.mli index 4e467631..1fe6f341 100644 --- a/bot-components/GitHub_queries.mli +++ b/bot-components/GitHub_queries.mli @@ -135,4 +135,7 @@ val get_project_field_values : -> project:int -> field:string -> options:string array - -> (GitHub_ID.t * (GitHub_ID.t * (string * string) list) option, string) result Lwt.t + -> ( GitHub_ID.t * (GitHub_ID.t * (string * string) list) option + , string ) + result + Lwt.t diff --git a/bot-components/GitHub_subscriptions.ml b/bot-components/GitHub_subscriptions.ml index 0d19619e..c6ee89c0 100644 --- a/bot-components/GitHub_subscriptions.ml +++ b/bot-components/GitHub_subscriptions.ml @@ -49,25 +49,6 @@ let pull_request_info_of_json json = (match pr_json |> member "merged_at" with `Null -> false | _ -> true) ; last_commit_message= None } -let project_card_of_json json = - let card_json = json |> member "project_card" in - let column_id = card_json |> member "column_id" |> to_int in - let regexp = - "https://api.github.com/repos/\\([^/]*\\)/\\([^/]*\\)/issues/\\([0-9]*\\)" - in - match card_json |> member "content_url" with - | `Null -> - Ok {issue= None; column_id} - | `String content_url when string_match ~regexp content_url -> - let owner = Str.matched_group 1 content_url in - let repo = Str.matched_group 2 content_url in - let number = Str.matched_group 3 content_url |> Int.of_string in - Ok {issue= Some {owner; repo; number}; column_id} - | `String _ -> - Error "Could not parse content_url field." - | _ -> - Error "content_url field has unexpected type." - let comment_info_of_json ?(review_comment = false) json = let comment_json = if review_comment then json |> member "review" else json |> member "comment" @@ -153,7 +134,7 @@ let push_event_info_of_json json = type msg = | IssueOpened of issue_info | IssueClosed of issue_info - | RemovedFromProject of project_card_issue + | PullRequestCardEdited of pull_request_card_info | PullRequestUpdated of pull_request_action * issue_info pull_request_info | BranchCreated of remote_ref_info | TagCreated of remote_ref_info @@ -184,9 +165,27 @@ let github_action ~event ~action json = Ok (IssueOpened (issue_info_of_json json)) | "issues", "closed" -> Ok (IssueClosed (issue_info_of_json json)) - | "project_card", "deleted" -> - json |> project_card_of_json - |> Result.map ~f:(fun card -> RemovedFromProject card) + | "projects_v2_item", "edited" + when String.equal "PullRequest" + ( json |> member "projects_v2_item" |> member "content_type" + |> to_string ) + && String.equal "single_select" + ( json |> member "changes" |> member "field_value" + |> member "field_type" |> to_string ) -> + let card_json = json |> member "projects_v2_item" in + let changes_json = json |> member "changes" |> member "field_value" in + Ok + (PullRequestCardEdited + { pr_id= card_json |> member "content_node_id" |> GitHub_ID.of_json + ; card_id= card_json |> member "node_id" |> GitHub_ID.of_json + ; project_id= + card_json |> member "project_node_id" |> GitHub_ID.of_json + ; project_number= changes_json |> member "project_number" |> to_int + ; field= changes_json |> member "field_name" |> to_string + ; old_value= + changes_json |> member "from" |> member "name" |> to_string + ; new_value= + changes_json |> member "to" |> member "name" |> to_string } ) | "issue_comment", "created" -> Ok (CommentCreated (comment_info_of_json json)) | "pull_request_review", "submitted" -> @@ -204,7 +203,7 @@ let github_event ~event json = match event with | "pull_request" | "issues" - | "project_card" + | "projects_v2_item" | "issue_comment" | "pull_request_review" | "check_run" diff --git a/bot-components/GitHub_subscriptions.mli b/bot-components/GitHub_subscriptions.mli index 9db61dbf..c357ffff 100644 --- a/bot-components/GitHub_subscriptions.mli +++ b/bot-components/GitHub_subscriptions.mli @@ -3,7 +3,7 @@ open GitHub_types type msg = | IssueOpened of issue_info | IssueClosed of issue_info - | RemovedFromProject of project_card_issue + | PullRequestCardEdited of pull_request_card_info | PullRequestUpdated of pull_request_action * issue_info pull_request_info | BranchCreated of remote_ref_info | TagCreated of remote_ref_info diff --git a/bot-components/GitHub_types.mli b/bot-components/GitHub_types.mli index aeeb9370..6103074b 100644 --- a/bot-components/GitHub_types.mli +++ b/bot-components/GitHub_types.mli @@ -9,8 +9,14 @@ type merge_method = MERGE | REBASE | SQUASH type backport_info = {backport_to: string; rejected_milestone: string} -type project_card = - {id: GitHub_ID.t; column: project_column option; columns: project_column list} +type pull_request_card_info = + { pr_id: GitHub_ID.t + ; card_id: GitHub_ID.t + ; project_id: GitHub_ID.t + ; project_number: int + ; field: string + ; old_value: string + ; new_value: string } type mv_card_to_column_input = {card_id: GitHub_ID.t; column_id: GitHub_ID.t} diff --git a/src/bot.ml b/src/bot.ml index 31e50723..b8f13f51 100644 --- a/src/bot.ml +++ b/src/bot.ml @@ -287,24 +287,32 @@ let callback _conn req body = (f "Issue %s/%s#%d was closed: checking its milestone." issue.owner issue.repo issue.number ) () + | Ok + ( _ + , PullRequestCardEdited {project_number; field; old_value; new_value} + ) + when Int.equal project_number 11 + && String.equal old_value "Request inclusion" + && String.equal new_value "Rejected" + && String.is_suffix ~suffix:" status" field -> + let backport_to = String.drop_suffix field 7 in (* - | Ok (_, RemovedFromProject ({issue= Some issue; column_id} as card)) -> (fun () -> action_as_github_app ~bot_info ~key ~app_id ~owner:issue.owner ~repo:issue.repo (project_action ~issue ~column_id) ) |> Lwt.async ; + *) Server.respond_string ~status:`OK ~body: (f - "Issue or PR %s/%s#%d was removed from project column %d: \ - checking if this was a backporting column." - issue.owner issue.repo issue.number card.column_id ) + "PR proposed for backporting was rejected from inclusion in \ + %s. Updating the milestone." + backport_to ) () - | Ok (_, RemovedFromProject _) -> + | Ok (_, PullRequestCardEdited _) -> Server.respond_string ~status:`OK - ~body:"Note card removed from project: nothing to do." () - *) + ~body:"Unsupported pull request card edition." () | Ok (_, IssueOpened ({body= Some body} as issue_info)) -> ( let body = body |> trim_comments |> strip_quoted_bot_name ~github_bot_name