Skip to content
Snippets Groups Projects
Unverified Commit c40e61bd authored by Mathieu Othacehe's avatar Mathieu Othacehe
Browse files

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.
parent 238f856e
No related branches found
No related tags found
No related merge requests found
......@@ -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))))))
......@@ -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.
......
......@@ -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)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment