[no subject]

[Ludovic Courtès]

branch: master
commit 496b624dda0f78cdc531726d515f57ea1854d89a
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jan 23 23:37:13 2018 +0100

    http: Implement /api/queue.
    
    * src/cuirass/http.scm (url-handler): Add /api/queue handler.
    * tests/http.scm ("http"): Add a BUILD2 and DERIVATION2, and rename
    BUILD and DERIVATION accordingly.
    ("/build/2", "/build/2/log/raw"): Rename to /42.
    ("/api/queue?nr=100"): New test.
---
 src/cuirass/http.scm |  10 +++++
 tests/http.scm       | 101 +++++++++++++++++++++++++++++++++------------------
 2 files changed, 75 insertions(+), 36 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 87fb7b7..0417ffb 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -155,6 +155,16 @@
                                                  `((status done)
                                                    ,@params))))
            (respond-json-with-error 500 "Parameter not defined!"))))
+    (("api" "queue")
+     (let* ((params (request-parameters request))
+            ;; 'nr parameter is mandatory to limit query size.
+            (valid-params? (assq-ref params 'nr)))
+       (if valid-params?
+           (respond-json (object->json-string
+                          (handle-builds-request db
+                                                 `((status pending)
+                                                   ,@params))))
+           (respond-json-with-error 500 "Parameter not defined!"))))
     (_
      (respond (build-response #:code 404)
               #:body (string-append "Resource not found: "
diff --git a/tests/http.scm b/tests/http.scm
index 2c53fad..c136c47 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -27,7 +27,8 @@
              (web response)
              (rnrs bytevectors)
              (srfi srfi-1)
-             (srfi srfi-64))
+             (srfi srfi-64)
+             (ice-9 match))
 
 (define (hash-table-keys table)
   (hash-fold (lambda (key value rest)
@@ -128,37 +129,54 @@
     (wait-until-ready 6688))
 
   (test-assert "fill-db"
-    (let ((build
-           `((#:derivation . "/gnu/store/fake.drv")
-             (#:eval-id . 1)
-             (#:log . "unused so far")
-             (#:status . 0)
-             (#:outputs . (("out" . "/gnu/store/fake-1.0")))
-             (#:timestamp . 1501347493)
-             (#:starttime . 1501347493)
-             (#:stoptime . 1501347493)))
-          (derivation
-           '((#:derivation . "/gnu/store/fake.drv")
-             (#:job-name . "fake-job")
-             (#:system . "x86_64-linux")
-             (#:nix-name . "fake-1.0")
-             (#:eval-id . 1)))
-          (specification
-           '((#:name . "guix")
-             (#:url . "git://git.savannah.gnu.org/guix.git")
-             (#:load-path . ".")
-             (#:file . "/tmp/gnu-system.scm")
-             (#:proc . hydra-jobs)
-             (#:arguments (subset . "hello"))
-             (#:branch . "master")
-             (#:tag . #f)
-             (#:commit . #f)
-             (#:no-compile? . #f)))
-          (evaluation
-           '((#:specification . "guix")
-             (#:revision . 1))))
-      (db-add-build (%db) build)
-      (db-add-derivation (%db) derivation)
+    (let* ((build1
+            `((#:derivation . "/gnu/store/fake.drv")
+              (#:eval-id . 1)
+              (#:log . "unused so far")
+              (#:status . ,(build-status succeeded))
+              (#:outputs . (("out" . "/gnu/store/fake-1.0")))
+              (#:timestamp . 1501347493)
+              (#:starttime . 1501347493)
+              (#:stoptime . 1501347493)))
+           (build2
+            `((#:derivation . "/gnu/store/fake2.drv")
+              (#:eval-id . 1)
+              (#:log . "unused so far")
+              (#:status . ,(build-status scheduled))
+              (#:outputs . (("out" . "/gnu/store/fake-2.0")))
+              (#:timestamp . 1501347493)
+              (#:starttime . 0)
+              (#:stoptime . 0)))
+           (derivation1
+            '((#:derivation . "/gnu/store/fake.drv")
+              (#:job-name . "fake-job")
+              (#:system . "x86_64-linux")
+              (#:nix-name . "fake-1.0")
+              (#:eval-id . 1)))
+           (derivation2
+            '((#:derivation . "/gnu/store/fake2.drv")
+              (#:job-name . "fake-job")
+              (#:system . "x86_64-linux")
+              (#:nix-name . "fake-2.0")
+              (#:eval-id . 1)))
+           (specification
+            '((#:name . "guix")
+              (#:url . "git://git.savannah.gnu.org/guix.git")
+              (#:load-path . ".")
+              (#:file . "/tmp/gnu-system.scm")
+              (#:proc . hydra-jobs)
+              (#:arguments (subset . "hello"))
+              (#:branch . "master")
+              (#:tag . #f)
+              (#:commit . #f)
+              (#:no-compile? . #f)))
+           (evaluation
+            '((#:specification . "guix")
+              (#:revision . 1))))
+      (db-add-build (%db) build1)
+      (db-add-build (%db) build2)
+      (db-add-derivation (%db) derivation1)
+      (db-add-derivation (%db) derivation2)
       (db-add-specification (%db) specification)
       (db-add-evaluation (%db) evaluation)))
 
@@ -178,13 +196,13 @@
       (list (response-code response)
             (response-location response))))
 
-  (test-equal "/build/2"
+  (test-equal "/build/42"
     404
-    (response-code (http-get (test-cuirass-uri "/build/2"))))
+    (response-code (http-get (test-cuirass-uri "/build/42"))))
 
-  (test-equal "/build/2/log/raw"
+  (test-equal "/build/42/log/raw"
     404
-    (response-code (http-get (test-cuirass-uri "/build/2/log/raw"))))
+    (response-code (http-get (test-cuirass-uri "/build/42/log/raw"))))
 
   (test-equal "/api/latestbuilds"
     500
@@ -216,6 +234,17 @@
              json->scm)))
       (= (length hash-list) 0)))
 
+  (test-equal "/api/queue?nr=100"
+    `("fake-2.0" ,(build-status scheduled))
+    (match (call-with-input-string
+               (utf8->string
+                (http-get-body
+                 (test-cuirass-uri "/api/queue?nr=100")))
+             json->scm)
+      ((dictionary)
+       (list (hash-ref dictionary "nixname")
+             (hash-ref dictionary "buildstatus")))))
+
   (test-assert "db-close"
     (db-close (%db)))