Don't allocate builds to agents where the setup previously failed

1 files changed, 30 insertions, 9 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index b016744..82f983c 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -82,19 +82,40 @@
 
 (define (allocate-builds datastore)
   (let ((agents (datastore-list-agents datastore))
-        (builds (datastore-list-unprocessed-builds datastore)))
+        (builds (datastore-list-unprocessed-builds datastore))
+        (setup-failures
+         (datastore-fetch-setup-failures datastore)))
+
+    (define (filter-builds-for-agent agent-id)
+      (lambda (build)
+        (let* ((build-id (assq-ref build 'uuid))
+               (setup-failures-for-build
+                (or (assoc-ref setup-failures build-id)
+                    '())))
+          (if (any (lambda (setup-failure)
+                     (string=? (assq-ref setup-failure 'agent-id)
+                               agent-id))
+                   setup-failures-for-build)
+              ;; Don't allocated builds to agents where the setup has failed
+              ;; in the past
+              #f
+              #t))))
+
     (datastore-replace-build-allocation-plan
      datastore
      (append-map
       (lambda (agent-id)
-        (map (lambda (build-id ordering)
-               (list build-id
-                     agent-id
-                     ordering))
-             (map (lambda (build)
-                    (assq-ref build 'uuid))
-                  builds)
-             (iota (length builds))))
+        (let ((builds-for-agent
+               (filter (filter-builds-for-agent agent-id)
+                       builds)))
+          (map (lambda (build-id ordering)
+                 (list build-id
+                       agent-id
+                       ordering))
+               (map (lambda (build)
+                      (assq-ref build 'uuid))
+                    builds-for-agent)
+               (iota (length builds-for-agent)))))
       (map (lambda (agent)
              (assq-ref agent 'uuid))
            agents))))