Change how triggering build allocations works

Associate this with the coordinator, rather than having the logic in the agent
communication code.

3 files changed, 22 insertions, 19 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index b5cd478..d22cf5c 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -78,8 +78,7 @@ if there was no request body."
 
 (define (http-agent-messaging-start-server port host secret-key-base
                                            build-coordinator
-                                           chunked-request-channel
-                                           trigger-build-allocation)
+                                           chunked-request-channel)
   (define update-base-datastore-metrics!
     (base-datastore-metrics-updater build-coordinator))
 
@@ -99,7 +98,6 @@ if there was no request body."
                            body
                            secret-key-base
                            build-coordinator
-                           trigger-build-allocation
                            chunked-request-channel
                            update-base-datastore-metrics!)))
       #:host host
@@ -215,7 +213,6 @@ port. Also, the port used can be changed by passing the --port option.\n"
                     body
                     secret-key-base
                     build-coordinator
-                    trigger-build-allocation
                     chunked-request-channel
                     update-base-datastore-metrics!)
   (define (authenticated? uuid request)
@@ -278,7 +275,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
                                     (json-string->scm (utf8->string body)))
                ;; Trigger build allocation, as the result of this build
                ;; could change the allocation
-               (trigger-build-allocation)
+               (trigger-build-allocation build-coordinator)
                (render-json
                 "message received"))
              (render-json
@@ -295,7 +292,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
                 (json-string->scm (utf8->string body)))
                ;; Trigger build allocation, so that the allocator can handle
                ;; this setup failure
-               (trigger-build-allocation)
+               (trigger-build-allocation build-coordinator)
                (render-json
                 "message received"))
              (render-json
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 5b57823..f0987a4 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -47,7 +47,7 @@
             new-agent-password
             fetch-builds
             agent-details
-            make-build-allocator-thread
+            trigger-build-allocation
             start-hook-processing-thread
 
             build-output-file-location
@@ -62,23 +62,29 @@
   (datastore            build-coordinator-datastore)
   (hooks                build-coordinator-hooks)
   (metrics-registry     build-coordinator-metrics-registry)
-  (allocation-strategy  build-coordinator-allocation-strategy))
+  (allocation-strategy  build-coordinator-allocation-strategy)
+  (allocator-thread     build-coordinator-allocator-thread
+                        set-build-coordinator-allocator-thread!))
 
 (define* (make-build-coordinator #:key datastore hooks
                                  (metrics-registry (make-metrics-registry))
                                  (allocation-strategy
                                   basic-build-allocation-strategy))
-  (make-build-coordinator-record
-   datastore
-   hooks
-   metrics-registry
-   allocation-strategy))
+  (let ((build-coordinator
+         (make-build-coordinator-record datastore
+                                        hooks
+                                        metrics-registry
+                                        allocation-strategy)))
+    (set-build-coordinator-allocator-thread!
+     build-coordinator
+     (make-build-allocator-thread build-coordinator))
+
+    build-coordinator))
 
 (define* (submit-build build-coordinator derivation
                        #:key
                        requested-uuid
                        (priority 0)
-                       (defer-allocation? #f)
                        (ensure-all-related-derivation-outputs-have-builds? #f))
   (let ((datastore (build-coordinator-datastore build-coordinator))
         (uuid (or requested-uuid (random-v4-uuid))))
@@ -136,6 +142,9 @@
                                   password)
     password))
 
+(define (trigger-build-allocation build-coordinator)
+  ((build-coordinator-allocator-thread build-coordinator)))
+
 (define (allocate-builds build-coordinator)
   (define datastore
     (build-coordinator-datastore build-coordinator))
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index c7267e9..41f1ff3 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -426,9 +426,7 @@ processed?:      ~A
                    ;; restore original C handler.
                    (sigaction SIGINT #f))))))
 
-       (let* ((trigger-build-allocation
-               (make-build-allocator-thread build-coordinator))
-              (agent-communication-thunk
+       (let* ((agent-communication-thunk
                (let ((agent-communication-uri
                       (string->uri (assq-ref opts 'agent-communication))))
                  (match (uri-scheme agent-communication-uri)
@@ -448,8 +446,7 @@ processed?:      ~A
                          host
                          (assq-ref opts 'secret-key-base)
                          build-coordinator
-                         chunked-request-channel
-                         trigger-build-allocation))))))))
+                         chunked-request-channel)))))))
 
          (start-hook-processing-thread build-coordinator)
          (trigger-build-allocation build-coordinator)