From bda7d58853ed4fba976cac92a70c4dc68db263aa Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 8 May 2020 11:50:37 +0100
Subject: Support providing different substitute URLs for different purposes

The agent looks to substitute the derivation, and also substitute inputs, so
allow providing different substitute URLs for each of these purposes. This can
make substituting faster in the case where you have a different source of
substitutes for derivations and non-derivation items.
---
 guix-build-coordinator/agent.scm        | 24 ++++++++++++++++--------
 scripts/guix-build-coordinator-agent.in | 15 ++++++++++++++-
 2 files changed, 30 insertions(+), 9 deletions(-)

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 37ef5ba..4685863 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -33,7 +33,8 @@
   #:export (run-agent))
 
 (define (run-agent uuid coordinator-uri password
-                   substitute-urls)
+                   derivation-substitute-urls
+                   non-derivation-substitute-urls)
   (while #t
     (let* ((details (submit-status coordinator-uri uuid password
                                    'idle))
@@ -52,8 +53,10 @@
                   (let ((derivation-name (assoc-ref build "derivation-name")))
                     (simple-format #t "setting up to build: ~A\n"
                                    derivation-name)
-                    (let ((pre-build-status (pre-build-process substitute-urls
-                                                               derivation-name)))
+                    (let ((pre-build-status (pre-build-process
+                                             derivation-substitute-urls
+                                             non-derivation-substitute-urls
+                                             derivation-name)))
                       (if (eq? (assq-ref pre-build-status 'result) 'success)
                           (begin
                             (simple-format #t "setup successful, building: ~A\n"
@@ -83,7 +86,9 @@
       (when (null? builds)
         (sleep 5)))))
 
-(define (pre-build-process substitute-urls derivation-name)
+(define (pre-build-process derivation-substitute-urls
+                           non-derivation-substitute-urls
+                           derivation-name)
   (define (find-missing-inputs inputs)
     (let* ((output-paths
             (append-map derivation-input-output-paths inputs))
@@ -91,11 +96,13 @@
             (remove file-exists? output-paths))
            (path-substitutes
             (with-store store
-              (set-build-options store #:substitute-urls substitute-urls)
+              (set-build-options store #:substitute-urls
+                                 non-derivation-substitute-urls)
 
               (map (lambda (file)
                      (and
-                      (has-substiutes-no-cache? substitute-urls file)
+                      (has-substiutes-no-cache? non-derivation-substitute-urls
+                                                file)
                       (if (has-substitutes? store file)
                           #t
                           (begin
@@ -119,7 +126,8 @@
                 ;; Download the substitutes
                 (with-store store
                   (set-build-options store
-                                     #:substitute-urls substitute-urls)
+                                     #:substitute-urls
+                                     non-derivation-substitute-urls)
 
                   (build-things store missing-paths))
 
@@ -160,7 +168,7 @@
                      (lambda ()
                        (substitute-derivation derivation-name
                                               #:substitute-urls
-                                              substitute-urls))
+                                              derivation-substitute-urls))
                      #:times 12
                      #:delay 20)
                     (read-derivation-from-file derivation-name)))))
diff --git a/scripts/guix-build-coordinator-agent.in b/scripts/guix-build-coordinator-agent.in
index 89bd375..d75b66c 100644
--- a/scripts/guix-build-coordinator-agent.in
+++ b/scripts/guix-build-coordinator-agent.in
@@ -46,6 +46,16 @@
         (option '("substitute-urls") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'substitute-urls
+                              (string-split arg #\space)
+                              result)))
+        (option '("derivation-substitute-urls") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'derivation-substitute-urls
+                              (string-split arg #\space)
+                              result)))
+        (option '("non-derivation-substitute-urls") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'non-derivation-substitute-urls
                               (string-split arg #\space)
                               result)))))
 
@@ -71,4 +81,7 @@
   (run-agent (assq-ref opts 'uuid)
              (assq-ref opts 'coordinator)
              (assq-ref opts 'password)
-             (assq-ref opts 'substitute-urls)))
+             (or (assq-ref opts 'derivation-substitute-urls)
+                 (assq-ref opts 'substitute-urls))
+             (or (assq-ref opts 'non-derivation-substitute-urls)
+                 (assq-ref opts 'substitute-urls))))
-- 
cgit v1.2.3