From e7e98cc7ca765a0ebaa65f9dd90fefcaeed0b308 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 1 Jul 2020 17:44:15 +0100
Subject: Add a way of sending events for all builds to the Guix Data Service

To backfill the data, where the hooks haven't been used.
---
 guix-build-coordinator/guix-data-service.scm | 71 +++++++++++++++++++++++++++-
 1 file changed, 69 insertions(+), 2 deletions(-)

diff --git a/guix-build-coordinator/guix-data-service.scm b/guix-build-coordinator/guix-data-service.scm
index d777b49..7c4bd09 100644
--- a/guix-build-coordinator/guix-data-service.scm
+++ b/guix-build-coordinator/guix-data-service.scm
@@ -25,12 +25,19 @@
   #:use-module (json)
   #:use-module (web client)
   #:use-module (web response)
-  #:export (send-build-event-to-guix-data-service))
+  #:use-module (guix-build-coordinator datastore)
+  #:export (send-build-event-to-guix-data-service
+
+            send-events-for-all-builds))
 
 (define (send-build-event-to-guix-data-service target-url event)
+  (send-build-events-to-guix-data-service target-url
+                                          (list event)))
+
+(define (send-build-events-to-guix-data-service target-url events)
   (define body
     (scm->json-string
-     `((items . ,(vector event)))))
+     `((items . ,(list->vector events)))))
 
   (let*-values
       (((response body)
@@ -48,3 +55,63 @@
         (simple-format #f "code: ~A response: ~A"
                        code
                        (utf8->string body)))))))
+
+(define (send-events-for-all-builds datastore target-url)
+  (define (events-for-build build-id)
+    (define build-details
+      (datastore-find-build datastore build-id))
+
+    (define derivation-name
+      (assq-ref build-details 'derivation-name))
+
+    `(((type       . build)
+       (event      . scheduled)
+       (build_id   . ,build-id)
+       (derivation . ,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)))))
+               '())))
+
+      ,@(map
+         (lambda (start-time-and-agent)
+           `((type       . build)
+             (event      . started)
+             (build_id   . ,build-id)
+             (derivation . ,derivation-name)
+             (timestamp  . ,(string->number
+                             (strftime "%s"
+                                       (assq-ref start-time-and-agent
+                                                 'start-time))))))
+         (reverse
+          (datastore-find-build-starts datastore build-id)))
+
+      ,@(let ((result-details (datastore-find-build-result datastore build-id)))
+          (if result-details
+              `(((type       . build)
+                 (event      . ,(let ((result (assq-ref result-details 'result)))
+                                  (cond
+                                   ((string=? result "success") 'succeeded)
+                                   ((string=? result "failure") 'failed)
+                                   (else
+                                    (error "unknown result")))))
+                 (build_id   . ,build-id)
+                 (derivation . ,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)))))
+                         '()))))
+              '()))))
+
+  (datastore-for-each-build
+   datastore
+   (lambda (build-id)
+     (simple-format #t "~A\n" build-id)
+     (let ((events (events-for-build build-id)))
+       (send-build-events-to-guix-data-service target-url
+                                               events)))))
-- 
cgit v1.2.3