http: Change the paramater format from two-elements lists to pairs.

* src/cuirass/database.scm (assqx-ref): Remove exported procedure.
(db-get-builds, db-get-build): Adapt to new format.
* src/cuirass/http.scm (request-parameters): Use (cons key param) instead
of (list key param).
(url-handler): Adapt to new format.
* tests/database.scm ("db-get-builds"): Idem.

3 files changed, 45 insertions, 56 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 9b442c1..56f421d 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -58,7 +58,6 @@
             read-sql-file
             read-quoted-string
             sqlite-exec
-            assqx-ref
             ;; Parameters.
             %package-database
             %package-schema-file
@@ -461,16 +460,6 @@ log file for DRV."
        (#:repo-name  . ,repo-name)
        (#:outputs    . ,(db-get-outputs db id))))))
 
-;; XXX Change caller and remove
-(define (assqx-ref filters key)
-  (match filters
-    (()
-     #f)
-    (((xkey xvalue) rest ...)
-     (if (eq? key xkey)
-         xvalue
-         (assqx-ref rest key)))))
-
 (define (db-get-builds db filters)
   "Retrieve all builds in database DB which are matched by given FILTERS.
 FILTERS is an assoc list whose possible keys are 'id | 'jobset | 'job |
@@ -547,13 +536,13 @@ Assumes that if group id stays the same the group headers stay the same."
          (collect-outputs x-builds-id x-repeated-row '() rows)))))
 
   (let* ((order (match (assq 'order filters)
-                  (('order 'build-id) "id ASC")
-                  (('order 'decreasing-build-id) "id DESC")
-                  (('order 'finish-time) "stoptime DESC")
-                  (('order 'finish-time+build-id) "stoptime DESC, id DESC")
-                  (('order 'start-time) "starttime DESC")
-                  (('order 'submission-time) "timestamp DESC")
-                  (('order 'status+submission-time)
+                  (('order . 'build-id) "id ASC")
+                  (('order . 'decreasing-build-id) "id DESC")
+                  (('order . 'finish-time) "stoptime DESC")
+                  (('order . 'finish-time+build-id) "stoptime DESC, id DESC")
+                  (('order . 'start-time) "starttime DESC")
+                  (('order . 'submission-time) "timestamp DESC")
+                  (('order . 'status+submission-time)
                    ;; With this order, builds in 'running' state (-1) appear
                    ;; before those in 'scheduled' state (-2).
                    "status DESC, timestamp DESC")
@@ -585,17 +574,17 @@ ORDER BY ~a, id ASC;" order))
          (stmt (sqlite-prepare db stmt-text #:cache? #t)))
     (sqlite-bind-arguments
      stmt
-     #:id (assqx-ref filters 'id)
-     #:jobset (assqx-ref filters 'jobset)
-     #:job (assqx-ref filters 'job)
-     #:evaluation (assqx-ref filters 'evaluation)
-     #:system (assqx-ref filters 'system)
-     #:status (and=> (assqx-ref filters 'status) object->string)
-     #:borderlowid (assqx-ref filters 'border-low-id)
-     #:borderhighid (assqx-ref filters 'border-high-id)
-     #:borderlowtime (assqx-ref filters 'border-low-time)
-     #:borderhightime (assqx-ref filters 'border-high-time)
-     #:nr (match (assqx-ref filters 'nr)
+     #:id (assq-ref filters 'id)
+     #:jobset (assq-ref filters 'jobset)
+     #:job (assq-ref filters 'job)
+     #:evaluation (assq-ref filters 'evaluation)
+     #:system (assq-ref filters 'system)
+     #:status (and=> (assq-ref filters 'status) object->string)
+     #:borderlowid (assq-ref filters 'border-low-id)
+     #:borderhighid (assq-ref filters 'border-high-id)
+     #:borderlowtime (assq-ref filters 'border-low-time)
+     #:borderhightime (assq-ref filters 'border-high-time)
+     #:nr (match (assq-ref filters 'nr)
             (#f -1)
             (x x)))
     (sqlite-reset stmt)
@@ -603,7 +592,7 @@ ORDER BY ~a, id ASC;" order))
 
 (define (db-get-build db id)
   "Retrieve a build in database DB which corresponds to ID."
-  (match (db-get-builds db `((id ,id)))
+  (match (db-get-builds db `((id . ,id)))
     ((build)
      build)
     (() #f)))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 5a5eb52..2d66ff9 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -118,7 +118,7 @@
 
 (define (request-parameters request)
   "Parse the REQUEST query parameters and return them under the form
-  '((parameter value) ...)."
+  '((parameter . value) ...)."
   (let* ((uri (request-uri request))
          (query (uri-query uri)))
     (if query
@@ -126,7 +126,7 @@
                (match (string-split param #\=)
                  ((key param)
                   (let ((key-symbol (string->symbol key)))
-                    (list key-symbol
+                    (cons key-symbol
                           (match key-symbol
                             ('id (string->number param))
                             ('nr (string->number param))
@@ -248,9 +248,7 @@
     (("api" "evaluations")
      (let* ((params (request-parameters request))
             ;; 'nr parameter is mandatory to limit query size.
-            (nr (match (assq-ref params 'nr)
-                  ((val) val)
-                  (_ #f))))
+            (nr (assq-ref params 'nr)))
        (if nr
            (respond-json (object->json-string
                           (with-critical-section db-channel (db)
@@ -265,9 +263,9 @@
            (respond-json
             (object->json-string
              (with-critical-section db-channel (db)
-               (handle-builds-request db `((status done)
+               (handle-builds-request db `((status . done)
                                            ,@params
-                                           (order finish-time))))))
+                                           (order . finish-time))))))
            (respond-json-with-error 500 "Parameter not defined!"))))
     (("api" "queue")
      (let* ((params (request-parameters request))
@@ -279,9 +277,9 @@
              ;; Use the 'status+submission-time' order so that builds in
              ;; 'running' state appear before builds in 'scheduled' state.
              (with-critical-section db-channel (db)
-               (handle-builds-request db `((status pending)
+               (handle-builds-request db `((status . pending)
                                            ,@params
-                                           (order status+submission-time))))))
+                                           (order . status+submission-time))))))
            (respond-json-with-error 500 "Parameter not defined!"))))
     ('()
      (respond-html (html-page
@@ -296,8 +294,8 @@
         (let* ((evaluation-id-max (db-get-evaluations-id-max db name))
                (evaluation-id-min (db-get-evaluations-id-min db name))
                (params (request-parameters request))
-               (border-high (assqx-ref params 'border-high))
-               (border-low (assqx-ref params 'border-low))
+               (border-high (assq-ref params 'border-high))
+               (border-low (assq-ref params 'border-low))
                (evaluations (db-get-evaluations-build-summary db
                                                               name
                                                               %page-size
@@ -314,20 +312,20 @@
         (let* ((builds-id-max (db-get-builds-max db id))
                (builds-id-min (db-get-builds-min db id))
                (params (request-parameters request))
-               (border-high-time (assqx-ref params 'border-high-time))
-               (border-low-time (assqx-ref params 'border-low-time))
-               (border-high-id (assqx-ref params 'border-high-id))
-               (border-low-id (assqx-ref params 'border-low-id)))
+               (border-high-time (assq-ref params 'border-high-time))
+               (border-low-time (assq-ref params 'border-low-time))
+               (border-high-id (assq-ref params 'border-high-id))
+               (border-low-id (assq-ref params 'border-low-id)))
           (html-page
            "Evaluation"
            (build-eval-table
-            (handle-builds-request db `((evaluation ,id)
-                                        (nr ,%page-size)
-                                        (order finish-time+build-id)
-                                        (border-high-time ,border-high-time)
-                                        (border-low-time ,border-low-time)
-                                        (border-high-id ,border-high-id)
-                                        (border-low-id ,border-low-id)))
+            (handle-builds-request db `((evaluation . ,id)
+                                        (nr . ,%page-size)
+                                        (order . finish-time+build-id)
+                                        (border-high-time . ,border-high-time)
+                                        (border-low-time . ,border-low-time)
+                                        (border-high-id . ,border-high-id)
+                                        (border-low-id . ,border-low-id)))
             builds-id-min
             builds-id-max))))))
 
diff --git a/tests/database.scm b/tests/database.scm
index 6ca9d1c..17d48f5 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -194,12 +194,14 @@ INSERT INTO Evaluations (specification, commits) VALUES (3, 3);")
       (let ((summarize (lambda (alist)
                          (list (assq-ref alist #:id)
                                (assq-ref alist #:derivation)))))
-        (vector (map summarize (db-get-builds db '((nr 3) (order build-id))))
+        (vector (map summarize (db-get-builds db '((nr . 3)
+                                                   (order . build-id))))
                 (map summarize (db-get-builds db '()))
-                (map summarize (db-get-builds db '((jobset "guix"))))
-                (map summarize (db-get-builds db '((nr 1))))
+                (map summarize (db-get-builds db '((jobset . "guix"))))
+                (map summarize (db-get-builds db '((nr . 1))))
                 (map summarize
-                     (db-get-builds db '((order status+submission-time))))))))
+                     (db-get-builds
+                      db '((order . status+submission-time))))))))
 
   (test-equal "db-get-pending-derivations"
     '("/bar.drv" "/foo.drv")