From ed3c806ab83c77c1b8f04bb399c66743f1858178 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 15 May 2022 22:35:24 +0100
Subject: Avoid substituting derivations when builds are submitted

When the derivation substitute URLs are known. This avoids having to add the
derivation to the store, which can be blocked by garbage collection.
---
 guix-build-coordinator/client-communication.scm | 35 ++++++++++++++-----------
 guix-build-coordinator/coordinator.scm          |  9 ++++---
 2 files changed, 25 insertions(+), 19 deletions(-)

(limited to 'guix-build-coordinator')

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index fec53e3..27f98ff 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -377,33 +377,38 @@
                                 (string->number val)))
                        1000)))))))))
       (('POST "builds")
-       (let ((derivation-file (assoc-ref body "derivation")))
+       (let ((derivation-file (assoc-ref body "derivation"))
+             (substitute-urls
+              (and=> (assoc-ref body "substitute-urls")
+                     vector->list)))
          (unless (string? derivation-file)
            (raise-exception
             (make-exception-with-message
              (simple-format #f "derivation must be a string: ~A\n"
                             derivation))))
 
-         (let ((derivation-database-entry
-                (datastore-find-derivation datastore derivation-file)))
-           (unless derivation-database-entry
-             (unless (with-store store
-                       (valid-path? store derivation-file))
-               (call-with-worker-thread
-                substitutes-channel
-                (lambda ()
-                  (let ((raw-substitute-urls
-                         (assoc-ref body "substitute-urls")))
-                    (substitute-derivation derivation-file
-                                           #:substitute-urls
-                                           (and=> raw-substitute-urls
-                                                  vector->list))))))))
+         (define (read-drv/substitute derivation-file)
+           (unless (with-store store
+                     (valid-path? store derivation-file))
+             (call-with-worker-thread
+              substitutes-channel
+              (lambda ()
+                (substitute-derivation derivation-file
+                                       #:substitute-urls substitute-urls)))
+             (read-derivation-from-file derivation-file)))
 
          (let ((submit-build-result
                 (apply
                  submit-build
                  `(,build-coordinator
                    ,derivation-file
+                   #:read-drv
+                   ,(if (null? (or substitute-urls '()))
+                        read-drv/substitute
+                        (lambda (derivation-file)
+                          (read-derivation-through-substitutes
+                           derivation-file
+                           substitute-urls)))
                    ,@(let ((priority (assoc-ref body "priority")))
                        (if priority
                            `(#:priority ,priority)
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 05c5772..62833df 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -292,7 +292,8 @@
                        (ignore-if-build-for-outputs-exists? #f)
                        (ensure-all-related-derivation-outputs-have-builds? #f)
                        (tags '())
-                       defer-until)
+                       defer-until
+                       (read-drv read-derivation-from-file))
   (define datastore (build-coordinator-datastore build-coordinator))
 
   (define (build-for-derivation-exists?)
@@ -308,7 +309,7 @@
     (let ((system (or (datastore-find-derivation-system datastore
                                                         derivation-file)
                       (derivation-system
-                       (read-derivation-from-file derivation-file))))
+                       (read-drv derivation-file))))
           (outputs (or (datastore-find-derivation-outputs datastore
                                                           derivation-file)
                        (map
@@ -317,7 +318,7 @@
                            `((name . ,name)
                              (output . ,(derivation-output-path output)))))
                         (derivation-outputs
-                         (read-derivation-from-file derivation-file))))))
+                         (read-drv derivation-file))))))
       (any
        (lambda (output-details)
          (let ((builds-for-output
@@ -408,7 +409,7 @@
                (unless (datastore-find-derivation datastore derivation-file)
                  (datastore-store-derivation
                   datastore
-                  (read-derivation-from-file derivation-file)))
+                  (read-drv derivation-file)))
 
                (let ((related-derivations-lacking-builds
                       (if ensure-all-related-derivation-outputs-have-builds?
-- 
cgit v1.2.3