diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 73 | ||||
| -rw-r--r-- | src/cuirass/http.scm | 57 | ||||
| -rw-r--r-- | src/schema.sql | 9 | ||||
| -rw-r--r-- | 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; |