Trigger build allocations when necessary for deferred builds

1 files changed, 39 insertions, 0 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index d7def51..72b91ae 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -67,6 +67,7 @@
             datastore-replace-agent-tags
             datastore-list-processed-builds
             datastore-list-unprocessed-builds
+            datastore-find-first-unallocated-deferred-build
             datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds
             datastore-insert-unprocessed-hook-event
             datastore-count-unprocessed-hook-events
@@ -1869,6 +1870,44 @@ ORDER BY priority DESC"
 
          builds)))))
 
+(define-method (datastore-find-first-unallocated-deferred-build
+                (datastore <sqlite-datastore>))
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT uuid, derivation_name, priority, created_at, deferred_until
+FROM builds
+WHERE processed = 0
+  AND canceled = 0
+  AND deferred_until IS NOT NULL
+  AND uuid NOT IN (SELECT build_id FROM build_allocation_plan)
+ORDER BY deferred_until ASC
+LIMIT 1"
+             #:cache? #t)))
+
+       (let ((result
+              (match (sqlite-step statement)
+                (#(uuid derivation_name priority created_at deferred_until)
+                 `((uuid            . ,uuid)
+                   (derivation-name . ,derivation_name)
+                   (priority        . ,priority)
+                   (created-at      . ,(if (string? created_at)
+                                           (string->date created_at
+                                                         "~Y-~m-~d ~H:~M:~S")
+                                           #f))
+                   (deferred-until . ,(if (string? deferred_until)
+                                          (string->date deferred_until
+                                                        "~Y-~m-~d ~H:~M:~S")
+                                          #f))))
+                (#f #f))))
+         (sqlite-reset statement)
+
+         result)))))
+
 (define-method (datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds
                 (datastore <sqlite-datastore>)
                 created-after)