From c0540457692e87fc8752a82bdaca9ce8167914db Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 21 Apr 2023 16:19:24 +0100
Subject: Deallocate canceled builds from agents when they startup

---
 guix-build-coordinator/agent-messaging/http.scm    |  6 ++++-
 .../agent-messaging/http/server.scm                |  8 +++++--
 guix-build-coordinator/agent.scm                   |  1 +
 guix-build-coordinator/coordinator.scm             | 27 ++++++++++++++++++----
 4 files changed, 35 insertions(+), 7 deletions(-)

(limited to 'guix-build-coordinator')

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 8e01cb9..6e8490c 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -255,7 +255,8 @@
                 .
                 args)
   (apply
-   (lambda* (status #:key 1min-load-average (log default-log))
+   (lambda* (status #:key 1min-load-average (log default-log)
+                    initial-status-update?)
      (coordinator-http-request
       log
       interface
@@ -266,6 +267,9 @@
                ,@(if 1min-load-average
                      `((load_average
                         . (("1" . ,1min-load-average))))
+                     '())
+               ,@(if initial-status-update?
+                     `((initial_status_update . #t))
                      '()))))
    args))
 
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 3de5c69..0f3faac 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -254,11 +254,15 @@ port. Also, the port used can be changed by passing the --port option.\n"
                     (1min-load-average (and=> (assoc-ref json-body "load_average")
                                               (lambda (load-average)
                                                 (assoc-ref load-average "1"))))
-                    (processor-count (assoc-ref json-body "processor_count")))
+                    (processor-count (assoc-ref json-body "processor_count"))
+                    (initial-status-update
+                     (eq? #t (assoc-ref json-body "initial_status_update"))))
 
                (update-agent-status build-coordinator uuid
                                     status 1min-load-average
-                                    processor-count))
+                                    processor-count
+                                    #:initial-status-update?
+                                    initial-status-update))
 
              (render-json
               (agent-details build-coordinator uuid)))
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index fc0ed3f..2d54844 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -486,6 +486,7 @@
                                   'idle
                                   #:1min-load-average
                                   (get-load-average #:period 1)
+                                  #:initial-status-update? #t
                                   #:log (build-log-procedure lgr))))
       (for-each
        (lambda (job-args)
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index d7bc605..b8a93d4 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -825,11 +825,30 @@
                               active?)
   (trigger-build-allocation coordinator))
 
-(define (update-agent-status coordinator agent-uuid
-                             status 1min-load-average
-                             processor-count)
+(define* (update-agent-status coordinator agent-uuid
+                              status 1min-load-average
+                              processor-count
+                              #:key initial-status-update?)
+  (define datastore
+    (build-coordinator-datastore coordinator))
+
+  (when initial-status-update?
+    (datastore-call-with-transaction
+     datastore
+     (lambda _
+       (for-each
+        (lambda (build)
+          (when (assq-ref build 'canceled)
+            (datastore-remove-build-allocation
+             datastore
+             (assq-ref build 'uuid)
+             agent-uuid)))
+        (datastore-list-agent-builds
+         datastore
+         agent-uuid)))))
+
   (datastore-update-agent-status
-   (build-coordinator-datastore coordinator)
+   datastore
    agent-uuid
    status
    1min-load-average
-- 
cgit v1.2.3