1 files changed, 38 insertions, 11 deletions

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 8e7dcd8..e89c719 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -55,6 +55,14 @@
       (datastore-list-builds-for-output datastore output)))
 
   (let* ((agents (datastore-list-agents datastore))
+         (requested-systems-by-agent
+          (map (lambda (agent-details)
+                 (let ((agent-id (assq-ref agent-details 'uuid)))
+                   (cons agent-id
+                         (datastore-agent-requested-systems
+                          datastore
+                          agent-id))))
+               agents))
          (builds (datastore-list-unprocessed-builds datastore))
          (setup-failures-hash
           (datastore-fetch-setup-failures datastore))
@@ -74,7 +82,21 @@
          (build-ordering-hints-hash
           (make-hash-table)))
 
+    (define systems-for-builds
+      ;; TODO Should be one query
+      (map (lambda (build)
+             (let ((build-id (assq-ref build 'uuid)))
+               (cons build-id
+                     (datastore-find-build-derivation-system
+                      datastore
+                      build-id))))
+           builds))
+
     (define (filter-builds-for-agent agent-id)
+      (define requested-systems
+        (assoc-ref requested-systems-by-agent
+                   agent-id))
+
       (define (relevant-setup-failure? setup-failure)
         (log "setup failure:" setup-failure)
         (let ((failure-reason
@@ -99,17 +121,22 @@
 
       (lambda (build)
         (log "build:" (assq-ref build 'uuid))
-        (let* ((build-id (assq-ref build 'uuid))
-               (setup-failures-for-build
-                (or (hash-ref setup-failures-hash build-id)
-                    '()))
-               (relevant-setup-failures
-                (filter relevant-setup-failure?
-                        setup-failures-for-build)))
-          (log "relevant setup failures:" relevant-setup-failures)
-          (if (null? relevant-setup-failures)
-              #t
-              #f))))
+        (and
+         (or (null? requested-systems)
+             (let ((build-system (assoc-ref systems-for-builds
+                                            (assq-ref build 'uuid))))
+               (member build-system requested-systems)))
+         (let* ((build-id (assq-ref build 'uuid))
+                (setup-failures-for-build
+                 (or (hash-ref setup-failures-hash build-id)
+                     '()))
+                (relevant-setup-failures
+                 (filter relevant-setup-failure?
+                         setup-failures-for-build)))
+           (log "relevant setup failures:" relevant-setup-failures)
+           (if (null? relevant-setup-failures)
+               #t
+               #f)))))
 
     (define (build-sorting-function-for-agent agent-id)
       (lambda (a b)