aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-10-28 07:56:51 +0000
committerChristopher Baines <mail@cbaines.net>2019-11-28 18:10:31 +0000
commit1e035637b52f9788627164ad438bdeecf587733a (patch)
tree26dbbd736889e59076904cbab50bb7f16c06b1bc
parent1311893e2f5b6e1e16c474d018901d4ff4a31234 (diff)
downloadcuirass-1e035637b52f9788627164ad438bdeecf587733a.tar
cuirass-1e035637b52f9788627164ad438bdeecf587733a.tar.gz
Support publishing evaluation eventssupport-publishing-build-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.
-rw-r--r--src/cuirass/base.scm5
-rw-r--r--src/cuirass/database.scm6
-rw-r--r--src/cuirass/http.scm9
3 files changed, 19 insertions, 1 deletions
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