diff --git a/Makefile.am b/Makefile.am
index e66ff84a863e91983cb9857cfabed4dfffe95934..98f89f9f28a3d061ea0824c393d59b26883b2e07 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 12b22b825086e7da3e45a168a7ed32318be02032..07fcd85117d7191080463160f68d2a0c40d68445 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 6b1313830cc092332b236c5cb73705636af3bf14..2d23aac7ff1c7bfcfeb3de288a92c024e53a1e6c 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 fb713199c20c7bfea889ff59313f917df385d513..1eeac80e294f0392c5c513625bef3f5f0eaccca1 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 0000000000000000000000000000000000000000..1fc38d61d19be74014a6911318ac6017ba13dc40
--- /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;