From 1e035637b52f9788627164ad438bdeecf587733a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 28 Oct 2019 07:56:51 +0000 Subject: Support publishing evaluation events * src/cuirass/base.scm (process-specs): Record the creation of new evaluations as events. * src/cuirass/database.scm (db-set-evaluation-done): Record when evaluations finish as an event. * src/cuirass/http.scm (url-handler): Add a new /api/evaluation-events page. --- src/cuirass/base.scm | 5 +++++ src/cuirass/database.scm | 6 +++++- src/cuirass/http.scm | 9 +++++++++ 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index e7c2597..471a15e 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -770,6 +770,11 @@ started)." (checkouts (fetch-inputs spec)) (eval-id (db-add-evaluation name checkouts))) (when eval-id + (db-add-event 'evaluation + (time-second (current-time time-utc)) + `((#:evaluation . ,eval-id) + (#:specification . ,name) + (#:in_progress . #t))) (compile-checkouts spec (filter compile? checkouts)) (spawn-fiber (lambda () diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 8cb7465..02f9f9c 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -419,7 +419,11 @@ VALUES (" spec-name ", true);") (define (db-set-evaluation-done eval-id) (with-db-critical-section db (sqlite-exec db "UPDATE Evaluations SET in_progress = false -WHERE id = " eval-id ";"))) +WHERE id = " eval-id ";") + (db-add-event 'evaluation + (time-second (current-time time-utc)) + `((#:evaluation . ,eval-id) + (#:in_progress . #f))))) (define-syntax-rule (with-database body ...) "Run BODY with %DB-CHANNEL being dynamically bound to a channel implementing diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 2a4113f..7d36945 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -396,6 +396,15 @@ Hydra format." (specifications-table (db-get-specifications)) '()))) + (("api" "evaluation-events") + (let* ((params (request-parameters request)) + ;; 'nr parameter is mandatory to limit query size. + (valid-params? (assq-ref params 'nr))) + (if valid-params? + (respond-json + (object->json-string + (handle-events-request 'evaluation params))) + (respond-json-with-error 500 "Parameter not defined!")))) (('GET "jobset" name) (respond-html -- cgit v1.2.3