branch master updated: Fix /specifications route.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new b135a02  Fix /specifications route.
b135a02 is described below

commit b135a02bf22a59f5d8b916b5068961e774fb44b5
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Sep 2 10:43:22 2020 +0200

    Fix /specifications route.
    
    Fixes <https://issues.guix.gnu.org/43163>.
    
    * src/cuirass/http.scm (specification->json-object): New procedure,
    (url-handler): use it for "/specifications" route to convert specification
    objects into a representation suitable for json->scm.
    * tests/http.scm ("/specifications"): Test the above route.
---
 src/cuirass/http.scm | 32 +++++++++++++++++++++++++++++++-
 tests/http.scm       |  9 +++++++++
 2 files changed, 40 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index fac675f..98696a6 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -120,6 +120,34 @@
     (#:checkouts . ,(list->vector
                      (assq-ref evaluation #:checkouts)))))
 
+(define (specification->json-object spec)
+  "Turn SPEC into a representation suitable for 'json->scm'."
+  (define (atom? x)
+    (not (pair? x)))
+
+  (define (atom-list? obj)
+    (and (list? obj)
+         (every atom? obj)))
+
+  `((#:name . ,(assq-ref spec #:name))
+    (#:load-path-inputs . ,(list->vector
+                            (assq-ref spec #:load-path-inputs)))
+    (#:package-path-inputs . ,(list->vector
+                               (assq-ref spec #:package-path-inputs)))
+    (#:proc-input . ,(assq-ref spec #:proc-input))
+    (#:proc-file . ,(assq-ref spec #:proc-file))
+    (#:proc . ,(assq-ref spec #:proc))
+    (#:proc-args . ,(map (match-lambda
+                           ((key . arg)
+                            (cons key (if (atom-list? arg)
+                                          (list->vector arg)
+                                          arg))))
+                         (assq-ref spec #:proc-args)))
+    (#:inputs . ,(list->vector
+                  (assq-ref spec #:inputs)))
+    (#:build-outputs . ,(list->vector
+                         (assq-ref spec #:build-outputs)))))
+
 (define (handle-build-request build-id)
   "Retrieve build identified by BUILD-ID over the database and convert it to
 hydra format. Return #f is not build was found."
@@ -355,7 +383,9 @@ Hydra format."
                     '())))
     (('GET (or "jobsets" "specifications") . rest)
      (respond-json (object->json-string
-                    (list->vector (db-get-specifications)))))
+                    (list->vector
+                     (map specification->json-object
+                          (db-get-specifications))))))
     (('GET "build" id)
      (let* ((build (if (string-suffix? ".drv" id)
                        (string-append (%store-prefix) "/" id)
diff --git a/tests/http.scm b/tests/http.scm
index f1d6e46..f80e515 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -192,6 +192,15 @@
       (db-add-evaluation "guix" checkouts1)
       (db-add-evaluation "guix" checkouts2)))
 
+  (test-assert "/specifications"
+    (match (call-with-input-string
+               (utf8->string
+                (http-get-body (test-cuirass-uri "/specifications")))
+             json->scm)
+      (#(spec)
+       (and (string=? (assoc-ref spec "name") "guix")
+            (vector? (assoc-ref spec "package-path-inputs"))))))
+
   (test-assert "/build/1"
     (lset= equal?
      (call-with-input-string