From 1311893e2f5b6e1e16c474d018901d4ff4a31234 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 21 Oct 2019 22:43:16 +0100 Subject: Support publishing build events Add a table to store events, which have a type and a JSON blob. These can be used to record changes, this commit inserts events when new builds are created, and when the status of builds change. The EventsOutbox table is then used to track when events have been sent out. This is done through the new cuirass-send-events script. * Makefile.am (bin_SCRIPTS): Add bin/cuirass-send-events. (dist_pkgmodule_DATA): Add src/cuirass/send-events.scm. (dist_sql_DATA): Add src/sql/upgrade-5.sql. (EXTRA_DIST): bin/cuirass-send-events.in. (bin/cuirass-send-events): New rule. * bin/cuirass-send-events.in: New file. * src/cuirass/send-events.scm: New file. * src/sql/upgrade-5.sql: New file. * src/cuirass/base.scm (build-packages): Call db-add-event after db-add-build. * src/cuirass/database.scm (changes-count): New procedure. (db-update-build-status!): Call db-add-event after updating the build status. (db-add-event): New procedure. (db-get-events-in-outbox): New procedure. (db-delete-events-from-output-with-ids-<=-to): New procedure. * src/cuirass/http.scm (handle-events-request): New procedure. (url-handler): Handle /api/build-events requests. * src/schema.sql (Events, EventOutbox): New tables. --- src/cuirass/http.scm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'src/cuirass/http.scm') diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 7579e1a..2a4113f 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -136,6 +136,21 @@ Hydra format." (db-get-builds-by-search filters)))) (list->vector (map build->hydra-build builds)))) +(define (handle-events-request type filters) + "Retrieve all events of TYPE matched by FILTERS in the database." + (let ((events (with-time-logging + (simple-format #f "~A events request" type) + (db-get-events + `((type . ,type) + ,@filters))))) + `((items . ,(list->vector + (map (lambda (event) + `((id . ,(assq-ref event #:id)) + (timestamp . ,(assq-ref event #:timestamp)) + ,@(json-string->scm + (assq-ref event #:event_json)))) + events)))))) + (define (request-parameters request) "Parse the REQUEST query parameters and return them under the form '((parameter . value) ...)." @@ -366,6 +381,15 @@ Hydra format." ,@params (order . status+submission-time))))) (respond-json-with-error 500 "Parameter not defined!")))) + (("api" "build-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 'build params))) + (respond-json-with-error 500 "Parameter not defined!")))) (('GET) (respond-html (html-page "Cuirass" -- cgit v1.2.3