Subject: [bug#76938] [PATCH Cuirass 12/13] forgejo: Add notification handling.

From: Romain GARBAGE <[email-masked]>
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