New alr publish --request-review

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 <num>`.
+
 ### Cancel an index submission with `alr publish --cancel`
 
 PR [#1406](https://github.com/alire-project/alire/pull/1406)

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_<id>"
+      --        }
+      --      ) {
+      --      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;

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)