Subject: [PATCH Cuirass 06/13] forgejo: Add API communication primitive.

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

* src/cuirass/forges/forgejo.scm (forgejo-request, %forgejo-port,
%forgejo-scheme): New variables.
* tests/forgejo.scm: New test for forgejo-request.
---
 src/cuirass/forges/forgejo.scm | 74 ++++++++++++++++++++++++++++++++--
 tests/forgejo.scm              | 18 +++++++++
 2 files changed, 89 insertions(+), 3 deletions(-)

diff --git a/src/cuirass/forges/forgejo.scm b/src/cuirass/forges/forgejo.scm
index 73ab609..b91413d 100644
--- a/src/cuirass/forges/forgejo.scm
+++ b/src/cuirass/forges/forgejo.scm
@@ -1,5 +1,5 @@
 ;;; forgejo.scm -- Forgejo JSON mappings
-;;; Copyright © 2024 Romain Garbage <[email-masked]>
+;;; Copyright © 2024, 2025 Romain Garbage <[email-masked]>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -20,9 +20,19 @@
   #:use-module (cuirass specification)
   #:use-module (cuirass forges)
   #:use-module (json)
+  #:use-module (web client)
   #:use-module (web http)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:use-module (guix base64)
   #:use-module (guix channels)
+  #:use-module (ice-9 iconv)
   #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-8)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:export (forgejo-pull-request-event-pull-request
             forgejo-pull-request-event-action
             json->forgejo-pull-request-event
@@ -32,12 +42,18 @@
 
             json->forgejo-pull-request
 
-            forgejo-pull-request->specification))
+            forgejo-pull-request->specification
+
+            ;; Used in tests.
+            forgejo-request
+            %forgejo-port
+            %forgejo-scheme))
 
 ;;; Commentary:
 ;;;
 ;;; This module implements a subset of the Forgejo Webhook API described at
-;;; <https://forgejo.org/docs/latest/user/webhooks/>.
+;;; <https://forgejo.org/docs/latest/user/webhooks/> and a subset of the REST
+;;; API described at <https://codeberg.org/api/swagger>.
 ;;;
 ;;; Code:
 
@@ -144,3 +160,55 @@
            . ,(forgejo-repository-name repository))
           (pull-request-target-repository-home-page
            . ,(forgejo-repository-home-page repository))))))))
+
+;;; Error types for the Forgejo API.
+(define-condition-type &forgejo-client-error &error
+  forgejo-error?)
+
+(define-condition-type &forgejo-invalid-response-error &forgejo-client-error
+  forgejo-invalid-reponse-error?
+  (headers  forgejo-invalid-response-headers))
+
+;;; Parameterize port and scheme for tests.
+(define %forgejo-port
+  (make-parameter #f))
+
+(define %forgejo-scheme
+  (make-parameter 'https))
+
+;;; Helper function for API requests.
+(define* (forgejo-request server endpoint
+                          #:key token
+                          method
+                          (body #f)     ; default value in http-request.
+                          (headers '()))
+  "Sends an TOKEN authenticated JSON request to SERVER at ENDPOINT using
+METHOD. Returns the body of the response as a Guile object."
+  (let* ((uri (build-uri (%forgejo-scheme)
+                         #:host server
+                         #:port (%forgejo-port)
+                         #:path endpoint))
+         (headers (append
+                   headers
+                   `((content-type . (application/json))
+                     ;; The Auth Basic scheme needs a base64-encoded
+                     ;; colon-separated user and token values. Forgejo doesn't
+                     ;; seem to care for the user part but the colon seems to
+                     ;; be necessary for the token value to get extracted.
+                     (authorization . (basic . ,(base64-encode
+                                                 (string->utf8
+                                                  (string-append ":" token))))))))
+         (response response-body (http-request uri
+                                               #:method method
+                                               #:headers headers
+                                               #:body (scm->json-string body)))
+         (charset (match (assoc-ref (response-headers response) 'content-type)
+                    (('application/json ('charset . charset))
+                     charset)
+                    (content-type
+                     (raise
+                      (condition
+                       (&forgejo-invalid-response-error
+                        (headers (response-headers response)))))))))
+    (json-string->scm
+     (bytevector->string response-body charset))))
diff --git a/tests/forgejo.scm b/tests/forgejo.scm
index dfb3903..8ffdbcf 100644
--- a/tests/forgejo.scm
+++ b/tests/forgejo.scm
@@ -19,6 +19,7 @@
 (use-modules (cuirass forges)
              (cuirass forges forgejo)
              (cuirass specification)
+             (cuirass tests http)
              (cuirass utils)
              (cuirass tests common)
              (guix channels)
@@ -86,3 +87,20 @@
                   (pull-request-number . 1)
                   (pull-request-target-repository-name . project-name)
                   (pull-request-target-repository-home-page . "https://forgejo.instance.test/base-repo/project-name"))))))
+
+(test-equal "forgejo-request: return value"
+  (json-string->scm default-pull-request-json)
+  (with-http-server `((,(build-response
+                        #:code 200
+                        #:reason-phrase "OK"
+                        #:headers '((content-type . (application/json  (charset . "utf-8"))))) ,default-pull-request-json))
+    (let* ((url (string->uri (%local-url)))
+           (hostname (uri-host url))
+           (scheme (uri-scheme url))
+           (port (uri-port url)))
+      (parameterize ((%forge-token-directory "/tmp")
+                     (%forgejo-port port)
+                     (%forgejo-scheme scheme))
+        (forgejo-request hostname "/"
+                         #:token "token"
+                         #:method 'GET)))))
-- 
2.48.1