[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#31197] [PATCH] http: Add /api/evaluations route.
From: |
Mathieu Othacehe |
Subject: |
[bug#31197] [PATCH] http: Add /api/evaluations route. |
Date: |
Tue, 17 Apr 2018 16:56:01 +0200 |
* 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.,
Mathieu Othacehe <=