Improve handling of submitting builds

Don't always substitute the derivation, just fetch it if it doesn't exist in
the database. Also just use the name of the derivation, only read it from the
disk when it needs storing in the database.

4 files changed, 52 insertions, 20 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 2360631..ae4a8c5 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -154,17 +154,23 @@
           `((new-password . ,password)))))
       (('POST "builds")
        (let ((derivation-file (assoc-ref body "derivation")))
-         (unless (file-exists? derivation-file)
-           (substitute-derivation derivation-file
-                                  #:substitute-urls
-                                  (vector->list
-                                   (assoc-ref body "substitute-urls"))))
+         (let ((derivation-database-entry
+                (datastore-find-derivation datastore derivation-file)))
+           (unless derivation-database-entry
+             (unless (file-exists? derivation-file)
+               (substitute-derivation derivation-file
+                                      #:substitute-urls
+                                      (vector->list
+                                       (assoc-ref body "substitute-urls"))))
+             (datastore-store-derivation
+              datastore
+              (read-derivation-from-file derivation-file))))
 
          (let ((submit-build-result
                 (apply
                  submit-build
                  `(,build-coordinator
-                   ,(read-derivation-from-file derivation-file)
+                   ,derivation-file
                    ,@(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 9815565..e8d9c22 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -81,7 +81,7 @@
 
     build-coordinator))
 
-(define* (submit-build build-coordinator derivation
+(define* (submit-build build-coordinator derivation-file
                        #:key
                        requested-uuid
                        (priority 0)
@@ -94,19 +94,18 @@
     (not
      (null? (datastore-list-builds-for-derivation
              datastore
-             (derivation-file-name derivation)))))
+             derivation-file))))
 
   (define (build-for-output-already-exists?)
     (any
-     (match-lambda
-       ((name . derivation-output)
-        (let ((builds-for-output
-               (datastore-list-builds-for-output
-                datastore
-                (derivation-output-path derivation-output))))
+     (lambda (output-details)
+       (let ((builds-for-output
+              (datastore-list-builds-for-output
+               datastore
+               (assq-ref output-details 'output))))
 
-          (not (null? builds-for-output)))))
-     (derivation-outputs derivation)))
+         (not (null? builds-for-output))))
+     (datastore-find-derivation-outputs datastore derivation-file)))
 
   (if (and ignore-if-build-for-derivation-exists?
            (build-for-derivation-exists?))
@@ -117,13 +116,11 @@
 
           ;; Actually create a build
           (let ((uuid (or requested-uuid (random-v4-uuid))))
-            (datastore-store-derivation datastore derivation)
-
             (when ensure-all-related-derivation-outputs-have-builds?
               (let ((derivations-lacking-builds
                      (datastore-list-related-derivations-with-no-build-for-outputs
                       datastore
-                      (derivation-file-name derivation))))
+                      derivation-file)))
                 (for-each
                  (lambda (related-derivation)
                    (let ((related-uuid (random-v4-uuid)))
@@ -139,7 +136,7 @@
                  derivations-lacking-builds)))
 
             (datastore-store-build datastore
-                                   (derivation-file-name derivation)
+                                   derivation-file
                                    uuid
                                    priority)
 
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index f17a0fb..8b689a5 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -38,6 +38,7 @@
 (re-export datastore-list-unprocessed-hook-events)
 (re-export datastore-delete-unprocessed-hook-event)
 (re-export datastore-list-agent-builds)
+(re-export datastore-find-derivation)
 (re-export datastore-find-derivation-outputs)
 (re-export datastore-find-derivation-system)
 (re-export datastore-find-derivation-inputs)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 7f06b89..b566180 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -31,6 +31,7 @@
             datastore-store-setup-failure
             datastore-store-setup-failure/missing-inputs
             datastore-list-setup-failure-missing-inputs
+            datastore-find-derivation
             datastore-find-derivation-system
             datastore-find-derivation-inputs
             datastore-find-derivation-outputs
@@ -1368,6 +1369,33 @@ SELECT name, id FROM derivation_outputs WHERE derivation_name = :derivation_name
 
       outputs)))
 
+(define-method (datastore-find-derivation
+                (datastore <sqlite-datastore>)
+                name)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT system
+FROM derivations
+WHERE name = :name")))
+
+       (sqlite-bind-arguments
+        statement
+        #:name name)
+
+       (let ((result
+              (match (sqlite-step statement)
+                (#f #f)
+                (#(system)
+                 `((system . ,system))))))
+         (sqlite-reset statement)
+
+         result)))))
+
 (define-method (datastore-find-derivation-outputs
                 (datastore <sqlite-datastore>)
                 derivation-name)