Package: guix-patches;
Reported by: Romain GARBAGE <romain.garbage <at> inria.fr>
Date: Tue, 11 Mar 2025 10:34:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Romain GARBAGE <romain.garbage <at> inria.fr> To: 76938 <at> debbugs.gnu.org Cc: ludovic.courtes <at> inria.fr, Romain GARBAGE <romain.garbage <at> inria.fr> Subject: [bug#76938] [PATCH Cuirass 06/13] forgejo: Add API communication primitive. 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 <romain.garbage <at> inria.fr>
+;;; Copyright © 2024, 2025 Romain Garbage <romain.garbage <at> inria.fr>
;;;
;;; 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.