Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

New alr publish --cancel #1406

Merged
merged 4 commits into from Jul 25, 2023
Merged

New alr publish --cancel #1406

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
a37b4bc
New `alr publish --cancel <num> --reason <text>`
mosteo Jul 8, 2023
575da75
Added JSON escaping
mosteo Jul 8, 2023
6e9b396
Update alire.toml pins
mosteo Jul 18, 2023
dcae0f7
user-changes.md: new `--status`, `--cancel` switches
mosteo Jul 18, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
4 changes: 2 additions & 2 deletions alire.toml
View file
Open in desktop
Expand Up @@ -48,8 +48,8 @@ windows = { ALIRE_OS = "windows" }
aaa = { url = "https://github.com/mosteo/aaa", commit = "fbfffb1cb269a852201d172119d94f3024b617f2" }
ada_toml = { url = "https://github.com/mosteo/ada-toml", commit = "da4e59c382ceb0de6733d571ecbab7ea4919b33d" }
clic = { url = "https://github.com/alire-project/clic", commit = "6879b90876a1c918b4e112f59c6db0e25b713f52" }
gnatcoll = { url = "https://github.com/alire-project/gnatcoll-core.git", commit = "403efe11405113cf12ae3d014df474cf7a046176" }
minirest = { url = "https://github.com/mosteo/minirest.git", commit = "17fa789b71ccaf65e8c892816456c94a09a384d0" }
gnatcoll = { url = "https://github.com/alire-project/gnatcoll-core.git", commit = "4e663b87a028252e7e074f054f8f453661397166" }
minirest = { url = "https://github.com/mosteo/minirest.git", commit = "9a9c660f9c6f27f5ef75417e7fac7061dff14d78" }
semantic_versioning = { url = "https://github.com/alire-project/semantic_versioning", commit = "2f23fc5f6b4855b836b599adf292fed9c0ed4144" }
simple_logging = { url = "https://github.com/alire-project/simple_logging", commit = "3505dc645f3eef6799a486aae223d37e88cfc4d5" }
stopwatch = { url = "https://github.com/mosteo/stopwatch", commit = "f607a63b714f09bbf6126de9851cbc21cf8666c9" }
2 changes: 1 addition & 1 deletion deps/gnatcoll-slim
Open in desktop
Submodule gnatcoll-slim updated 1 files
+1 −1 src/gnatcoll-json-utility.ads
2 changes: 1 addition & 1 deletion deps/minirest
Open in desktop
Submodule minirest updated 2 files
+19 −10 src/minirest.adb
+67 −8 src/minirest.ads
14 changes: 14 additions & 0 deletions doc/user-changes.md
View file
Open in desktop
Expand Up @@ -6,6 +6,20 @@ stay on top of `alr` new features.

## Release `2.0-dev`

### Cancel an index submission with `alr publish --cancel`

