branch: main
commit 51ba6894c5a7ba5d8e6edc38f9799394be415a2d
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Tue May 6 16:49:47 2025 +0200
http: Let the bridge modify the database when adding a new spec.
* src/cuirass/http.scm (url-handler): For /admin/gitlab/event,
/admin/forgejo/event, and /admin/specification/add, pass the serialized
sexp to the bridge.
* src/cuirass/scripts/register.scm (bridge): For ‘register-jobset’,
deserialize the spec.
* src/cuirass/base.scm (jobset-registry): For ‘register’, call
‘db-add-or-update-specification’.
---
src/cuirass/base.scm | 1 +
src/cuirass/http.scm | 21 ++++++---------------
src/cuirass/scripts/register.scm | 12 ++++--------
3 files changed, 11 insertions(+), 23 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 44f9688..958be9f 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -1093,6 +1093,7 @@ POLLING-PERIOD seconds."
#:event-log event-log))
(name (specification-name spec)))
(log-info "registering new jobset '~a'" name)
+ (db-add-or-update-specification spec)
(put-message event-log
`(new-event (jobset-registered ,spec)))
(loop (vhash-consq name monitor
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 086b506..46bcd7e 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -739,11 +739,8 @@ return DEFAULT."
;; New merge request.
((or "open" "reopen")
(if (not (db-get-specification (specification-name spec)))
- (begin
- (db-add-or-update-specification spec)
-
- (unless (call-bridge `(register-jobset
,(specification-name spec))
- bridge)
+ (let ((sexp (specification->sexp spec)))
+ (unless (call-bridge `(register-jobset ,sexp) bridge)
(log-warning
"cannot notify bridge of the addition of jobset
'~a'"
(specification-name spec)))
@@ -808,11 +805,8 @@ return DEFAULT."
;; New pull request.
((or 'opened 'reopened)
(if (not (db-get-specification spec-name))
- (begin
- (db-add-or-update-specification spec)
-
- (unless (call-bridge `(register-jobset ,spec-name)
- bridge)
+ (let ((sexp (specification->sexp spec)))
+ (unless (call-bridge `(register-jobset ,sexp) bridge)
(log-warning
"cannot notify bridge of the addition of jobset
'~a'"
spec-name))
@@ -871,11 +865,8 @@ return DEFAULT."
,(format #f "Specification ~a already exists" name))
'())
#:code 400)
- (begin
- (db-add-or-update-specification spec)
-
- (unless (call-bridge `(register-jobset ,(specification-name spec))
- bridge)
+ (let ((sexp (specification->sexp spec)))
+ (unless (call-bridge `(register-jobset ,sexp) bridge)
(log-warning
"cannot notify bridge of the addition of jobset '~a'"
(specification-name spec)))
diff --git a/src/cuirass/scripts/register.scm b/src/cuirass/scripts/register.scm
index 7668a77..3e48320 100644
--- a/src/cuirass/scripts/register.scm
+++ b/src/cuirass/scripts/register.scm
@@ -141,14 +141,10 @@ accepting incoming connections."
;; Note: The protocol is bare-bones and unversioned; the 'cuirass'
;; processes are meant to be upgraded in lockstep.
(match command
- (`(register-jobset ,name)
- (match (db-get-specification name)
- (#f
- (log-warning "requested spec '~a' not found" name)
- (write '(reply #f) socket))
- (spec
- (register-jobset registry spec)
- (write '(reply #t) socket))))
+ (`(register-jobset ,sexp)
+ (let ((spec (sexp->specification sexp)))
+ (register-jobset registry spec)
+ (write '(reply #t) socket)))
(`(update-jobset ,sexp)
(let* ((spec (sexp->specification sexp))
(name (specification-name spec))
