Log delays in fetch builds to allocate

1 files changed, 27 insertions, 20 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 3ed79e8..581466a 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -2673,25 +2673,28 @@ WHERE build_derivation_outputs.derivation_id = :derivation_id
       allocated_builds_derivation_outputs.output_id"
              #:cache? #t)))
 
-       (sqlite-bind-arguments
-        statement
-        #:agent_id agent-id)
-
-       (let ((builds
-              (sqlite-fold
-               (lambda (row result)
-                 (cons
-                  (match row
-                    (#f #f)
-                    (#(uuid derivation_name)
-                     `((uuid            . ,uuid)
-                       ;; TODO Switch this to derivation_name
-                       (derivation-name . ,derivation_name))))
-                  result))
-               '()
-               statement)))
-         (sqlite-reset statement)
-
+       (define (get-builds)
+         (sqlite-bind-arguments
+          statement
+          #:agent_id agent-id)
+
+         (let ((builds
+                (sqlite-fold
+                 (lambda (row result)
+                   (cons
+                    (match row
+                      (#f #f)
+                      (#(uuid derivation_name)
+                       `((uuid            . ,uuid)
+                         ;; TODO Switch this to derivation_name
+                         (derivation-name . ,derivation_name))))
+                    result))
+                 '()
+                 statement)))
+           (sqlite-reset statement)
+           builds))
+
+       (define (get-first-non-conflicting-build builds)
          (find (lambda (build-details)
                  (sqlite-bind-arguments
                   output-conflicts-statement
@@ -2706,7 +2709,11 @@ WHERE build_derivation_outputs.derivation_id = :derivation_id
                    (match result
                      (#f #t)
                      (_ #f))))
-               builds))))
+               builds))
+
+       (let ((builds (call-with-delay-logging get-builds)))
+         (call-with-delay-logging get-first-non-conflicting-build
+                                  #:args (list builds)))))
    #:readonly? #t))
 
 (define-method (datastore-insert-to-allocated-builds