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

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

[Mathieu Othacehe]

* 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

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

[Ludovic Courtès]

Hello Mathieu,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> * 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.

Awesome, I had been missing it.  :-)

Hydra doesn’t have such a thing apparently.  We should discuss with Alex
Kost to add support for it in Emacs-Guix.

> +(define (db-get-evaluations db)
> +  (let loop ((rows  (sqlite-exec db "SELECT * FROM Evaluations;"))
> +             (evaluations '()))

I think we should add a LIMIT and ORDER, like we do for ‘db-get-builds’,
to avoid sending too much data to clients and consing too much.

Could you try that?

Later we could add “filters” to select evaluations from one project or
branch.

> +    (match rows
> +      (() evaluations)

Rather (reverse evaluations).

> +                    (with-critical-section db-channel (db)
> +                                           (db-get-evaluations db)))))

Rather:

  (with-critical-section db-channel (db)
    (db-get-evaluations db))

Normally, ‘dir-locals.el’ has the right rule for this.

Thanks!

Ludo’.

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

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 269 bytes --]


Hi Ludo,

> Hydra doesn’t have such a thing apparently.  We should discuss with Alex
> Kost to add support for it in Emacs-Guix.

I added Alex to make sure he is notified!

Here's an updated version adding an ORDER BY and a LIMIT as you
suggested.

Thanks,

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-http-Add-api-evaluations-route.patch --]
[-- Type: text/x-diff, Size: 4604 bytes --]

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

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

[Alex Kost]

Mathieu Othacehe (2018-04-19 11:20 +0200) wrote:

> Hi Ludo,
>
>> Hydra doesn’t have such a thing apparently.  We should discuss with Alex
>> Kost to add support for it in Emacs-Guix.
>
> I added Alex to make sure he is notified!

Thank you!  If an API for the evaluations will be added to cuirass, I
will surely add a support for it to Emacs-Guix.  Thanks for letting me
know!

-- 
Alex

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

[Ludovic Courtès]

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> 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.

Perfect, go for it!

Thanks,
Ludo’.

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

[Mathieu Othacehe]

Hey Ludo,

> Perfect, go for it!

Thanks, pushed :)

Mathieu