Subject: [PATCH Cuirass 07/13] forgejo: Add pull request API manipulation procedures.

From: Romain GARBAGE <[email-masked]>
Date: Tue, 11 Mar 2025 11:34:32 +0100

* src/cuirass/forges/forgejo.scm: (%forgejo-api-base-path, api-build-endpoint,
&forgejo-api-error, forgejo-api-pull-request-get,
forgejo-api-pull-request-update): New variables.
* tests/forgejo.scm: Add tests for api-build-endpoint.
---
 src/cuirass/forges/forgejo.scm | 53 +++++++++++++++++++++++++++++++++-
 tests/forgejo.scm              | 12 ++++++++
 2 files changed, 64 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/forges/forgejo.scm b/src/cuirass/forges/forgejo.scm
index b91413d..9cd846f 100644
--- a/src/cuirass/forges/forgejo.scm
+++ b/src/cuirass/forges/forgejo.scm
@@ -47,7 +47,10 @@
             ;; Used in tests.
             forgejo-request
             %forgejo-port
-            %forgejo-scheme))
+            %forgejo-scheme
+            api-build-endpoint
+            forgejo-api-pull-request-get
+            forgejo-api-pull-request-update))
 
 ;;; Commentary:
 ;;;
@@ -169,6 +172,10 @@
   forgejo-invalid-reponse-error?
   (headers  forgejo-invalid-response-headers))
 
+(define-condition-type &forgejo-api-error &forgejo-client-error
+  forgejo-api-error?
+  (message forgejo-api-message))
+
 ;;; Parameterize port and scheme for tests.
 (define %forgejo-port
   (make-parameter #f))
@@ -212,3 +219,47 @@ METHOD. Returns the body of the response as a Guile object."
                         (headers (response-headers response)))))))))
     (json-string->scm
      (bytevector->string response-body charset))))
+
+;;;
+;;; REST API
+;;;
+(define %forgejo-api-base-path "/api/v1")
+
+;; PATHs are defined e.g. here: <https://codeberg.org/api/swagger>.
+(define (api-build-endpoint path)
+  "Returns an API endpoint built from PATH as defined in the documentation."
+  (when (not (string-prefix? "/" path))
+    (raise
+     (condition
+      (&forgejo-api-error
+       (message "Provided path should start with /.")))))
+  (string-append %forgejo-api-base-path path))
+
+(define* (forgejo-api-pull-request-get server token #:key owner
+                                                          repository
+                                                          pull-request-index)
+  "Returns the content of a pull request as a FORGEJO-PULL-REQUEST record."
+  (forgejo-pull-request-event-pull-request
+   (json->forgejo-pull-request-event
+    (forgejo-request server
+                     (api-build-endpoint
+                      (format #f "/repos/~a/~a/pulls/~a"
+                              owner repository pull-request-index))
+                     #:token token
+                     #:method 'GET))))
+
+(define* (forgejo-api-pull-request-update server token #:key owner
+                                                             repository
+                                                             pull-request-index
+                                                             changes)
+  "Updates the pull request with CHANGES, Guile code that can be converted to
+JSON. Returns the content of the updated pull-request."
+  (forgejo-pull-request-event-pull-request
+   (json->forgejo-pull-request-event
+    (forgejo-request server
+                     (api-build-endpoint
+                      (format #f "/repos/~a/~a/pulls/~a"
+                              owner repository pull-request-index))
+                     #:token token
+                     #:method 'PATCH
+                     #:body changes))))
diff --git a/tests/forgejo.scm b/tests/forgejo.scm
index 8ffdbcf..2528f5b 100644
--- a/tests/forgejo.scm
+++ b/tests/forgejo.scm
@@ -31,6 +31,7 @@
              (web response)
              (rnrs bytevectors)
              (srfi srfi-1)
+             (srfi srfi-34)
              (srfi srfi-64)
              (ice-9 threads)
              (ice-9 match))
@@ -104,3 +105,14 @@
         (forgejo-request hostname "/"
                          #:token "token"
                          #:method 'GET)))))
+
+(test-equal "api-build-endpoint: valid path"
+  "/api/v1/pulls/1"
+  (api-build-endpoint "/pulls/1"))
+
+(test-assert "api-build-endpoint: invalid path"
+  (guard (c (#t
+             c))
+    (api-build-endpoint "pulls/1")
+    ;; Assert false since it should return an error.
+    #f))
-- 
2.48.1