Skip updating other build priorities for some builds

The builds submitted to ensure all related derivation outputs have builds.

Submitting these builds won't cause the priority of any related builds to be
updated, since they have a priority of 0, so this expensive part of submitting
the builds can be skipped.

1 files changed, 49 insertions, 33 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 9e8de44..d900224 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -3566,9 +3566,9 @@ INSERT INTO derivation_outputs (derivation_id, name, output_id)
 
 (define-method (datastore-insert-build
                 (datastore <sqlite-datastore>)
-                uuid derivation-name priority
-                defer-until)
-  (define (insert-build db)
+                .
+                rest)
+  (define (insert-build db drv-name uuid priority defer-until)
     (let ((statement
            (sqlite-prepare
             db
@@ -3580,7 +3580,7 @@ VALUES (:uuid, :derivation_id, :priority, datetime('now'), :deferred_until)"
       (sqlite-bind-arguments
        statement
        #:uuid uuid
-       #:derivation_id (db-find-derivation-id db derivation-name)
+       #:derivation_id (db-find-derivation-id db drv-name)
        #:priority priority
        #:deferred_until
        (and=> defer-until
@@ -3723,36 +3723,52 @@ SET derived_priority = :derived_priority
 WHERE build_id = :build_id"
             #:cache? #t)))
 
-      (sqlite-fold
-       (lambda (row result)
-         (match row
-           (#(id)
-            (sqlite-bind-arguments update-derived-priority-statement
-                                   #:build_id id
-                                   #:derived_priority derived-priority)
-            (sqlite-step update-derived-priority-statement)
-            (sqlite-reset update-derived-priority-statement)))
-         #f)
-       #f
-       find-builds-statement)
-      (sqlite-reset find-builds-statement)))
+      (let ((builds-to-update
+             (call-with-delay-logging
+              (lambda ()
+                (sqlite-map (lambda (row)
+                              (vector-ref row 0))
+                            find-builds-statement)))))
+        (sqlite-reset find-builds-statement)
+
+        (map (lambda (id)
+               (sqlite-bind-arguments update-derived-priority-statement
+                                      #:build_id id
+                                      #:derived_priority derived-priority)
+               (sqlite-step update-derived-priority-statement)
+               (sqlite-reset update-derived-priority-statement))
+             builds-to-update))))
 
-  (call-with-worker-thread/delay-logging
-   (slot-ref datastore 'worker-writer-thread-channel)
-   (lambda (db)
-     (let* ((build-id          (insert-build db))
-            (derived-priority  (or (get-derived-priority db build-id)
-                                   priority))
-            (all-inputs-built? (all-inputs-built? db build-id)))
-
-       (insert-unprocessed-builds-with-derived-priorities-entry db
-                                                                build-id
-                                                                derived-priority
-                                                                all-inputs-built?)
-       (unless all-inputs-built?
-         (update-unprocessed-builds-with-derived-priorities db
-                                                            build-id
-                                                            derived-priority)))))
+  (apply
+   (lambda* (uuid drv-name priority defer-until
+                  #:key skip-updating-other-build-derived-priorities)
+
+     (call-with-worker-thread/delay-logging
+      (slot-ref datastore 'worker-writer-thread-channel)
+      (lambda (db)
+        (let* ((build-id          (insert-build db drv-name uuid priority
+                                                defer-until))
+               (derived-priority  (or (call-with-delay-logging
+                                       get-derived-priority
+                                       #:args (list db build-id))
+                                      priority))
+               (all-inputs-built? (all-inputs-built? db build-id)))
+
+          (insert-unprocessed-builds-with-derived-priorities-entry
+           db
+           build-id
+           derived-priority
+           all-inputs-built?)
+
+          (unless (or all-inputs-built?
+                      skip-updating-other-build-derived-priorities)
+            (call-with-delay-logging
+             update-unprocessed-builds-with-derived-priorities
+             #:args
+             (list db
+                   build-id
+                   derived-priority)))))))
+   rest)
   #t)
 
 (define (insert-agent db uuid name description)