branch: main
commit 5404309afc09cc68bd16d63480423cdf0d70a552
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Tue May 6 14:59:13 2025 +0200
http: Let the bridge modify the database when editing a spec.
* src/cuirass/http.scm (url-handler): In /admin/specification/edit,
remove call to ‘db-add-or-update-specification’. Pass the spec sexp to
the bridge.
* src/cuirass/scripts/register.scm (bridge): For ‘update-jobset’,
deserialize the given spec.
* src/cuirass/base.scm (jobset-registry): Call
‘db-add-or-update-specification’ in the ‘update’ sexp.
---
src/cuirass/base.scm | 5 +++--
src/cuirass/http.scm | 14 ++++++--------
src/cuirass/scripts/register.scm | 8 +++++---
3 files changed, 14 insertions(+), 13 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 5245c60..44f9688 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -1056,9 +1056,10 @@ POLLING-PERIOD seconds."
(#f
(log-error "cannot update non-existent spec '~s'" name))
((_ . monitor)
+ (db-add-or-update-specification spec)
+ (put-message monitor `(update-spec ,spec))
(put-message event-log
- `(new-event (jobset-updated ,spec)))
- (put-message monitor `(update-spec ,spec)))))
+ `(new-event (jobset-updated ,spec))))))
(loop registry))
(`(unregister ,name ,reply)
(match (vhash-assq name registry)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 605753b..086b506 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -895,14 +895,12 @@ return DEFAULT."
;; XXX: It is not possible yet to edit build outputs and notifications
;; using the web interface. Use the outputs and notifications from the
;; existing specification.
-
- (db-add-or-update-specification
- (specification
- (inherit spec)
- (build-outputs old-outputs)
- (notifications old-notifications)))
-
- (unless (call-bridge `(update-jobset ,name)
+ (unless (call-bridge `(update-jobset
+ ,(specification->sexp
+ (specification
+ (inherit spec)
+ (build-outputs old-outputs)
+ (notifications old-notifications))))
bridge)
(log-error "cannot notify bridge of modification of jobset '~a'"
name))
diff --git a/src/cuirass/scripts/register.scm b/src/cuirass/scripts/register.scm
index a71d2ff..7668a77 100644
--- a/src/cuirass/scripts/register.scm
+++ b/src/cuirass/scripts/register.scm
@@ -149,9 +149,11 @@ accepting incoming connections."
(spec
(register-jobset registry spec)
(write '(reply #t) socket))))
- (`(update-jobset ,name)
- (let ((spec (db-get-specification name)))
- (if spec
+ (`(update-jobset ,sexp)
+ (let* ((spec (sexp->specification sexp))
+ (name (specification-name spec))
+ (old-spec (db-get-specification name)))
+ (if old-spec
(begin
(update-jobset registry spec)
(write '(reply #t) socket))
