[PATCH Cuirass v2] cuirass: Fix handling of SPECIFICATION-NAME.

[Romain GARBAGE]

Fixes a regression introduced in
1da873b0e23eceb3c239dd6dc6781debf23bec63, where the NAME field of the
SPECIFICATION record type is forced to be a symbol as stated by the
documentation.

* src/cuirass/base.scm (jobset-registry): Handle SPECIFICATION-NAME as a
symbol.
* src/cuirass/http.scm (body->specification, specification->json-object, 
url-handler): Handle SPECIFICATION-NAME as a symbol.
* src/cuirass/templates.scm (specifications-table, specification-edit):
Fix template generation.
---
 src/cuirass/base.scm      |  4 ++--
 src/cuirass/http.scm      | 28 +++++++++++++++-------------
 src/cuirass/templates.scm | 21 +++++++++++----------
 3 files changed, 28 insertions(+), 25 deletions(-)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 86d2f97..507be5f 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -857,7 +857,7 @@ POLLING-PERIOD seconds."
                         ((_ . actor) actor)))
          (loop registry))
         (`(update ,spec)
-         (let ((name (string->symbol (specification-name spec))))
+         (let ((name (specification-name spec)))
            (match (vhash-assq name registry)
              (#f
               (log-error "cannot update non-existent spec '~s'" name))
@@ -877,7 +877,7 @@ POLLING-PERIOD seconds."
                                                   #:polling-period period))
                    (name (specification-name spec)))
               (log-info "registering new jobset '~a'" name)
-              (loop (vhash-consq (string->symbol name) monitor
+              (loop (vhash-consq name monitor
                                  registry))))
            ((_ . monitor)
             (log-info "jobset '~a' was already registered"
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 48c506c..44d98d4 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -191,7 +191,7 @@ a <checkout> record."
      ((mastodon? notif)
       `((type . mastodon)))))
 
-  `((name . ,(specification-name spec))
+  `((name . ,(symbol->string (specification-name spec)))
     (build . ,(match (specification-build spec)
                 ((? symbol? subset)
                  subset)
@@ -439,7 +439,8 @@ into a specification record and return it."
                                        ((key . param)
                                         (and (eq? key field) param)))
                                      params)))
