1  -- SPDX-License-Identifier: AGPL-3.0-or-later
  2  
  3  with GNAT.OS_Lib;
  4  with GNAT.Expect;
  5  with Ada.Text_IO;
  6  
  7  package body Bitbucket_API is
  8  
  9     Base_URL : constant String := "https://api.bitbucket.org/2.0";
 10  
 11     function Run_Curl
 12       (Args : String) return API_Result
 13     is
 14        use GNAT.Expect;
 15        Pd : Process_Descriptor;
 16        Result : Expect_Match;
 17        Output : Unbounded_String := Null_Unbounded_String;
 18        Ret : API_Result;
 19     begin
 20        Non_Blocking_Spawn
 21          (Pd,
 22           "/usr/bin/curl",
 23           GNAT.OS_Lib.Argument_String_To_List (Args).all,
 24           Err_To_Out => True);
 25  
 26        loop
 27           begin
 28              Expect (Pd, Result, ".+", Timeout => 30_000);
 29              Append (Output, Expect_Out (Pd));
 30           exception
 31              when Process_Died =>
 32                 exit;
 33           end;
 34        end loop;
 35  
 36        Close (Pd);
 37  
 38        Ret.Data := Output;
 39  
 40        if Index (Output, """error""") > 0 or else
 41           Index (Output, "\"error\"") > 0
 42        then
 43           Ret.Success := False;
 44           Ret.Message := To_Unbounded_String ("API error");
 45        else
 46           Ret.Success := True;
 47           Ret.Message := To_Unbounded_String ("OK");
 48        end if;
 49  
 50        return Ret;
 51  
 52     exception
 53        when others =>
 54           Ret.Success := False;
 55           Ret.Message := To_Unbounded_String ("Failed to execute curl");
 56           return Ret;
 57     end Run_Curl;
 58  
 59     function Create_Repo
 60       (Creds : Config.Credentials;
 61        Name : String;
 62        Is_Private : Boolean := False;
 63        Description : String := "") return API_Result
 64     is
 65        URL : constant String :=
 66           Base_URL & "/repositories/" &
 67           To_String (Creds.Workspace) & "/" & Name;
 68        Private_Str : constant String :=
 69           (if Is_Private then "true" else "false");
 70        Data : constant String :=
 71           "{""scm"":""git"",""is_private"":" & Private_Str &
 72           ",""description"":""" & Description & """}";
 73        Args : constant String :=
 74           "-s -X POST " &
 75           "-u " & To_String (Creds.Username) & ":" &
 76           To_String (Creds.App_Password) & " " &
 77           "-H ""Content-Type: application/json"" " &
 78           "-d '" & Data & "' " &
 79           URL;
 80     begin
 81        return Run_Curl (Args);
 82     end Create_Repo;
 83  
 84     function Delete_Repo
 85       (Creds : Config.Credentials;
 86        Name : String) return API_Result
 87     is
 88        URL : constant String :=
 89           Base_URL & "/repositories/" &
 90           To_String (Creds.Workspace) & "/" & Name;
 91        Args : constant String :=
 92           "-s -X DELETE " &
 93           "-u " & To_String (Creds.Username) & ":" &
 94           To_String (Creds.App_Password) & " " &
 95           URL;
 96     begin
 97        return Run_Curl (Args);
 98     end Delete_Repo;
 99  
100     function List_Repos
101       (Creds : Config.Credentials) return API_Result
102     is
103        URL : constant String :=
104           Base_URL & "/repositories/" &
105           To_String (Creds.Workspace) & "?pagelen=100";
106        Args : constant String :=
107           "-s -X GET " &
108           "-u " & To_String (Creds.Username) & ":" &
109           To_String (Creds.App_Password) & " " &
110           URL;
111     begin
112        return Run_Curl (Args);
113     end List_Repos;
114  
115     function Get_Repo
116       (Creds : Config.Credentials;
117        Name : String) return API_Result
118     is
119        URL : constant String :=
120           Base_URL & "/repositories/" &
121           To_String (Creds.Workspace) & "/" & Name;
122        Args : constant String :=
123           "-s -X GET " &
124           "-u " & To_String (Creds.Username) & ":" &
125           To_String (Creds.App_Password) & " " &
126           URL;
127     begin
128        return Run_Curl (Args);
129     end Get_Repo;
130  
131     function Repo_Exists
132       (Creds : Config.Credentials;
133        Name : String) return Boolean
134     is
135        Result : constant API_Result := Get_Repo (Creds, Name);
136     begin
137        return Result.Success and then
138           Index (Result.Data, """slug"":""" & Name & """") > 0;
139     end Repo_Exists;
140  
141  end Bitbucket_API;