[PATCH 2/2] Support publishing evaluation events

[Christopher Baines]

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