-         (name (assq-ref params 'name))
+         (name (string->symbol
+                (assq-ref params 'name)))
          (build (string->symbol
                  (assq-ref params 'build)))
          (build-params (or (and (assq-ref params 'param-select)
@@ -458,7 +459,7 @@ into a specification record and return it."
                                       param)))))))
          (channels (map (lambda (name url branch)
                           (channel
-                           (name (string->symbol name))
+                           (name name)
                            (url url)
                            (branch branch)))
                         (filter-field 'channel-name)
@@ -743,7 +744,7 @@ bogus reply is received, return DEFAULT."
                          (respond-json-with-error 400 "Jobset already 
exists."))))
                   ;; Accepted or rejected merge requests receive the same 
treatment.
                   ((or "close" "merge")
-                   (let ((spec-name (symbol->string (specification-name 
spec))))
+                   (let ((spec-name (specification-name spec)))
                      (if (db-get-specification spec-name)
                          (begin
                            (db-remove-specification spec-name)
@@ -760,7 +761,7 @@ bogus reply is received, return DEFAULT."
                   ;; treated the same way: the jobset is reevaluated.
                   ;; XXX: Copied and adapted from 
"/jobset/<spec>/hook/evaluate.
                   ("update"
-                   (let ((spec-name (symbol->string (specification-name 
spec))))
+                   (let ((spec-name (specification-name spec)))
                      (if (db-get-specification spec-name)
                          (if (call-bridge `(trigger-jobset 
,(specification-name spec))
                                           bridge)
@@ -817,7 +818,7 @@ bogus reply is received, return DEFAULT."
          (build-outputs old-outputs)
          (notifications old-notifications)))
 
-       (unless (call-bridge `(update-jobset ,(string->symbol name))
+       (unless (call-bridge `(update-jobset ,name)
                             bridge)
          (log-error "cannot notify bridge of modification of jobset '~a'"
                     name))
@@ -837,7 +838,7 @@ bogus reply is received, return DEFAULT."
       #:body ""))
 
     (('GET "admin" "specifications" "activate" name)
-     (if (call-bridge `(activate-jobset ,(string->symbol name))
+     (if (call-bridge `(activate-jobset ,name)
                       bridge)
          (let ((location (string-append "/jobset/" name)))
            (respond
@@ -1180,7 +1181,8 @@ bogus reply is received, return DEFAULT."
            (respond-dashboard-not-found id))))
     (('GET "jobset" name)
      (respond-html
-      (let* ((evaluation-id-max (db-get-evaluations-id-max name))
+      (let* ((name (string->symbol name))
+             (evaluation-id-max (db-get-evaluations-id-max name))
              (evaluation-id-min (db-get-evaluations-id-min name))
              (params (request-parameters request))
              (border-high (assq-ref params 'border-high))
@@ -1192,13 +1194,13 @@ bogus reply is received, return DEFAULT."
              (absolute-summary
               (db-get-evaluations-absolute-summary evaluations))
              (active?
-              (call-bridge `(active-jobset? ,(string->symbol name))
+              (call-bridge `(active-jobset? ,name)
                            bridge #t))
              (last-updates
-              (call-bridge `(jobset-last-update-times ,(string->symbol name))
+              (call-bridge `(jobset-last-update-times ,name)
                            bridge)))
         (html-page
-         (string-append "Jobset " name)
+         (string-append "Jobset " (symbol->string name))
          (evaluation-info-table name
                                 evaluations
                                 evaluation-id-min
@@ -1210,7 +1212,7 @@ bogus reply is received, return DEFAULT."
                                 #:last-update-times
                                 last-updates)
          `(((#:name . ,name)
-            (#:link . ,(string-append "/jobset/" name))))))))
+            (#:link . ,(string-append "/jobset/" (symbol->string name)))))))))
 
     (('GET "eval" "latest")
      (let* ((params (request-parameters request))
@@ -1405,7 +1407,7 @@ bogus reply is received, return DEFAULT."
      (let* ((spec (db-get-specification spec))
             (name (and spec (specification-name spec))))
        (if spec
-           (if (call-bridge `(trigger-jobset ,(string->symbol name))
+           (if (call-bridge `(trigger-jobset ,name)
                             bridge)
                (respond-json (scm->json-string `((jobset . ,name))))
                (begin
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 54a10c1..d49c868 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -378,8 +378,8 @@ system whose names start with " (code "guile-") ":" (br)
                      (td
                       (@ (class "column-name"))
                       (a (@ (href "/jobset/"
-                                  ,(specification-name spec)))
-                         ,(specification-name spec)))
+                                  ,(symbol->string (specification-name spec))))
+                         ,(symbol->string (specification-name spec))))
                      (td
                       (@ (class "column-build"))
                       ,(match (specification-build spec)
@@ -422,11 +422,11 @@ system whose names start with " (code "guile-") ":" (br)
                        (style "vertical-align: middle"))
                       ,@(let* ((summary
                                 (and=> (spec->latest-eval-ok
-                                        (specification-name spec))
+                                        (symbol->string (specification-name 
spec)))
                                        eval-summary))
                                (last-eval
                                 (spec->latest-eval
-                                 (specification-name spec)))
+                                 (symbol->string (specification-name spec))))
                                (last-eval-status-ok?
                                 (and last-eval
                                      (<= (evaluation-current-status last-eval)
@@ -455,7 +455,7 @@ system whose names start with " (code "guile-") ":" (br)
                            (else '()))))
                      (td
                       (@ (class "column-action"))
-                      ,@(let* ((name (specification-name spec))
+                      ,@(let* ((name (symbol->string (specification-name 
spec)))
                                (dashboard-name
                                 (string-append "Dashboard " name)))
                           `((a (@ (href "/eval/latest/dashboard?spec="
@@ -468,10 +468,10 @@ system whose names start with " (code "guile-") ":" (br)
                       ,(let ((id
                               (string-append
                                "specDropdown-"
-                               (specification-name spec)))
+                               (symbol->string (specification-name spec))))
                              (name
                               (string-append "Options "
-                                             (specification-name spec))))
+                                             (symbol->string 
(specification-name spec)))))
                          `(div
                            (@ (id ,id)
                               (title ,name)
@@ -490,12 +490,12 @@ system whose names start with " (code "guile-") ":" (br)
                                (li (@ (role "menuitem"))
                                    (a (@ (class "dropdown-item")
                                          (href "/specification/edit/"
-                                               ,(specification-name spec)))
+                                               ,(symbol->string 
(specification-name spec))))
                                       " Edit"))
                                (li (@ (role "menuitem"))
                                    (a (@ (class "dropdown-item")
                                          (href 
"/admin/specifications/deactivate/"
-                                               ,(specification-name spec)))
+                                               ,(symbol->string 
(specification-name spec))))
                                       " Deactivate"))))))))
                  specs)))))))
 
@@ -569,7 +569,8 @@ the existing SPEC otherwise."
                                  '("")
                                  rest)))))))
 
-  (let ((name (and spec (specification-name spec)))
+  (let ((name (and spec (symbol->string
+                         (specification-name spec))))
         (build (and spec (match (specification-build spec)
                            ((? symbol? build) build)
                            ((build _ ...) build))))
-- 
2.45.1