From de81d7281ade84c782d2f4074d410d62f9738f1b Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Thu, 27 Jul 2023 12:59:53 +0200 Subject: [PATCH] New `alr publish --request-review` (#1409) * Descriminate more PR states Only missing is when there are changes requested * Colored states * Fixed review evaluation * New `alr publish --request-review` * Document new feature in user visible changes * Self-review --- doc/user-changes.md | 8 + src/alire/alire-github.adb | 124 +++++++++++++- src/alire/alire-github.ads | 19 ++- src/alire/alire-publish-states.adb | 252 ++++++++++++++++++++++++++--- src/alire/alire-publish-states.ads | 30 +++- src/alr/alr-commands-publish.adb | 18 ++- src/alr/alr-commands-publish.ads | 5 +- 7 files changed, 416 insertions(+), 40 deletions(-) diff --git a/doc/user-changes.md b/doc/user-changes.md index 8bcf192c..82f557e6 100644 --- a/doc/user-changes.md +++ b/doc/user-changes.md @@ -6,6 +6,14 @@ stay on top of `alr` new features. ## Release `2.0-dev` +### Request review of an index submission with `alr publish --request-review` + +PR [#1409](https://github.com/alire-project/alire/pull/1409) + +When a submission has passed all server-side tests, for the time being it must +be reviewed and merged manually. This can now be done with `alr publish +--request-review `. + ### Cancel an index submission with `alr publish --cancel` PR [#1406](https://github.com/alire-project/alire/pull/1406) diff --git a/src/alire/alire-github.adb b/src/alire/alire-github.adb index f76c7939..20da5062 100644 --- a/src/alire/alire-github.adb +++ b/src/alire/alire-github.adb @@ -21,6 +21,18 @@ package body Alire.GitHub is Base_URL : constant URL := "https://api.github.com"; Header_Rate : constant String := "X-Ratelimit-Remaining"; + Repos : constant String := "repos"; + Pulls : constant String := "pulls"; + + ------------------- + -- Community_API -- + ------------------- + + function Community_API return String + is (Repos + / Index.Community_Organization + / Index.Community_Repo_Name); + ----------------- -- JSON_Escape -- ----------------- @@ -42,9 +54,13 @@ package body Alire.GitHub is function API_Call (Proc : String; Args : Minirest.Parameters := Minirest.No_Arguments; Kind : Kinds := GET; - Token : String := OS_Lib.Getenv (Env_GH_Token, "")) + Token : String := OS_Lib.Getenv (Env_GH_Token, ""); + Raw : String := "") return Minirest.Response is + -- We receive either JSON Args or a Raw body to send + pragma Assert (Raw = "" or else Args = Minirest.No_Arguments); + Full_URL : constant String := Base_URL & (if Proc (Proc'First) /= '/' then "/" else "") @@ -63,6 +79,9 @@ package body Alire.GitHub is ("Headers: " & Minirest.Image (Headers, JSON_Escape'Access)); Trace.Debug ("Parameters: " & Minirest.Image (Args, JSON_Escape'Access)); + if Raw /= "" then + Trace.Debug ("Raw body: " & Raw); + end if; return This : constant Response := (case Kind is @@ -72,12 +91,20 @@ package body Alire.GitHub is Arguments => Args, Headers => Headers), when POST | PATCH => - Minirest.Post - (Full_URL, - Data => Args, - Headers => Headers, - Escape => JSON_Escape'Access, - Kind => Minirest.Request_Kinds (Kind))) + (if Raw = "" then + Minirest.Post + (Full_URL, + Data => Args, + Headers => Headers, + Escape => JSON_Escape'Access, + Kind => Minirest.Request_Kinds (Kind)) + else + Minirest.Post + (Full_URL, + Data => Raw, + Headers => Headers, + Kind => Minirest.Request_Kinds (Kind)) + )) do Trace.Debug ("GitHub API response: " & This.Status_Line); @@ -323,6 +350,32 @@ package body Alire.GitHub is return Pending; end Fork; + ------------ + -- Checks -- + ------------ + + function Checks (SHA : String) return JSON_Value + is (API_Call + (Community_API + / "actions" + / "runs", + Args => + "per_page" = 100 + and "head_sha" = SHA)); + + ------------- + -- Reviews -- + ------------- + + function Reviews (PR : Natural) return JSON_Value + is (API_Call + (Repos + / Index.Community_Organization + / Index.Community_Repo_Name + / Pulls + / AAA.Strings.Trim (PR'Image) + / "reviews")); + ----------------- -- Repo_Exists -- ----------------- @@ -342,4 +395,61 @@ package body Alire.GitHub is return Boolean is (API_Call ("users" / User).Succeeded); + -------------------- + -- Request_Review -- + -------------------- + + procedure Request_Review (Number : Natural; + Node_ID : String) + is + pragma Unreferenced (Number); + use AAA.Strings; + + -- Unfortunately, removing the draft flag isn't available through REST. + -- We must resort to the GraphQL API, much more powerful but also more + -- complex. To get this out of the way, this query is hardcoded here. + + -- mutation { + -- markPullRequestReadyForReview + -- (input: + -- { + -- clientMutationId: "alr-x.y.z", + -- pullRequestId: "PR_" + -- } + -- ) { + -- clientMutationId + -- } + -- } + + Mutation : constant String + := "mutation { markPullRequestReadyForReview (input: { " + & "clientMutationId: ""alr-" & Version.Current & """, " + & "pullRequestId: ""PRID"" }) {clientMutationId}}"; + + Response : constant Minirest.Response + := API_Call ("graphql", + Kind => POST, + Raw => + "{""query"":" + & JSON_Escape (Replace (Mutation, "PRID", Node_ID)) + & "}"); + + use GNATCOLL.JSON; + begin + if not Response.Succeeded or else + Read (Response.Content.Flatten ("")).Has_Field ("errors") + then + Raise_Checked_Error + (Errors.New_Wrapper + .Wrap ("Error updating PR using GitHub GraphQL API") + .Wrap ("Status line: " & Response.Status_Line) + .Wrap ("Response body:") + .Wrap (Response.Content.Flatten (ASCII.LF)) + .Get); + end if; + + -- TODO: do we need to additionally request a review, or simply by + -- removing the draft status we'll get a notification? + end Request_Review; + end Alire.GitHub; diff --git a/src/alire/alire-github.ads b/src/alire/alire-github.ads index d9c34eb8..95b56d90 100644 --- a/src/alire/alire-github.ads +++ b/src/alire/alire-github.ads @@ -6,6 +6,8 @@ with GNATCOLL.JSON; package Alire.GitHub is + subtype JSON_Value is GNATCOLL.JSON.JSON_Value; + Env_GH_Token : constant String := "GH_TOKEN"; -- This is the environment variable used by the `gh` tool to look for the -- user token. We can reuse it so if it's available, we need not pester the @@ -40,16 +42,16 @@ package Alire.GitHub is -- Returns the number of the PR just created function Find_Pull_Request (M : Milestones.Milestone) - return GNATCOLL.JSON.JSON_Value; + return JSON_Value; -- Find a pull request that matches the user and branch, and return the raw -- JSON info. It will return the unique open PR, or the most recent closed -- one. function Find_Pull_Request (Number : Natural) - return GNATCOLL.JSON.JSON_Value; + return JSON_Value; -- Find the PR with the given number, in any state - function Find_Pull_Requests return GNATCOLL.JSON.JSON_Value; + function Find_Pull_Requests return JSON_Value; -- Return open pull requests created by the user procedure Comment (Number : Natural; Text : String); @@ -71,6 +73,17 @@ package Alire.GitHub is -- elapses without succeeding, it will return Pending. It'll only raise if -- the initial request is denied. + procedure Request_Review (Number : Natural; + Node_ID : String); + -- The Node_ID is the "node_id" returned by the REST API, which is the "id" + -- needed by the GraphQL API. + + function Checks (SHA : String) return JSON_Value; + -- Get the workflow run results on a commit + + function Reviews (PR : Natural) return JSON_Value; + -- Get the reviews for a pull request + function Repo_Exists (User : String := User_Info.User_GitHub_Login; Repo : String := Index.Community_Repo_Name) diff --git a/src/alire/alire-publish-states.adb b/src/alire/alire-publish-states.adb index ec4d15ec..d64cc7f9 100644 --- a/src/alire/alire-publish-states.adb +++ b/src/alire/alire-publish-states.adb @@ -1,9 +1,14 @@ +with AAA.Enum_Tools; + +with Alire.Errors; with Alire.GitHub; with Alire.Index; with Alire.URI; with Alire.Utils.Tables; with Alire.Utils.User_Input.Query_Config; +with AnsiAda; + with CLIC.User_Input; with GNATCOLL.JSON; @@ -12,6 +17,17 @@ package body Alire.Publish.States is use URI.Operators; + ------------- + -- Matches -- + ------------- + -- The GitHub API isn't fully consistent on the case of returned enums + function Matches (S : String; Target : String) return Boolean + is + use AAA.Strings; + begin + return To_Lower_Case (S) = To_Lower_Case (Target); + end Matches; + ------------- -- Webpage -- ------------- @@ -35,15 +51,25 @@ package body Alire.Publish.States is --------- package Key is - Head : constant String := "head"; - Label : constant String := "label"; - Number : constant String := "number"; - State : constant String := "state"; - Title : constant String := "title"; + Conclusion : constant String := "conclusion"; + Draft : constant String := "draft"; + Head : constant String := "head"; + Label : constant String := "label"; + Login : constant String := "login"; + Merged : constant String := "merged"; + Node_ID : constant String := "node_id"; + Number : constant String := "number"; + SHA : constant String := "sha"; + State : constant String := "state"; + Title : constant String := "title"; + User : constant String := "user"; end Key; package Val is - Open : constant String := "open"; + -- Case will be dealt with by Matches + Changes_Requested : constant String := "CHANGES_REQUESTED"; + Closed : constant String := "closed"; + Open : constant String := "open"; end Val; --------------- @@ -57,16 +83,127 @@ package body Alire.Publish.States is return (Exists => False); end if; - return - (Exists => True, - Branch => +Info.Get (Key.Head).Get (Key.Label), - Title => +Info.Get (Key.Title), - Number => Info.Get (Key.Number), - Status => (if Info.Get (Key.State) = Val.Open - then Open - else Rejected), -- TODO: be more precise in the future - Checks => <> -- TODO: extract info about checks - ); + declare + Number : constant Natural := Info.Get (Key.Number); + + ------------------- + -- Needs_Changes -- + ------------------- + + function Needs_Changes return Boolean is + Busy : Simple_Logging.Ongoing := + Simple_Logging.Activity + ("Retrieving reviews for PR" & Number'Image) + with Unreferenced; + use GNATCOLL.JSON; + Reviews : constant JSON_Array := GitHub.Reviews (Number).Get; + + -- Reviews pile up and only the last one of each reviewer is + -- important, so we have to keep track of reviewers seen. + Reviewers : AAA.Strings.Map; + + begin + for I in 1 .. Length (Reviews) loop + Reviewers.Include + (Get (Reviews, I).Get (Key.User).Get (Key.Login), + Get (Reviews, I).Get (Key.State)); + end loop; + + if (for some Review of Reviewers => + Matches (Review, Val.Changes_Requested)) + then + return True; + end if; + + return False; + end Needs_Changes; + + ------------------- + -- Checks_Status -- + ------------------- + + function Checks_Status (SHA : String) return Check_States is + type Conclusions is (Success, Failure, Neutral, Cancelled, + Skipped, Timed_Out, Action_Required, + Pending, Unknown); + + function Is_Valid is new AAA.Enum_Tools.Is_Valid (Conclusions); + + Busy : Simple_Logging.Ongoing := + Simple_Logging.Activity + ("Retrieving checks for PR" & Number'Image) + with Unreferenced; + use GNATCOLL.JSON; + Checks : constant JSON_Array + := GitHub.Checks (SHA).Get ("workflow_runs"); + + Some_Incomplete : Boolean := False; + begin + if Length (Checks) = 0 then + return Checks_Ongoing; + end if; + + for I in 1 .. Length (Checks) loop + declare + Check : constant JSON_Value := Get (Checks, I); + Conclusion : constant Conclusions + := (if not Check.Has_Field (Key.Conclusion) + or else Check.Get (Key.Conclusion).Is_Empty + then + Pending + elsif not Is_Valid (Check.Get (Key.Conclusion)) then + Unknown + else + Conclusions'Value (Check.Get (Key.Conclusion))); + begin + case Conclusion is + when Failure | Cancelled | Timed_Out => + return Checks_Failed; + when Success | Skipped | Neutral => + null; + when others => + Some_Incomplete := True; + end case; + end; + end loop; + + if Some_Incomplete then + return Checks_Ongoing; + else + return Checks_Passed; + end if; + end Checks_Status; + + begin + return + (Exists => True, + Branch => +Info.Get (Key.Head).Get (Key.Label), + Number => Number, + Node_ID => +Info.Get (Key.Node_ID), + Title => +Info.Get (Key.Title), + Status => (if Info.Has_Field (Key.Merged) and then + Info.Get (Key.Merged) + then + Merged + elsif Matches (Info.Get (Key.State), Val.Closed) then + Rejected + elsif Needs_Changes then + Changes_Requested + else + (case Checks_Status (Info.Get (Key.Head) + .Get (Key.SHA)) + is + when Checks_Ongoing => + Checks_Ongoing, + when Checks_Failed => + Checks_Failed, + when Checks_Passed => + (if Info.Get (Key.Draft) then + Checks_Passed + else + Under_Review))) + ); + end; end To_Status; ----------------------- @@ -85,7 +222,7 @@ package body Alire.Publish.States is Obj : constant JSON_Value := Get (List, I); begin -- Keep the first one we see - if Obj.Get (Key.State).Get = Val.Open then + if Matches (Obj.Get (Key.State).Get, Val.Open) then Target := Obj; exit; @@ -108,6 +245,13 @@ package body Alire.Publish.States is end if; end Find_Pull_Request; + ----------------------- + -- Find_Pull_Request -- + ----------------------- + + function Find_Pull_Request (PR : Natural) return PR_Status + is (To_Status (GitHub.Find_Pull_Request (PR))); + ------------------------ -- Find_Pull_Requests -- ------------------------ @@ -115,6 +259,8 @@ package body Alire.Publish.States is function Find_Pull_Requests return Status_Array is use AAA.Strings; use GNATCOLL.JSON; + Busy : constant Simple_Logging.Ongoing + := Simple_Logging.Activity ("Retrieving user's PRs") with Unreferenced; List : constant JSON_Array := GitHub.Find_Pull_Requests.Get; Result : Status_Array (1 .. Length (List)); I : Natural := Result'First; @@ -123,13 +269,15 @@ package body Alire.Publish.States is -- surprisingly not by author only. Hence we have to filter here. for J in 1 .. Length (List) loop declare - Status : constant PR_Status := To_Status (Get (List, J)); + Branch : constant String + := +Get (List, J).Get (Key.Head).Get (Key.Label); + -- Do this first so we don't retrieve unneeded reviews begin if Has_Prefix - (+Status.Branch, + (Branch, Utils.User_Input.Query_Config.User_GitHub_Login & ":") then - Result (I) := Status; + Result (I) := To_Status (Get (List, J)); I := I + 1; end if; end; @@ -138,13 +286,36 @@ package body Alire.Publish.States is return Result (Result'First .. I - 1); end Find_Pull_Requests; + ----------- + -- Color -- + ----------- + + function Color (Status : Lifecycle_States) return String + is + use AnsiAda; + begin + return + (case Status is + when Checks_Failed | Rejected => + Foreground (Light_Red), + when Checks_Passed | Merged => + Foreground (Light_Green), + when Checks_Ongoing | Under_Review | Changes_Requested => + Foreground (Light_Yellow)); + end Color; + ------------------ -- Print_Status -- ------------------ procedure Print_Status is + + use AAA.Strings; + use AnsiAda; + States : constant Status_Array := Find_Pull_Requests; Table : Utils.Tables.Table; + begin if States'Length = 0 then Trace.Always ("No pending submissions found."); @@ -158,7 +329,8 @@ package body Alire.Publish.States is Table .Append (TTY.Emph (AAA.Strings.Trim (PR.Number'Image))) .Append (+PR.Branch) - .Append (AAA.Strings.To_Mixed_Case (PR.Status'Image)) + .Append (Color_Wrap (To_Mixed_Case (PR.Status'Image), + Color (PR.Status))) .Append (TTY.URL (Webpage (PR))) .New_Row; end loop; @@ -216,4 +388,42 @@ package body Alire.Publish.States is end if; end Cancel; + -------------------- + -- Request_Review -- + -------------------- + + procedure Request_Review (PR : Natural) is + use AnsiAda; + use AAA.Strings; + St : constant PR_Status := Find_Pull_Request (PR); + begin + if not St.Exists then + Raise_Checked_Error ("Requested pull request not found"); + end if; + + if St.Status /= Checks_Passed then + Raise_Checked_Error + (Errors.New_Wrapper + .Wrap + ("Reviews can only be requested for pull requests with status " + & Color_Wrap (To_Mixed_Case (Checks_Passed'Image), + Color (Checks_Passed))) + .Wrap + ("PR" & TTY.Emph (PR'Image) & " has status " + & Color_Wrap (To_Mixed_Case (St.Status'Image), Color (St.Status) + )) + .Get); + end if; + + declare + use Simple_Logging; + Busy : constant Ongoing := Activity ("Removing draft flag") + with Unreferenced; + begin + GitHub.Request_Review (PR, +St.Node_ID); + end; + + Put_Success ("Review requested successfully"); + end Request_Review; + end Alire.Publish.States; diff --git a/src/alire/alire-publish-states.ads b/src/alire/alire-publish-states.ads index 1bd5d83b..0b6e90ce 100644 --- a/src/alire/alire-publish-states.ads +++ b/src/alire/alire-publish-states.ads @@ -2,21 +2,34 @@ with Alire.Milestones; package Alire.Publish.States is - type Check_States is (Pending, Running, Failed, Succeeded); + type Lifecycle_States is + (Checks_Ongoing, -- Waiting for checks to complete, draft or not + Checks_Failed, -- Some automated check failed + Checks_Passed, -- Checks successful, still in draft mode + Under_Review, -- Checks successful, no longer a draft, devs notified + Changes_Requested, -- Open with changes requested by some reviewer + Merged, -- Closed with merge + Rejected -- Closed without merge + ); + -- These states correspond to our desired workflow and not exactly to GH + -- states. See explanations for each state. It uses a combo of PR status, + -- checks, and reviews. - type Life_States is (Open, Changes_Requested, Merged, Rejected); + subtype Check_States + is Lifecycle_States range Checks_Ongoing .. Checks_Passed; - subtype Open_States is Life_States range Open .. Changes_Requested; + subtype Open_States + is Lifecycle_States range Checks_Ongoing .. Changes_Requested; type PR_Status (Exists : Boolean) is tagged record case Exists is when False => null; when True => Branch : UString; -- In truth, it's `user:branch` - Number : Natural := 0; + Number : Natural := 0; + Node_ID : UString; -- Internal ID for the GraphQL API Title : UString; - Status : Life_States := Open; - Checks : Check_States := Pending; + Status : Lifecycle_States := Checks_Ongoing; end case; end record; @@ -35,6 +48,8 @@ package Alire.Publish.States is -- Find the status of a PR. Only one can be open, that will be returned in -- preference. Otherwise, the one closed more recently will be returned. + function Find_Pull_Request (PR : Natural) return PR_Status; + function Find_Pull_Requests return Status_Array with Post => (for all PR of Find_Pull_Requests'Result => PR.Status in Open_States); @@ -44,4 +59,7 @@ package Alire.Publish.States is procedure Cancel (PR : Natural; Reason : String); + procedure Request_Review (PR : Natural); + -- Remove Draft flag from PR and request review from Alire developers team + end Alire.Publish.States; diff --git a/src/alr/alr-commands-publish.adb b/src/alr/alr-commands-publish.adb index 19740863..887a1a59 100644 --- a/src/alr/alr-commands-publish.adb +++ b/src/alr/alr-commands-publish.adb @@ -39,7 +39,7 @@ package body Alr.Commands.Publish is begin if Alire.Utils.Count_True ((Cmd.Tar, Cmd.Print_Trusted, Cmd.Status, - Cmd.Cancel.all /= Unset)) > 1 + Cmd.Cancel.all /= Unset, Cmd.Review.all /= Unset)) > 1 or else (Cmd.Manifest.all /= "" and then Cmd.Print_Trusted) then @@ -76,12 +76,19 @@ package body Alr.Commands.Publish is if not Args.Is_Empty then Reportaise_Wrong_Arguments - ("Unexpected argumets; verify --reason text is quoted"); + ("Unexpected arguments; verify --reason text is quoted"); end if; Alire.Publish.States.Cancel (PR => To_Int (Cmd.Cancel.all), Reason => Cmd.Reason.all); + elsif Cmd.Review.all /= Unset then + if not Args.Is_Empty then + Reportaise_Wrong_Arguments ("Unexpected arguments"); + end if; + + Alire.Publish.States.Request_Review (To_Int (Cmd.Review.all)); + elsif Cmd.Status then Alire.Publish.States.Print_Status; @@ -170,6 +177,13 @@ package body Alr.Commands.Publish is "Give a message for the record on why the PR is being closed", Argument => "'short text'"); + Define_Switch + (Config, + Cmd.Review'Access, + "", "--request-review=", + "Remove draft status from the pull request and request a review", + Argument => "NUM"); + Define_Switch (Config, Cmd.Status'Access, diff --git a/src/alr/alr-commands-publish.ads b/src/alr/alr-commands-publish.ads index 6bf6a8bb..b56500ee 100644 --- a/src/alr/alr-commands-publish.ads +++ b/src/alr/alr-commands-publish.ads @@ -52,7 +52,7 @@ package Alr.Commands.Publish is overriding function Usage_Custom_Parameters (Cmd : Command) return String is ("[--skip-build] [--skip-submit] [--tar] " - & "[--manifest ] [ [commit]]]"); + & "[--manifest ] [ [commit]]] [--request-review NUM]"); private @@ -74,6 +74,9 @@ private Reason : aliased GNAT.Strings.String_Access := new String'(Unset); -- Reason to give when closing the PR + Review : aliased GNAT.Strings.String_Access := new String'(Unset); + -- True when requesting a review for a PR + Status : aliased Boolean := False; -- Retrieve the status of PRs opened by the user -- 2.39.5