Limit builds insertion queries.

Once the evaluation is over, the new builds are registered. This registration
tries to insert a new build for each derivation returned by the evaluation
phase. If the new build does not add a new output, the insertion query is then
rollbacked. This means that there are at least as many insertion queries as
new derivations.

SQlite allows at most one writer at a time, and even though we are using WAL
mode, performing a lot of insertions will reduce the reading perforances.
When multiple evaluations are performed in parallel, the large number of
concurrent insertion queries also causes contention.

To avoid those issues, check first in the "Outputs" table which derivations
are already registered. This means that most of the insertion queries will be
replaced by reading queries, that are much less expensive and more suitable
for Cuirass concurrent implementation.

* src/cuirass/base.scm (new-outputs?): New procedure.
(build-packages): Use it to insert only builds registering new outputs.

1 files changed, 29 insertions, 17 deletions

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index bce151a..9b9d89f 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -694,6 +694,17 @@ by PRODUCT-SPECS."
                                           (#:path . ,product))))))
             product-specs))
 
+(define (new-outputs? outputs)
+  "Return #t if OUTPUTS contains at least one unregistered output and #f
+otherwise."
+  (let ((new-outputs
+         (filter-map (match-lambda
+                       ((name . path)
+                        (let ((drv (db-get-output path)))
+                          (and (not drv) path))))
+                     outputs)))
+    (not (null? new-outputs))))
+
 (define (build-packages store jobs eval-id)
   "Build JOBS and return a list of Build results."
   (define (register job)
@@ -711,25 +722,26 @@ by PRODUCT-SPECS."
                                       `(,name . ,path))))
                                  (derivation-path->output-paths drv)))
            (cur-time (time-second (current-time time-utc))))
-      (let ((build `((#:derivation . ,drv)
-                     (#:eval-id . ,eval-id)
-                     (#:job-name . ,job-name)
-                     (#:system . ,system)
-                     (#:nix-name . ,nix-name)
-
-                     ;; XXX: We'd leave LOG to #f (i.e., NULL) but that
-                     ;; currently violates the non-NULL constraint.
-                     (#:log . ,(or log ""))
-
-                     (#:status . ,(build-status scheduled))
-                     (#:outputs . ,outputs)
-                     (#:timestamp . ,cur-time)
-                     (#:starttime . 0)
-                     (#:stoptime . 0))))
-        (db-add-build build))))
+      (and (new-outputs? outputs)
+           (let ((build `((#:derivation . ,drv)
+                          (#:eval-id . ,eval-id)
+                          (#:job-name . ,job-name)
+                          (#:system . ,system)
+                          (#:nix-name . ,nix-name)
+
+                          ;; XXX: We'd leave LOG to #f (i.e., NULL) but that
+                          ;; currently violates the non-NULL constraint.
+                          (#:log . ,(or log ""))
+
+                          (#:status . ,(build-status scheduled))
+                          (#:outputs . ,outputs)
+                          (#:timestamp . ,cur-time)
+                          (#:starttime . 0)
+                          (#:stoptime . 0))))
+             (db-add-build build)))))
 
   (define derivations
-    (filter-map register jobs))
+    (with-time-logging "registration" (filter-map register jobs)))
 
   (log-message "evaluation ~a registered ~a new derivations"
                eval-id (length derivations))