Get the state to use with events from the database

I was thinking of storing/maintaining this in memory, but that's not great as
there's a high chance that some coding issue means it will diverge from the
database.

Instead, pull the state from the database, and try to return it with an
appropriate state_id value.

I'm not sure I've got this exactly right, maybe some of the event stuff will
need bringing in to the transactions in the coordinator, but this should be OK
to start off with.

2 files changed, 45 insertions, 11 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 698a62e..5d443d8 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -493,6 +493,24 @@
                          '()))
                  #:threshold 10)))
            (render-json submit-build-result))))
+      (('GET "state")
+       ;; Use a write transaction here to get a snapshot of the state plus the
+       ;; state-id
+       (render-json
+        (datastore-call-with-transaction
+         datastore
+         (lambda (_)
+           `((state_id . ,(build-coordinator-get-state-id build-coordinator))
+             (agents   . ,(list->vector
+                           (map
+                            (lambda (agent-details)
+                              `(,@agent-details
+                                (builds
+                                 . ,(list->vector
+                                     (datastore-list-agent-builds
+                                      datastore
+                                      (assq-ref agent-details 'uuid))))))
+                            (datastore-list-agents datastore)))))))))
       (('GET "events")
        (list (build-response
               #:code 200
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 9cd3f2d..189f148 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -24,6 +24,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
@@ -62,6 +63,7 @@
             build-coordinator-logger
 
             build-coordinator-listen-for-events
+            build-coordinator-get-state-id
 
             %known-hooks
 
@@ -108,7 +110,9 @@
                         set-build-coordinator-allocator-thread!)
   (logger               build-coordinator-logger)
   (events-channel       build-coordinator-events-channel
-                        set-build-coordinator-events-channel!))
+                        set-build-coordinator-events-channel!)
+  (get-state-id         build-coordinator-get-state-id-proc
+                        set-build-coordinator-get-state-id-proc!))
 
 (define %known-hooks
   '(build-submitted
@@ -123,17 +127,18 @@
   (let* ((submission-channel (make-channel))
          (listener-channels-box (make-atomic-box vlist-null))
 
-         (state
-          (make-atomic-box
-           `((agents . ,(list->vector
-                         (datastore-list-agents datastore))))))
-
          (buffer-size 10000)
          (event-buffer (make-vector buffer-size))
 
          (current-state-id-and-event-buffer-index-box
           (make-atomic-box (cons 0 -1))))
 
+    (define (get-state-id)
+      (match (atomic-box-ref
+              current-state-id-and-event-buffer-index-box)
+        ((current-state-id . event-buffer-index)
+         current-state-id)))
+
     (define (spawn-fiber-for-listener callback
                                       after-state-id
                                       submission-channel
@@ -248,7 +253,8 @@
              #f
              (atomic-box-ref listener-channels-box)))))))
 
-    submission-channel))
+    (values submission-channel
+            get-state-id)))
 
 (define (build-coordinator-send-event build-coordinator . args)
   (spawn-fiber
@@ -272,6 +278,9 @@
     ;; shouldn't exit until callback has finished being called
     (get-message listening-finished-channel)))
 
+(define (build-coordinator-get-state-id build-coordinator)
+  ((build-coordinator-get-state-id-proc build-coordinator)))
+
 (define* (make-build-coordinator #:key datastore hooks
                                  (metrics-registry (make-metrics-registry
                                                     #:namespace
@@ -424,10 +433,17 @@
 
             (spawn-fiber-to-watch-for-deferred-builds build-coordinator)
 
-            (set-build-coordinator-events-channel!
-             build-coordinator
-             (make-events-channel
-              (build-coordinator-datastore build-coordinator)))
+            (let ((events-channel
+                   get-state-id
+                   (make-events-channel
+                    (build-coordinator-datastore build-coordinator))))
+
+              (set-build-coordinator-events-channel!
+               build-coordinator
+               events-channel)
+              (set-build-coordinator-get-state-id-proc!
+               build-coordinator
+               get-state-id))
 
             ;; Start the agent messaging server
             (match (uri-scheme agent-communication-uri)