branch master updated: Optimize build query.

[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 cb2c4e3  Optimize build query.
cb2c4e3 is described below

commit cb2c4e3d8f7eda187adf6da1fc35aef838c49828
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Oct 7 11:49:30 2020 +0200

    Optimize build query.
    
    Make sure that db-get-builds only performs one query and add build products 
to
    the result. Also add indexes so that all "order" filters are covered.
    
    Limit the maximum of build objects returned in "/api/latestbuilds" and
    "/api/queue" to 1000.
    
    Fixes: <https://issues.guix.gnu.org/43826>.
    
    * src/sql/upgrade-15.sql: New file.
    * Makefile (dist_sql_DATA): Add it.
    * src/cuirass/database.scm (db-get-builds-by-search): Add "buildproducts" to
    the returned build objects.
    (db-get-builds): Remove unused filters. Join Outputs and BuildProducts table
    in the query. Add "buildproducts" to the returned build objects.
    * src/cuirass/http.scm (build->hydra-build): Use "buildproducts" from
    "db-get-builds" procedure.
    (url-handler): Forbid limit parameters greater than 1000 and use
    "buildproducts" from "db-get-builds" procedure.
    * src/schema.sql (Builds_stoptime, Builds_stoptime_id, Builds_status_ts_id):
    New indexes.
---
 Makefile.am              |  3 +-
 src/cuirass/database.scm | 73 ++++++++++++++++++++++++++++++++++++++----------
 src/cuirass/http.scm     | 57 ++++++++++++++++++++-----------------
 src/schema.sql           |  9 +++++-
 src/sql/upgrade-15.sql   |  7 +++++
 5 files changed, 107 insertions(+), 42 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index e66ff84..98f89f9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -83,7 +83,8 @@ dist_sql_DATA =                               \
   src/sql/upgrade-11.sql                       \
   src/sql/upgrade-12.sql                       \
   src/sql/upgrade-13.sql                       \
-  src/sql/upgrade-14.sql
+  src/sql/upgrade-14.sql                       \
+  src/sql/upgrade-15.sql
 
 dist_css_DATA =                                        \
   src/static/css/cuirass.css                   \
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 12b22b8..07fcd85 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -875,7 +875,8 @@ LIMIT :nr;"))
                          (#:job-name . ,job-name)
                          (#:system . ,system)
                          (#:nix-name . ,nix-name)
-                         (#:specification . ,specification))
+                         (#:specification . ,specification)
+                         (#:buildproducts . ,(db-get-build-products id)))
                        builds))))))))
 
 (define (db-get-builds filters)
@@ -883,20 +884,19 @@ LIMIT :nr;"))
 FILTERS is an assoc list whose possible keys are 'derivation | 'id | 'jobset |
 'job | 'system | 'nr | 'order | 'status | 'evaluation."
 
+  ;; XXX: Make sure that all filters are covered by an index.
   (define (filters->order filters)
     (match (assq 'order filters)
-      (('order . 'build-id) "Builds.id ASC")
-      (('order . 'decreasing-build-id) "Builds.id DESC")
+      (('order . 'build-id) "Builds.rowid ASC")
       (('order . 'finish-time) "stoptime DESC")
-      (('order . 'finish-time+build-id) "stoptime DESC, Builds.id DESC")
-      (('order . 'start-time) "starttime DESC")
-      (('order . 'submission-time) "Builds.timestamp DESC")
+      (('order . 'finish-time+build-id) "stoptime DESC, Builds.rowid DESC")
       ;; With this order, builds in 'running' state (-1) appear
       ;; before those in 'scheduled' state (-2).
       (('order . 'status+submission-time)
-       "Builds.status DESC, Builds.timestamp DESC, Builds.id ASC")
-      (_ "Builds.id DESC")))
+       "Builds.status DESC, Builds.timestamp DESC, Builds.rowid ASC")
+      (_ "Builds.rowid DESC")))
 