PR [#1406](https://github.com/alire-project/alire/pull/1406)

A pending submission can be closed with `alr publish --cancel
<num> --reason <text>`.

### Track user's index submissions with `alr publish --status`

PR [#1400](https://github.com/alire-project/alire/pull/1400)

The new `alr publish --status` switch will print a table with unmerged pull
requests opened by the user against the community index repository.

### Automatic release submission during `alr publish`

PR [#1398](https://github.com/alire-project/alire/pull/1398)
Expand Down
181 changes: 130 additions & 51 deletions src/alire/alire-github.adb
View file
Open in desktop
Expand Up @@ -6,6 +6,10 @@ with Alire.OS_Lib;
with Alire.Publish;
with Alire.URI;
with Alire.Utils.TTY;
with Alire.Version;

with GNATCOLL.JSON.Utility;
with GNATCOLL.Strings;

with Minirest;

Expand All @@ -17,11 +21,23 @@ package body Alire.GitHub is
Base_URL : constant URL := "https://api.github.com";
Header_Rate : constant String := "X-Ratelimit-Remaining";

-----------------
-- JSON_Escape --
-----------------

function JSON_Escape (S : String) return String
is
use GNATCOLL;
X : constant Strings.XString := Strings.To_XString (S);
begin
return +GNATCOLL.JSON.Utility.Escape_String (X);
end JSON_Escape;

--------------
-- API_Call --
--------------

type Kinds is (GET, POST);
type Kinds is new Minirest.Request_Kinds;

function API_Call (Proc : String;
Args : Minirest.Parameters := Minirest.No_Arguments;
Expand All @@ -34,7 +50,8 @@ package body Alire.GitHub is
& (if Proc (Proc'First) /= '/' then "/" else "")
& Proc;
Headers : Minirest.Parameters :=
"Accept" = "Application/vnd.github.v3.full+json";
"Accept" = "Application/vnd.github.v3.full+json"
and "X-GitHub-Api-Version" = "2022-11-28";
begin
if Token /= "" then
Headers := Headers and "Authorization" = "Bearer " & Token;
Expand All @@ -43,9 +60,9 @@ package body Alire.GitHub is
Trace.Debug
("GitHub API call " & Kind'Image & " to " & Full_URL);
Trace.Debug
("Headers: " & Minirest.Image (Headers));
("Headers: " & Minirest.Image (Headers, JSON_Escape'Access));
Trace.Debug
("Parameters: " & Minirest.Image (Args));
("Parameters: " & Minirest.Image (Args, JSON_Escape'Access));

return This : constant Response :=
(case Kind is
Expand All @@ -54,11 +71,13 @@ package body Alire.GitHub is
(Full_URL,
Arguments => Args,
Headers => Headers),
when POST =>
when POST | PATCH =>
Minirest.Post
(Full_URL,
Data => Args,
Headers => Headers))
Headers => Headers,
Escape => JSON_Escape'Access,
Kind => Minirest.Request_Kinds (Kind)))
do
Trace.Debug
("GitHub API response: " & This.Status_Line);
Expand Down Expand Up @@ -95,6 +114,36 @@ package body Alire.GitHub is
Ada.Exceptions.Exception_Message (E)));
end API_Call;

--------------
-- API_Call --
--------------

function API_Call (Proc : String;
Args : Minirest.Parameters := Minirest.No_Arguments;
Kind : Kinds := GET;
Token : String := OS_Lib.Getenv (Env_GH_Token, "");
Error : String := "GitHub API call failed")
return GNATCOLL.JSON.JSON_Value
is
Response : constant Minirest.Response
:= API_Call (Proc => Proc,
Args => Args,
Kind => Kind,
Token => Token);
begin
if Response.Succeeded then
return GNATCOLL.JSON.Read (Response.Content.Flatten (""));
else
Raise_Checked_Error
(Errors.New_Wrapper
.Wrap (Error)
.Wrap ("Status line: " & Response.Status_Line)
.Wrap ("Response body:")
.Wrap (Response.Content.Flatten (ASCII.LF))
.Get);
end if;
end API_Call;

-------------------
-- Branch_Exists --
-------------------
Expand Down Expand Up @@ -124,32 +173,21 @@ package body Alire.GitHub is
)
return Natural
is
Response : constant Minirest.Response
:= API_Call
begin
return
API_Call
(Kind => POST,
Token => Token,
Error => "Pull request could not be created",
Proc => "repos" / Base / Repo / "pulls",
Args =>
"title" = Title
and "body" = Message
and "base" = Base_Branch
and "head" = User & ":" & Head_Branch
and "draft" = Draft
and "maintainer_can_modify" = Maintainer_Can_Modify);
begin
if not Response.Succeeded then
Raise_Checked_Error
("Pull request could not be created: "
& Response.Status_Line & " with body "
& Response.Content.Flatten (" "));
end if;

declare
use GNATCOLL.JSON;
Result : constant JSON_Value := Read (Response.Content.Flatten (""));
begin
return Result.Get ("number").Get;
end;
and "maintainer_can_modify" = Maintainer_Can_Modify)
.Get ("number").Get;
end Create_Pull_Request;

---------------
Expand All @@ -159,25 +197,15 @@ package body Alire.GitHub is
function Get_Pulls (Args : Minirest.Parameters)
return GNATCOLL.JSON.JSON_Value
is
Response : constant Minirest.Response
:= API_Call ("repos"
/ Index.Community_Organization
/ Index.Community_Repo_Name
/ "pulls",
Kind => GET,
Args => Args
and "per_page" = 100);
begin
if Response.Succeeded then
return GNATCOLL.JSON.Read (Response.Content.Flatten (""));
else
Raise_Checked_Error
("Could not get list of pull requests."
& " GitHub REST API failed with code:"
& Response.Status_Code'Image
& " and status: "
& Response.Status_Line & Response.Content.Flatten (ASCII.LF));
end if;
return
API_Call ("repos"
/ Index.Community_Organization
/ Index.Community_Repo_Name
/ "pulls",
Error => "Could not list pull requests",
Kind => GET,
Args => Args and "per_page" = 100);
end Get_Pulls;

-----------------------
Expand All @@ -190,6 +218,21 @@ package body Alire.GitHub is
and "head" = User_Info.User_GitHub_Login & ":"
& Publish.Branch_Name (M)));

-----------------------
-- Find_Pull_Request --
-----------------------

function Find_Pull_Request (Number : Natural)
return GNATCOLL.JSON.JSON_Value
is (API_Call
("repos"
/ Index.Community_Organization
/ Index.Community_Repo_Name
/ "pulls"
/ AAA.Strings.Trim (Number'Image),
Error => "Could not retrieve pull request information",
Kind => GET));

------------------------
-- Find_Pull_Requests --
------------------------
Expand All @@ -198,6 +241,46 @@ package body Alire.GitHub is
is (Get_Pulls ("state" = "open"
and "head" = User_Info.User_GitHub_Login));

-------------
-- Comment --
-------------

procedure Comment (Number : Natural; Text : String) is
Unused : constant GNATCOLL.JSON.JSON_Value
:= API_Call
("repos"
/ Index.Community_Organization
/ Index.Community_Repo_Name
/ "issues"
/ AAA.Strings.Trim (Number'Image)
/ "comments",
Kind => POST,
Args => "body" = Text);
begin
Trace.Debug ("Comment via GitHub REST API successful: " & Text);
end Comment;

-----------
-- Close --
-----------

procedure Close (Number : Natural; Reason : String) is
use AAA.Strings;
Unused : constant GNATCOLL.JSON.JSON_Value
:= API_Call ("repos"
/ Index.Community_Organization
/ Index.Community_Repo_Name
/ "pulls"
/ Trim (Number'Image),
Error => "Failed to close pull request via REST API",
Kind => PATCH,
Args => "state" = "closed");
begin
Comment (Number,
"Closed using `alr " & Version.Current & "` with reason: "
& Reason);
end Close;

----------
-- Fork --
----------
Expand All @@ -215,19 +298,15 @@ package body Alire.GitHub is
Start : constant Time := Clock;
Next : Time := Start + 1.0;

Response : constant Minirest.Response
Unused : constant GNATCOLL.JSON.JSON_Value
:= API_Call ("repos" / Owner / Repo / "forks",
Kind => POST,
Token => Token);
Token => Token,
Error =>
"Attempt to fork repo [" & Repo & "] owned by ["
& Owner & "] via " & "GitHub REST API failed"
);
begin
if not Response.Succeeded then
Raise_Checked_Error
("Attempt to fork repo [" & Repo & "] owned by [" & Owner & "] via "
& "GitHub REST API failed with code:"
& Response.Status_Code'Image & " and status: "
& Response.Status_Line & Response.Content.Flatten (ASCII.LF));
end if;

declare
Wait : Trace.Ongoing := Trace.Activity ("Waiting for GitHub");
begin
Expand Down
11 changes: 11 additions & 0 deletions src/alire/alire-github.ads
View file
Open in desktop
Expand Up @@ -45,9 +45,20 @@ package Alire.GitHub is
-- 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;
-- Find the PR with the given number, in any state

function Find_Pull_Requests return GNATCOLL.JSON.JSON_Value;
-- Return open pull requests created by the user

procedure Comment (Number : Natural; Text : String);
-- Add a comment to an issue/pull request. Use plain text or markdown.

procedure Close (Number : Natural; Reason : String);
-- Close an issue/pull request and add a comment giving the reason. The
-- comment is added after the closure.

function Fork
(User : String := User_Info.User_GitHub_Login;
Owner : String;
Expand Down