From 3de63f1f66d5f0eb157ee60bc864404f386ee2b0 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 24 May 2022 12:10:49 +0100
Subject: Support passing the build-server-id to the Guix Data Service

When querying for package derivations to build. This cuts out derivations that
have builds for that particular build server, meaning that less requests need
to be made to the coordinator.
---
 ...rdinator-queue-builds-from-guix-data-service.in | 41 ++++++++++++++++------
 1 file changed, 30 insertions(+), 11 deletions(-)

(limited to 'scripts')

diff --git a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
index 3de78fe..e7fbdb3 100644
--- a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
+++ b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
@@ -133,14 +133,19 @@
 
 (define* (package-derivations-for-commit guix-data-service
                                          commit
-                                         #:key system target)
+                                         #:key system target
+                                         guix-data-service-build-server-id)
   (let ((data (guix-data-service-request
                guix-data-service
                (string-append "/revision/" commit "/package-derivations.json")
-               `((system      . ,system)
+               (peek `((system      . ,system)
                  (target      . ,target)
                  (field       . "(no-additional-fields)")
-                 (all_results . "on")))))
+                 ,@(if guix-data-service-build-server-id
+                       `((no_build_from_build_server
+                          . ,guix-data-service-build-server-id))
+                       '())
+                 (all_results . "on"))))))
     (map (lambda (entry)
            (assoc-ref entry "derivation"))
          (vector->list
@@ -186,7 +191,8 @@
                                      systems-and-targets
                                      priority-for-derivation
                                      #:key (submit-builds-for-channel-instances?
-                                            #t))
+                                            #t)
+                                     guix-data-service-build-server-id)
   (log-msg 'INFO "looking at revision " commit)
   (par-for-each
    (match-lambda
@@ -220,7 +226,9 @@
               (package-derivations-for-commit guix-data-service
                                               commit
                                               #:system system
-                                              #:target target))))
+                                              #:target target
+                                              #:guix-data-service-build-server-id
+                                              guix-data-service-build-server-id))))
 
         (log-msg 'INFO "submitting package builds for "
                  system "=>" target " (" commit ")")
@@ -271,6 +279,12 @@
                   (alist-cons 'guix-data-service
                               arg
                               (alist-delete 'guix-data-service result))))
+        (option '("guix-data-service-build-server-id") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'guix-data-service-build-server-id
+                              arg
+                              (alist-delete 'guix-data-service-build-server-id
+                                            result))))
         (option '("threads") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'threads
@@ -357,11 +371,14 @@
     (let ((arguments (or (assq-ref opts 'arguments) '())))
       (unless (null? arguments)
         (for-each (lambda (commit)
-                    (submit-builds-for-revision (assq-ref opts 'coordinator)
-                                                guix-data-service
-                                                commit
-                                                systems-and-targets
-                                                priority-for-derivation))
+                    (submit-builds-for-revision
+                     (assq-ref opts 'coordinator)
+                     guix-data-service
+                     commit
+                     systems-and-targets
+                     priority-for-derivation
+                     #:guix-data-service-build-server-id
+                     (assq-ref opts 'guix-data-service-build-server-id)))
                   arguments)
         (exit 0)))
 
@@ -391,7 +408,9 @@
               systems-and-targets
               priority-for-derivation
               #:submit-builds-for-channel-instances?
-              (assq-ref opts 'fetch-channel-instance-derivations))
+              (assq-ref opts 'fetch-channel-instance-derivations)
+              #:guix-data-service-build-server-id
+              (assq-ref opts 'guix-data-service-build-server-id))
              (record-revision-as-processed processed-commits-file commit)))))
 
       (while #t
-- 
cgit v1.2.3