+  ;; XXX: Make sure that all filters are covered by an index.
   (define (where-conditions filters)
     (define filter-name->sql
       `((id              . "Builds.id = :id")
@@ -928,6 +928,30 @@ FILTERS is an assoc list whose possible keys are 
'derivation | 'id | 'jobset |
       '()
       (map car filters))))
 
+  (define (format-outputs names paths)
+    (map (lambda (name path)
+           `(,name . ((#:path . ,path))))
+         (string-split names #\,)
+         (string-split paths #\,)))
+
+  (define (format-build-products ids types file-sizes checksums paths)
+    (define (split list)
+      (if list
+          (string-split list #\,)
+          '()))
+
+    (map (lambda (id type file-size checksum path)
+           `((#:id . ,(string->number id))
+             (#:type . ,type)
+             (#:file-size . ,(string->number file-size))
+             (#:checksum . ,checksum)
+             (#:path . ,path)))
+         (split ids)
+         (split types)
+         (split file-sizes)
+         (split checksums)
+         (split paths)))
+
   (with-db-worker-thread db
     (let* ((order (filters->order filters))
            (where (match (where-conditions filters)
@@ -939,16 +963,25 @@ FILTERS is an assoc list whose possible keys are 
'derivation | 'id | 'jobset |
                                     (string-join rest " AND ")))))
            (stmt-text
             (format #f "
-SELECT Builds.derivation, Builds.rowid, Builds.timestamp, Builds.starttime,
-       Builds.stoptime, Builds.log, Builds.status, Builds.job_name,
-       Builds.system, Builds.nix_name, Builds.evaluation, Specifications.name
+SELECT Builds.*,
+GROUP_CONCAT(Outputs.name), GROUP_CONCAT(Outputs.path),
+GROUP_CONCAT(BP.rowid), GROUP_CONCAT(BP.type), GROUP_CONCAT(BP.file_size),
+GROUP_CONCAT(BP.checksum), GROUP_CONCAT(BP.path) FROM
+(SELECT Builds.derivation, Builds.rowid, Builds.timestamp, Builds.starttime,
+        Builds.stoptime, Builds.log, Builds.status, Builds.job_name,
+        Builds.system, Builds.nix_name, Builds.evaluation,
+        Specifications.name
 FROM Builds
 INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
 INNER JOIN Specifications ON Evaluations.specification = Specifications.name
 ~a
 ORDER BY ~a
-LIMIT :nr"
-                    where order))
+LIMIT :nr) Builds
+INNER JOIN Outputs ON Outputs.derivation = Builds.derivation
+LEFT JOIN BuildProducts as BP ON BP.build = Builds.rowid
+GROUP BY Builds.derivation
+ORDER BY ~a;"
+                    where order order))
            (stmt (sqlite-prepare db stmt-text #:cache? #t)))
 
       (sqlite-bind stmt 'nr (match (assq-ref filters 'nr)
@@ -977,7 +1010,10 @@ LIMIT :nr"
         (match rows
           (() (reverse builds))
           ((#(derivation id timestamp starttime stoptime log status job-name
-                         system nix-name eval-id specification) . rest)
+                         system nix-name eval-id specification
+                         outputs-name outputs-path
+                         products-id products-type products-file-size
+                         products-checksum products-path) . rest)
            (loop rest
                  (cons `((#:derivation . ,derivation)
                          (#:id . ,id)
@@ -991,7 +1027,14 @@ LIMIT :nr"
                          (#:nix-name . ,nix-name)
                          (#:eval-id . ,eval-id)
                          (#:specification . ,specification)
-                         (#:outputs . ,(db-get-outputs derivation)))
+                         (#:outputs . ,(format-outputs outputs-name
+                                                       outputs-path))
+                         (#:buildproducts .
+                          ,(format-build-products products-id
+                                                  products-type
+                                                  products-file-size
+                                                  products-checksum
+                                                  products-path)))
                        builds))))))))
 
 (define (db-get-build derivation-or-id)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 6b13138..2d23aac 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -86,9 +86,6 @@
                (list (build-status scheduled)
                      (build-status started)))))
 
-  (define build-products
-    (db-get-build-products (assq-ref build #:id)))
-
   `((#:id . ,(assq-ref build #:id))
     (#:jobset . ,(assq-ref build #:specification))
     (#:job . ,(assq-ref build #:job-name))
@@ -110,7 +107,8 @@
                                 (assq-ref build #:status))))
     (#:priority . 0)
     (#:finished . ,(bool->int finished?))
-    (#:buildproducts . ,(list->vector build-products))
+    (#:buildproducts . ,(list->vector
+                         (assq-ref build #:buildproducts)))
     (#:releasename . #nil)
     (#:buildinputs_builds . #nil)))
 
@@ -438,7 +436,7 @@ Hydra format."
            (respond-build-not-found id))))
     (('GET "build" (= string->number id) "details")
      (let* ((build (and id (db-get-build id)))
-            (products (and build (db-get-build-products id))))
+            (products (and build (assoc-ref build #:buildproducts))))
        (if build
            (respond-html
             (html-page (string-append "Build " (number->string id))
@@ -490,28 +488,36 @@ Hydra format."
     (('GET "api" "latestbuilds")
      (let* ((params (request-parameters request))
             ;; 'nr parameter is mandatory to limit query size.
-            (valid-params? (assq-ref params 'nr)))
-       (if valid-params?
-           ;; Limit results to builds that are "done".
-           (respond-json
-            (object->json-string
-             (handle-builds-request `((status . done)
-                                      ,@params
-                                      (order . finish-time)))))
-           (respond-json-with-error 500 "Parameter not defined!"))))
+            (limit (assq-ref params 'nr)))
+       (cond
+        ((not limit)
+         (respond-json-with-error 500 "Parameter not defined"))
+        ((> limit 1000)
+         (respond-json-with-error 500 "Maximum limit exceeded"))
+        (else
+         ;; Limit results to builds that are "done".
+         (respond-json
+          (object->json-string
+           (handle-builds-request `((status . done)
+                                    ,@params
+                                    (order . finish-time)))))))))
     (('GET "api" "queue")
      (let* ((params (request-parameters request))
             ;; 'nr parameter is mandatory to limit query size.
-            (valid-params? (assq-ref params 'nr)))
-       (if valid-params?
-           (respond-json
-            (object->json-string
-             ;; Use the 'status+submission-time' order so that builds in
-             ;; 'running' state appear before builds in 'scheduled' state.
-             (handle-builds-request `((status . pending)
-                                      ,@params
-                                      (order . status+submission-time)))))
-           (respond-json-with-error 500 "Parameter not defined!"))))
+            (limit (assq-ref params 'nr)))
+       (cond
+        ((not limit)
+         (respond-json-with-error 500 "Parameter not defined"))
+        ((> limit 1000)
+         (respond-json-with-error 500 "Maximum limit exceeded"))
+        (else
+         (respond-json
+          (object->json-string
+           ;; Use the 'status+submission-time' order so that builds in
+           ;; 'running' state appear before builds in 'scheduled' state.
+           (handle-builds-request `((status . pending)
+                                    ,@params
+                                    (order . status+submission-time)))))))))
     (('GET)
      (respond-html (html-page
                     "Cuirass"
@@ -624,7 +630,8 @@ Hydra format."
                       (order . finish-time+build-id))))
              ((build)
               (let* ((build-id (assoc-ref build #:id))
-                     (products (db-get-build-products build-id))
+                     (products (vector->list
+                                (assoc-ref build #:buildproducts)))
                      (product (find (lambda (product)
                                       (string=? (assoc-ref product #:type)
                                                 product-type))
diff --git a/src/schema.sql b/src/schema.sql
index fb71319..1eeac80 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -95,14 +95,21 @@ CREATE TABLE Events (
   event_json    TEXT NOT NULL
 );
 
--- Create indexes to speed up common queries.
+-- XXX: All queries targeting Builds and Outputs tables *must* be covered by
+-- an index.  It is also preferable for the other tables.
 CREATE INDEX Builds_status_index ON Builds (status);
 CREATE INDEX Builds_evaluation_index ON Builds (evaluation, status);
 CREATE INDEX Builds_nix_name ON Builds (nix_name COLLATE NOCASE);
 CREATE INDEX Builds_timestamp_stoptime on Builds(timestamp, stoptime);
+CREATE INDEX Builds_stoptime on Builds(stoptime DESC);
+CREATE INDEX Builds_stoptime_id on Builds(stoptime DESC, id DESC);
+CREATE INDEX Builds_status_ts_id on Builds(status DESC, timestamp DESC, id 
ASC);
+
 CREATE INDEX Evaluations_status_index ON Evaluations (id, status);
 CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id 
DESC);
+
 CREATE INDEX Outputs_derivation_index ON Outputs (derivation);
+
 CREATE INDEX Inputs_index ON Inputs(specification, name, branch);
 
 COMMIT;
diff --git a/src/sql/upgrade-15.sql b/src/sql/upgrade-15.sql
new file mode 100644
index 0000000..1fc38d6
--- /dev/null
+++ b/src/sql/upgrade-15.sql
@@ -0,0 +1,7 @@
+BEGIN TRANSACTION;
+
+CREATE INDEX Builds_stoptime on Builds(stoptime DESC);
+CREATE INDEX Builds_stoptime_id on Builds(stoptime DESC, id DESC);
+CREATE INDEX Builds_status_ts_id on Builds(status DESC, timestamp DESC, id 
ASC);
+
+COMMIT;