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 12/13] forgejo: Add notification handling. Date: Tue, 11 Mar 2025 11:34:37 +0100
* src/cuirass/forges/forgejo.scm (forgejo-handle-notification): New variable.
* tests/forgejo.scm: Add test for forgejo-handle-notification.
* src/cuirass/forges/notification.scm (%forge-notification-handlers): Add
handler for forgejo forge type.
---
src/cuirass/forges/forgejo.scm | 74 ++++++++++++++++++++++++++++-
src/cuirass/forges/notification.scm | 2 +-
tests/forgejo.scm | 18 +++++++
3 files changed, 92 insertions(+), 2 deletions(-)
diff --git a/src/cuirass/forges/forgejo.scm b/src/cuirass/forges/forgejo.scm
index f84685b..5d1fbb1 100644
--- a/src/cuirass/forges/forgejo.scm
+++ b/src/cuirass/forges/forgejo.scm
@@ -17,8 +17,10 @@
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
(define-module (cuirass forges forgejo)
- #:use-module (cuirass specification)
+ #:use-module (cuirass database)
#:use-module (cuirass forges)
+ #:use-module (cuirass parameters)
+ #:use-module (cuirass specification)
#:use-module (json)
#:use-module (web client)
#:use-module (web http)
@@ -29,6 +31,7 @@
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-8)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -47,6 +50,8 @@
update-forgejo-pull-request
update-forgejo-pull-request-from-spec
+ forgejo-handle-notification
+
;; Used in tests.
forgejo-request
%forgejo-port
@@ -334,3 +339,70 @@ CONTENT, a string. Returns the content of the updated pull-request body."
#:repository repository
#:pull-request-index pull-request-index
#:content content)))
+
+;;;
+;;; Forgejo specific handler of the forge-notification-service agent.
+;;;
+
+(define* (forgejo-handle-notification spec
+ #:key
+ (jobset-created #f)
+ (evaluation-started #f)
+ (evaluation-succeeded #f)
+ (evaluation-failed #f)
+ (build-results #f))
+ "Send notifications to a Forgejo instance. SPEC is a specification record,
+JOBSET-CREATED is a boolean, EVALUATION-STARTED, EVALUATION-SUCCEEDED and
+EVALUATION-FAILED are numbers and BUILD-RESULTS is a list of build records."
+ (let* ((name (specification-name spec))
+ (message (cond
+ (jobset-created
+ (format #f
+ "> Created Cuirass jobset [~a](~a/jobset/~a)."
+ name %cuirass-url name))
+ (evaluation-started
+ (format #f
+ "> Started evaluation [~a](~a/eval/~a) of Cuirass jobset [~a](~a/jobset/~a)."
+ evaluation-started %cuirass-url evaluation-started
+ name %cuirass-url name))
+ (evaluation-succeeded
+ (format #f
+ "> Finished evaluation [~a](~a/eval/~a) of Cuirass jobset [~a](~a/jobset/~a)."
+ evaluation-succeeded %cuirass-url evaluation-succeeded
+ name %cuirass-url name))
+ (evaluation-failed
+ (format #f
+ "> Evaluation [~a](~a/eval/~a) of Cuirass jobset [~a](~a/jobset/~a) failed."
+ evaluation-failed %cuirass-url evaluation-failed
+ name %cuirass-url name))
+ (build-results
+ (let* ((evaluation-id (max (filter-map build-evaluation-id
+ build-results)))
+ (header
+ (format #f "> Results for evaluation [~a](~a/eval/~a) of Cuirass jobset [~a](~a/jobset/~a):~%"
+ evaluation-id %cuirass-url evaluation-id
+ name %cuirass-url name))
+ (succeeded-builds (filter-map (lambda (build)
+ (and (eq? 0 (build-current-status build))
+ (build-nix-name build)))
+ build-results))
+ (failed-builds (filter-map (lambda (build)
+ (and (build-failure?
+ (build-current-status build))
+ (build-nix-name build)))
+ build-results))
+ (successes (if (null? succeeded-builds)
+ ""
+ (format #f "> Successfully build ~a package(s): ~a~%"
+ (length succeeded-builds)
+ (string-join succeeded-builds ", "))))
+ (failures (if (null? failed-builds)
+ ""
+ (format #f "> Failed build ~a package(s): ~a~%"
+ (length failed-builds)
+ (string-join failed-builds ", ")))))
+ (string-append header successes failures)))
+ (#t #f))))
+ ;; XXX: Raise an error when no message has been generated?
+ (when message
+ (update-forgejo-pull-request-from-spec spec message))))
diff --git a/src/cuirass/forges/notification.scm b/src/cuirass/forges/notification.scm
index ca7ed7b..0d1842f 100644
--- a/src/cuirass/forges/notification.scm
+++ b/src/cuirass/forges/notification.scm
@@ -61,7 +61,7 @@
;; - EVALUATION-FAILED, a number (evaluation-id)
;; - BUILD-RESULTS, a list of BUILD records
(define %forge-notification-handlers
- '())
+ `((forgejo . ,forgejo-handle-notification)))
;; The jobset monitor spawns a forge-notification-service instance and subscribes it
;; to the event-log-service that forwards a copy of every newly created event
diff --git a/tests/forgejo.scm b/tests/forgejo.scm
index 8003c7d..f7c3097 100644
--- a/tests/forgejo.scm
+++ b/tests/forgejo.scm
@@ -211,3 +211,21 @@
#:repository "repository"
#:pull-request-index 1
#:content "New content."))))))
+
+(test-equal "forgejo-handle-notification"
+ #f
+ (let ((default-response
+ (build-response
+ #:code 200
+ #:reason-phrase "OK"
+ #:headers '((content-type . (application/json (charset . "utf-8")))))))
+ (with-http-server `((,default-response ,default-pull-request-json)
+ (,default-response ,updated-body-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-handle-notification ))))))
--
2.48.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.