Implement deferring builds

This isn't intended as some time based scheduling, but more as a way to slow
down builds by deferring processing them until some point in the future.

I'm intending to use this to test fixed output derivations. I can look up all
the derivations I want to test, then defer the builds to run spread out across
some period. This feature saves having to submit the builds gradually.

1 files changed, 24 insertions, 6 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 2988de3..fac7bbf 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -1,6 +1,7 @@
 (define-module (guix-build-coordinator datastore sqlite)
   #:use-module (oop goops)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
@@ -289,9 +290,11 @@
               (or (metrics-registry-fetch-metric registry metric-name)
                   (make-histogram-metric registry
                                          metric-name)))
-             (start-time (current-time)))
+             (start-time (get-internal-real-time)))
         (let ((result (thunk)))
-          (metric-observe metric (- (current-time) start-time))
+          (metric-observe metric
+                          (/ (- (get-internal-real-time) start-time)
+                             internal-time-units-per-second))
           result))
       (thunk)))
 
@@ -1675,6 +1678,11 @@ SELECT uuid, derivation_name, priority
 FROM builds
 WHERE processed = 0
   AND canceled = 0
+  AND (
+    deferred_until IS NULL
+    OR
+    deferred_until < datetime('now')
+  )
 ORDER BY priority DESC"
              #:cache? #t)))
 
@@ -1708,6 +1716,11 @@ SELECT uuid
 FROM builds
 WHERE processed = 0
   AND canceled = 0
+  AND (
+    deferred_until IS NULL
+    OR
+    deferred_until < datetime('now')
+  )
 "
              (if created-after
                  (simple-format
@@ -2856,7 +2869,8 @@ INSERT INTO derivation_outputs (derivation_name, name, output) VALUES "
 
 (define-method (datastore-insert-build
                 (datastore <sqlite-datastore>)
-                uuid derivation-name priority)
+                uuid derivation-name priority
+                defer-until)
   (call-with-worker-thread
    (slot-ref datastore 'worker-writer-thread-channel)
    (lambda (db)
@@ -2864,15 +2878,19 @@ INSERT INTO derivation_outputs (derivation_name, name, output) VALUES "
             (sqlite-prepare
              db
              "
-INSERT INTO builds (uuid, derivation_name, priority, created_at)
-VALUES (:uuid, :derivation_name, :priority, datetime('now'))"
+INSERT INTO builds (uuid, derivation_name, priority, created_at, deferred_until)
+VALUES (:uuid, :derivation_name, :priority, datetime('now'), :deferred_until)"
              #:cache? #t)))
 
        (sqlite-bind-arguments
         statement
         #:uuid uuid
         #:derivation_name derivation-name
-        #:priority priority)
+        #:priority priority
+        #:deferred_until
+        (and=> defer-until
+               (lambda (date)
+                 (date->string date "~1 ~3"))))
 
        (sqlite-step statement)
        (sqlite-reset statement))))