Add new send-events-for-selected-builds procedure

Which is helpful when backfilling data in the data service.

1 files changed, 73 insertions, 49 deletions

diff --git a/guix-build-coordinator/guix-data-service.scm b/guix-build-coordinator/guix-data-service.scm
index 20dc8c4..bb3587c 100644
--- a/guix-build-coordinator/guix-data-service.scm
+++ b/guix-build-coordinator/guix-data-service.scm
@@ -19,6 +19,7 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (guix-build-coordinator guix-data-service)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 exceptions)
@@ -30,7 +31,8 @@
   #:use-module (guix-build-coordinator datastore)
   #:export (send-build-event-to-guix-data-service
 
-            send-events-for-all-builds))
+            send-events-for-all-builds
+            send-events-for-selected-builds))
 
 (define (send-build-event-to-guix-data-service target-url event)
   (send-build-events-to-guix-data-service target-url
@@ -60,62 +62,84 @@
                        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 (events-for-build datastore build-details)
+  (define build-id
+    (assq-ref build-details 'uuid))
 
-    (define derivation-name
-      (assq-ref build-details 'derivation-name))
+  (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)))))
-               '())))
+  `(((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)))
+    ,@(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)))))
-                         '()))))
-              '()))))
+    ,@(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)))))
+                       '()))))
+            '()))))
 
+(define (send-events-for-all-builds datastore target-url)
   (datastore-for-each-build
    datastore
    (lambda (build-id)
      (simple-format #t "~A\n" build-id)
-     (let ((events (events-for-build build-id)))
+     (let ((events
+            (events-for-build
+             datastore
+             (datastore-find-build datastore build-id))))
        (send-build-events-to-guix-data-service target-url
                                                events)))))
+
+(define (send-events-for-selected-builds datastore target-url . criteria)
+  (let ((all-build-details
+         (apply
+          datastore-fold-builds
+          datastore
+          cons
+          '()
+          criteria)))
+
+    (fold
+     (lambda (build-details result)
+       (simple-format #t "~A\n" (assq-ref build-details 'uuid))
+       (let ((events (events-for-build datastore build-details)))
+         (send-build-events-to-guix-data-service target-url
+                                                 events))
+       (+ 1 result))
+     0
+     all-build-details)))