[bug#31197] [PATCH] http: Add /api/evaluations route.

[Mathieu Othacehe <m.othacehe@gmail.com>]

* src/cuirass/database.scm (db-get-evaluations): New exported procedure.
* src/cuirass/http.scm (url-handler): Add /api/evaluations route.
* tests/http.scm ("http"): Add /api/evaluations test route.
---
Hi Guix,

Here's a patch to add /api/evaluations route. It allows to know which
guix commit have been fully evaluated and builded by cuirass before
checkouting them.

Mathieu

 src/cuirass/database.scm | 14 ++++++++++++++
 src/cuirass/http.scm     |  4 ++++
 tests/http.scm           | 20 +++++++++++++++++++-
 3 files changed, 37 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 4dda862..a966af0 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -45,6 +45,7 @@
             db-update-build-status!
             db-get-build
             db-get-builds
+            db-get-evaluations
             read-sql-file
             read-quoted-string
             sqlite-exec
@@ -541,3 +542,16 @@ INSERT INTO Stamps (specification, stamp) VALUES ("
                    (assq-ref spec #:name) ", " commit ");")
       (sqlite-exec db "UPDATE Stamps SET stamp=" commit
                    "WHERE specification=" (assq-ref spec #:name) ";")))
+
+(define (db-get-evaluations db)
+  (let loop ((rows  (sqlite-exec db "SELECT * FROM Evaluations;"))
+             (evaluations '()))
+    (match rows
+      (() evaluations)
+      ((#(id specification revision)
+        . rest)
+       (loop rest
+             (cons `((#:id . ,id)
+                     (#:specification . ,specification)
+                     (#:revision . ,revision))
+                   evaluations))))))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 31960ac..73960ef 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -186,6 +186,10 @@ Hydra format."
              (#f
               (respond-build-not-found build-id)))
            (respond-build-not-found build-id))))
+    (("api" "evaluations")
+     (respond-json (object->json-string
+                    (with-critical-section db-channel (db)
+                                           (db-get-evaluations db)))))
     (("api" "latestbuilds")
      (let* ((params (request-parameters request))
             ;; 'nr parameter is mandatory to limit query size.
diff --git a/tests/http.scm b/tests/http.scm
index 1e1f754..00a8171 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -94,6 +94,11 @@
     (#:releasename . #nil)
     (#:buildinputs_builds . #nil)))
 
+(define evaluations-query-result
+  '((#:id . 1)
+    (#:specification . "guix")
+    (#:revision . "fakesha1")))
+
 (test-group-with-cleanup "http"
   (test-assert "object->json-string"
     ;; Note: We cannot compare the strings directly because field ordering
@@ -177,7 +182,7 @@
               (#:no-compile? . #f)))
            (evaluation
             '((#:specification . "guix")
-              (#:revision . 1))))
+              (#:revision . "fakesha1"))))
       (db-add-build (%db) build1)
       (db-add-build (%db) build2)
       (db-add-derivation (%db) derivation1)
@@ -254,6 +259,19 @@
        (list (hash-ref dictionary "nixname")
              (hash-ref dictionary "buildstatus")))))
 
+  (test-assert "/api/evaluations"
+    (let ((hash-list
+           (call-with-input-string
+               (utf8->string
+                (http-get-body (test-cuirass-uri "/api/evaluations")))
+             json->scm)))
+      (and (= (length hash-list) 1)
+           (hash-table=?
+            (car hash-list)
+            (call-with-input-string
+                (object->json-string evaluations-query-result)
+              json->scm)))))
+
   (test-assert "db-close"
     (db-close (%db)))
 
-- 
2.7.4