Handle the system more explicitly when fetching builds

Also support fetching builds for specific systems from the Guix Data Service.

4 files changed, 22 insertions, 6 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index e7c17aa..f7459ad 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -292,7 +292,10 @@ port. Also, the port used can be changed by passing the --port option.\n"
        (if (authenticated? uuid request)
            (let* ((json-body (json-string->scm (utf8->string body)))
                   (count (assoc-ref json-body "count"))
-                  (builds (fetch-builds build-coordinator uuid count)))
+                  (systems (assoc-ref json-body "systems"))
+                  (builds (fetch-builds build-coordinator uuid
+                                        (vector->list systems)
+                                        count)))
              (render-json
               `((builds . ,(list->vector builds)))))
            (render-json
@@ -696,11 +699,13 @@ port. Also, the port used can be changed by passing the --port option.\n"
    #:succeed-on-access-denied-retry? #t))
 
 (define* (fetch-builds-for-agent coordinator-uri agent-uuid password
+                                 systems
                                  #:key (count 1))
   (vector->list
    (assoc-ref (coordinator-http-request
                coordinator-uri agent-uuid password
                (string-append "/agent/" agent-uuid "/fetch-builds")
-               #:body `((count . ,count))
+               #:body `((count               . ,count)
+                        (systems . ,(list->vector systems)))
                #:method 'POST)
               "builds")))
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 06518ed..a5a3f7a 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -36,12 +36,14 @@
   #:export (run-agent))
 
 (define (run-agent uuid coordinator-uri password
+                   systems
                    max-parallel-builds
                    derivation-substitute-urls
                    non-derivation-substitute-urls)
   (define (fetch-new-jobs count)
     (let ((received-builds
            (fetch-builds-for-agent coordinator-uri uuid password
+                                   systems
                                    #:count count)))
       (simple-format #t "requested ~A builds, received ~A\n"
                      count (length received-builds))
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 83f1e68..f76c783 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -321,7 +321,7 @@
 
   #t)
 
-(define (fetch-builds build-coordinator agent count)
+(define (fetch-builds build-coordinator agent systems count)
   (call-with-duration-metric
    (build-coordinator-metrics-registry build-coordinator)
    "guixbuildcoordinator_coordinator_fetch_builds_duration_seconds"
@@ -329,6 +329,7 @@
      (datastore-allocate-builds-to-agent
       (build-coordinator-datastore build-coordinator)
       agent
+      systems
       count))))
 
 (define (agent-details datastore agent-id)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 2b39c51..0497bab 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -1286,20 +1286,24 @@ SELECT agent_id, COUNT(*) FROM allocated_builds GROUP BY agent_id")))
 (define-method (datastore-allocate-builds-to-agent
                 (datastore <sqlite-datastore>)
                 agent-id
+                systems
                 count)
   (define (fetch-build db)
     (let ((statement
            (sqlite-prepare
             db
             ;; This needs to guard against the plan being out of date
-            "
+            (simple-format #f "
 SELECT builds.uuid, builds.derivation_name
 FROM builds
 INNER JOIN build_allocation_plan
   ON builds.uuid = build_allocation_plan.build_id
+INNER JOIN derivations
+  ON builds.derivation_name = derivations.name
 WHERE build_allocation_plan.agent_id = :agent_id
   AND builds.processed = 0
   AND builds.uuid NOT IN (SELECT build_id FROM allocated_builds)
+  AND derivations.system IN (~A)
   AND NOT EXISTS (
     SELECT 1
     FROM derivation_outputs AS build_derivation_outputs
@@ -1315,8 +1319,12 @@ WHERE build_allocation_plan.agent_id = :agent_id
           allocated_builds_derivation_outputs.output
   )
 ORDER BY build_allocation_plan.ordering ASC
-LIMIT 1")))
-
+LIMIT 1"
+                           (string-join
+                            (map (lambda (system)
+                                   (string-append "'" system "'"))
+                                 systems)
+                            ",")))))
       (sqlite-bind-arguments
        statement
        #:agent_id agent-id)