diff options
| author | Mathieu Othacehe <othacehe@gnu.org> | 2020-09-02 10:43:22 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-09-02 10:43:22 +0200 |
| commit | b135a02bf22a59f5d8b916b5068961e774fb44b5 (patch) | |
| tree | ae49edec505aed14bd3edabe80d24faf0f703ee0 | |
| parent | 83ac1a84f5a5f1af4c6a81de55b66cb3a2b4cdc5 (diff) | |
| download | cuirass-b135a02bf22a59f5d8b916b5068961e774fb44b5.tar cuirass-b135a02bf22a59f5d8b916b5068961e774fb44b5.tar.gz | |
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.
| -rw-r--r-- | src/cuirass/http.scm | 32 | ||||
| -rw-r--r-- | tests/http.scm | 9 |
2 files changed, 40 insertions, 1 deletions
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 |