Tweak updating derived priorities when canceling builds

Move the action in to the coordinator module, so that it happens outside of
the main write transaction.

3 files changed, 29 insertions, 36 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 85c1a03..ac871c2 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -511,6 +511,11 @@
               'build-canceled))))
 
       (when (eq? val 'build-canceled)
+        (datastore-update-unprocessed-builds-with-lower-derived-priorities
+         datastore
+         uuid
+         #f)
+
         (trigger-build-allocation build-coordinator)
 
         (build-coordinator-prompt-hook-processing-for-event build-coordinator
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index f2372b5..68c3339 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -18,6 +18,7 @@
 (re-export datastore-store-derivation)
 (re-export datastore-insert-build)
 (re-export datastore-cancel-build)
+(re-export datastore-update-unprocessed-builds-with-lower-derived-priorities)
 (re-export datastore-update-build-priority)
 (re-export datastore-new-agent)
 (re-export datastore-list-agents)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index c9d53d1..07b7aed 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -33,6 +33,7 @@
             datastore-list-builds-for-derivation-recursive-inputs
             datastore-insert-build
             datastore-cancel-build
+            datastore-update-unprocessed-builds-with-lower-derived-priorities
             datastore-update-build-priority
             datastore-count-builds
             datastore-for-each-build
@@ -1203,15 +1204,6 @@ DELETE FROM unprocessed_builds_with_derived_priorities
 
        (sqlite-step statement)
        (sqlite-reset statement))))
-
-  (update-unprocessed-builds-with-lower-derived-priorities
-   datastore
-   (call-with-worker-thread
-    (slot-ref datastore 'worker-reader-thread-channel)
-    (lambda (db)
-      (db-find-build-id db uuid)))
-   #f)
-
   #t)
 
 (define (db-get-build-priority db build-id)
@@ -1337,11 +1329,10 @@ WHERE build_id = :build_id"
              (sqlite-reset update-derived-priority-statement))
            builds-to-update))))
 
-(define (update-unprocessed-builds-with-lower-derived-priorities
+(define (datastore-update-unprocessed-builds-with-lower-derived-priorities
          datastore
-         build-id
-         priority-lower-bound)
-
+         uuid
+         explicit-priority-lower-bound)
   (define builds-to-consider
     (call-with-worker-thread/delay-logging
      (slot-ref datastore 'worker-reader-thread-channel)
@@ -1351,10 +1342,14 @@ WHERE build_id = :build_id"
        ;; compute the new derived priorities, starting with the root of the
        ;; graph (the build-id build) and working down, as each level is
        ;; dependent on the derived priorities of the level above.
-       (let ((statement
-              (sqlite-prepare
-               db
-               (string-append
+       (let* ((build-id
+               (db-find-build-id db uuid))
+              (priority-lower-bound
+               (or explicit-priority-lower-bound
+                   (get-derived-priority db build-id)))
+              (statement
+               (sqlite-prepare
+                db
                 "
 WITH RECURSIVE relevant_builds (id, level) AS (
   VALUES (:build_id, 0)
@@ -1373,30 +1368,22 @@ UNION
     ON all_derivation_outputs.output_id = unbuilt_outputs.output_id
   INNER JOIN builds
     ON builds.processed = 0
+   AND builds.canceled = 0
    AND builds.derivation_id = all_derivation_outputs.derivation_id
 )
 SELECT build_id, MAX(level)
 FROM relevant_builds
 INNER JOIN unprocessed_builds_with_derived_priorities
-  ON relevant_builds.id = unprocessed_builds_with_derived_priorities.build_id"
-                (if priority-lower-bound
-                    "
-WHERE unprocessed_builds_with_derived_priorities.derived_priority >
-      :priority"
-                    "")
-                "
+  ON relevant_builds.id = unprocessed_builds_with_derived_priorities.build_id
+WHERE unprocessed_builds_with_derived_priorities.derived_priority > :priority
 GROUP BY build_id
-ORDER BY level ASC")
-               #:cache? #t)))
+ORDER BY level ASC"
+                #:cache? #t)))
 
-         (if priority-lower-bound
-             (sqlite-bind-arguments
-              statement
-              #:build_id build-id
-              #:priority priority-lower-bound)
-             (sqlite-bind-arguments
-              statement
-              #:build_id build-id))
+         (sqlite-bind-arguments
+          statement
+          #:build_id build-id
+          #:priority priority-lower-bound)
 
          (let ((builds-to-consider
                 (call-with-delay-logging
@@ -1550,9 +1537,9 @@ WHERE build_id = :build_id"
          ;; each one, it's better to handle it afterwards.
          (when (< new-priority
                   old-priority)
-           (update-unprocessed-builds-with-lower-derived-priorities
+           (datastore-update-unprocessed-builds-with-lower-derived-priorities
             datastore
-            build-id
+            uuid
             ;; This acts as a lower bound, since builds feeding in to this
             ;; build can't have a derived priority less than new-priority
             new-priority))))