diff options
author | Christopher Baines <mail@cbaines.net> | 2020-06-28 22:32:14 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2020-07-01 17:43:38 +0100 |
commit | 9be68c01b14413974598ba73fa41d80fa3eb15ba (patch) | |
tree | 371e07b1a6ab05f7695ba189a8c4e6d507c62282 | |
parent | 5e61bc03b4f33ebb7378a3647bde6269b70c99fb (diff) | |
download | build-coordinator-9be68c01b14413974598ba73fa41d80fa3eb15ba.tar build-coordinator-9be68c01b14413974598ba73fa41d80fa3eb15ba.tar.gz |
Add hooks to send events to the Guix Data Service
-rw-r--r-- | guix-build-coordinator/hooks.scm | 101 |
1 files changed, 100 insertions, 1 deletions
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index 2def72c..fee06da 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -29,6 +29,7 @@ #:use-module (guix-build-coordinator utils) #:use-module (guix-build-coordinator datastore) #:use-module (guix-build-coordinator coordinator) + #:use-module (guix-build-coordinator guix-data-service) #:export (default-build-submitted-hook default-build-started-hook default-build-success-hook @@ -36,7 +37,12 @@ build-success-s3-publish-hook default-build-failure-hook build-failure-retry-hook - default-build-missing-inputs-hook)) + default-build-missing-inputs-hook + + build-submitted-send-event-to-guix-data-service-hook + build-started-send-event-to-guix-data-service-hook + build-success-send-event-to-guix-data-service-hook + build-failure-send-event-to-guix-data-service-hook)) (define (default-build-submitted-hook build-coordinator build-id) (display @@ -254,3 +260,96 @@ (length builds-for-output) missing-input))))) missing-inputs)))) + +(define (build-submitted-send-event-to-guix-data-service-hook target-url) + (lambda (build-coordinator build-id) + (define datastore + (build-coordinator-datastore build-coordinator)) + + (let ((build-details + (datastore-find-build datastore build-id))) + + (send-build-event-to-guix-data-service + target-url + `((type . build) + (event . scheduled) + (build_id . ,build-id) + (derivation . ,(assq-ref build-details 'derivation-name)) + ,@(let ((created-at (assq-ref build-details 'created-at))) + (if created-at + `((timestamp` . ,(string->number + (strftime + "%s" + (assq-ref build-details 'created-at))))) + '()))))))) + +(define (build-started-send-event-to-guix-data-service-hook target-url) + (lambda (build-coordinator build-id agent-id) + (define datastore + (build-coordinator-datastore build-coordinator)) + + (let ((build-details + (datastore-find-build datastore build-id)) + (timestamp + (string->number + (strftime + "%s" + (assq-ref + (first + (filter (lambda (start-time-and-agent) + (string=? agent-id + (assq-ref start-time-and-agent 'agent-id))) + (datastore-find-build-starts datastore build-id))) + 'start-time))))) + + (send-build-event-to-guix-data-service + target-url + `((type . build) + (event . started) + (build_id . ,build-id) + (derivation . ,(assq-ref build-details 'derivation-name)) + (timestamp . ,timestamp)))))) + +(define (build-success-send-event-to-guix-data-service-hook target-url) + (lambda (build-coordinator build-id) + (define datastore + (build-coordinator-datastore build-coordinator)) + + (let ((build-details + (datastore-find-build datastore build-id))) + + (send-build-event-to-guix-data-service + target-url + `((type . build) + (event . succeeded) + (build_id . ,build-id) + (derivation . ,(assq-ref build-details 'derivation-name)) + ,@(let ((end-time (assq-ref build-details 'end-time))) + (if end-time + `((timestamp` . ,(string->number + (strftime "%s" + (assq-ref build-details + 'end-time))))) + '()))))))) + +(define (build-failure-send-event-to-guix-data-service-hook target-url) + (lambda (build-coordinator build-id) + (define datastore + (build-coordinator-datastore build-coordinator)) + + (let ((build-details + (datastore-find-build datastore build-id))) + + (send-build-event-to-guix-data-service + target-url + `((type . build) + (event . failed) + (build_id . ,build-id) + (derivation . ,(assq-ref build-details 'derivation-name)) + ,@(let ((end-time (assq-ref build-details 'end-time))) + (if end-time + `((timestamp` . ,(string->number + (strftime "%s" + (assq-ref build-details + 'end-time))))) + '()))))))) |