From c40e61bd3e9c4d1ceca53002c7bc21ff0754cfff Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Thu, 19 Apr 2018 11:17:42 +0200
Subject: [PATCH] http: Add /api/evaluations route.

* 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.
---
 src/cuirass/database.scm | 15 +++++++++++++++
 src/cuirass/http.scm     | 11 +++++++++++
 tests/http.scm           | 28 +++++++++++++++++++++++++---
 3 files changed, 51 insertions(+), 3 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 4dda862..8437475 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,17 @@ 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 limit)
+  (let loop ((rows  (sqlite-exec db "SELECT id, specification, revision
+FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
+             (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..e911b9b 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -186,6 +186,17 @@ Hydra format."
              (#f
               (respond-build-not-found build-id)))
            (respond-build-not-found build-id))))
+    (("api" "evaluations")
+     (let* ((params (request-parameters request))
+            ;; 'nr parameter is mandatory to limit query size.
+            (nr (match (assq-ref params 'nr)
+                  ((val) val)
+                  (_ #f))))
+       (if nr
+           (respond-json (object->json-string
+                          (with-critical-section db-channel (db)
+                            (db-get-evaluations db nr))))
+           (respond-json-with-error 500 "Parameter not defined!"))))
     (("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..9d460b2 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -94,6 +94,11 @@
     (#:releasename . #nil)
     (#:buildinputs_builds . #nil)))
 
+(define evaluations-query-result
+  '((#:id . 2)
+    (#:specification . "guix")
+    (#:revision . "fakesha2")))
+
 (test-group-with-cleanup "http"
   (test-assert "object->json-string"
     ;; Note: We cannot compare the strings directly because field ordering
@@ -175,15 +180,19 @@
               (#:tag . #f)
               (#:commit . #f)
               (#:no-compile? . #f)))
-           (evaluation
+           (evaluation1
+            '((#:specification . "guix")
+              (#:revision . "fakesha1")))
+           (evaluation2
             '((#:specification . "guix")
-              (#:revision . 1))))
+              (#:revision . "fakesha2"))))
       (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)))
+      (db-add-evaluation (%db) evaluation1)
+      (db-add-evaluation (%db) evaluation2)))
 
   (test-assert "/build/1"
     (hash-table=?
@@ -254,6 +263,19 @@
        (list (hash-ref dictionary "nixname")
              (hash-ref dictionary "buildstatus")))))
 
+  (test-assert "/api/evaluations?nr=1"
+    (let ((hash-list
+           (call-with-input-string
+               (utf8->string
+                (http-get-body (test-cuirass-uri "/api/evaluations?nr=1")))
+             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