branch master updated: Limit builds insertion queries.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 461e07e  Limit builds insertion queries.
461e07e is described below

commit 461e07e14e1c8013343c0a2cb26c0e022e10d5e4
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Sep 25 11:00:11 2020 +0200

    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.
---
 src/cuirass/base.scm | 46 +++++++++++++++++++++++++++++-----------------
 1 file 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))