From 4f4d7ff7db694952cf9f6b9bdbef8f28423f4296 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Tue, 2 Feb 2021 11:56:28 +0100
Subject: [PATCH] Move weather field to database.
* src/sql/upgrade-4.sql: New file.
* Makefile.am (dist_sql_DATA): Add it.
* src/schema.sql (Builds)[weather]: New field.
(Builds_weather_evaluation): New index.
* src/cuirass/database.scm (db-get-last-status): New procedure.
(db-update-build-status!): Use it and update the new weather field.
(db-get-builds): Adapt it.
* tests/http.scm (build-query-result): Ditto.
---
Makefile.am | 3 +-
src/cuirass/database.scm | 116 ++++++++++++++++++++++-----------------
src/schema.sql | 2 +
src/sql/upgrade-4.sql | 6 ++
tests/http.scm | 2 +-
5 files changed, 77 insertions(+), 52 deletions(-)
create mode 100644 src/sql/upgrade-4.sql
diff --git a/Makefile.am b/Makefile.am
index dacc753d..2a4ed30d 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -81,7 +81,8 @@ dist_pkgdata_DATA = src/schema.sql
dist_sql_DATA = \
src/sql/upgrade-1.sql \
src/sql/upgrade-2.sql \
- src/sql/upgrade-3.sql
+ src/sql/upgrade-3.sql \
+ src/sql/upgrade-4.sql
dist_css_DATA = \
src/static/css/cuirass.css \
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 20a98c1c..8cb48a89 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -756,6 +756,26 @@ where id = " build-id ") d;
(exec-query db "COMMIT;")
derivations)))
+(define (db-get-last-status drv)
+ "Return the status of the last completed build with the same 'job_name' and
+specification' as DRV."
+ (with-db-worker-thread db
+ (match (expect-one-row
+ (exec-query/bind db "
+SELECT Builds.status FROM
+(SELECT evaluation, job_name, specification FROM Builds
+INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id WHERE
+derivation = " drv ") AS cur, Builds INNER JOIN
+Evaluations ON Builds.evaluation = Evaluations.id
+WHERE cur.job_name = Builds.job_name AND
+cur.specification = Evaluations.specification AND
+Builds.evaluation < cur.evaluation AND
+Builds.status >= 0
+ORDER BY Builds.evaluation DESC LIMIT 1"))
+ ((status)
+ (string->number status))
+ (else #f))))
+
(define* (db-update-build-status! drv status #:key log-file)
"Update the database so that DRV's status is STATUS. This also updates the
'starttime' or 'stoptime' fields. If LOG-FILE is true, record it as the build
@@ -793,22 +813,15 @@ log file for DRV."
;; with the status of the last completed build with the same
;; 'job_name' and 'specification'.
(begin
- (let ((rows
- (exec-query/bind db "
+ (let* ((last-status (db-get-last-status drv))
+ (weather (build-status->weather status last-status))
+ (rows
+ (exec-query/bind db "
UPDATE Builds SET stoptime =" now
", status =" status
-", last_status =
-(SELECT Builds.status FROM
-(SELECT evaluation, job_name, specification FROM Builds
-INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id WHERE
-derivation = " drv ") AS cur, Builds INNER JOIN
-Evaluations ON Builds.evaluation = Evaluations.id
-WHERE cur.job_name = Builds.job_name AND
-cur.specification = Evaluations.specification AND
-Builds.evaluation < cur.evaluation AND
-Builds.status >= 0
-ORDER BY Builds.evaluation DESC LIMIT 1)
-WHERE derivation =" drv
+", last_status = " last-status
+", weather = " weather
+"WHERE derivation =" drv
" AND status != " status ";")))
(when (positive? rows)
(db-add-event 'build
@@ -997,6 +1010,11 @@ CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
('pending "Builds.status < 0")
('succeeded "Builds.status = 0")
('failed "Builds.status > 0")))
+ (weather
+ . ,(match (assq-ref filters 'weather)
+ (#f #f)
+ ('all "Builds.weather >= 0")
+ ('new "Builds.weather = 0 OR Builds.weather = 1")))
(border-low-time
. "(((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.id))
OR :borderlowtime IS NULL OR :borderlowid IS NULL)")
@@ -1051,7 +1069,7 @@ OR :borderhightime IS NULL OR :borderhighid IS NULL)")))
(query
(format #f " SELECT Builds.derivation, Builds.id, Builds.timestamp,
Builds.starttime, Builds.stoptime, Builds.log, Builds.status,
-Builds.last_status, Builds.priority, Builds.max_silent,
+Builds.last_status, Builds.weather, Builds.priority, Builds.max_silent,
Builds.timeout, Builds.job_name, Builds.system,
Builds.worker, Builds.nix_name, Builds.evaluation, agg.name, agg.outputs_name,
agg.outputs_path,agg.bp_build, agg.bp_type, agg.bp_file_size,
@@ -1100,44 +1118,42 @@ ORDER BY ~a;"
(match builds
(() (reverse result))
(((derivation id timestamp starttime stoptime log status
- last-status priority max-silent timeout job-name
- system worker nix-name eval-id specification
- outputs-name outputs-path
+ last-status weather priority max-silent timeout
+ job-name system worker nix-name eval-id
+ specification outputs-name outputs-path
products-id products-type products-file-size
products-checksum products-path)
. rest)
- (let* ((status (string->number status))
- (last-status (and last-status
- (string->number last-status)))
- (weather (build-status->weather status last-status)))
- (loop rest
- (cons `((#:derivation . ,derivation)
- (#:id . ,(string->number id))
- (#:timestamp . ,(string->number timestamp))
- (#:starttime . ,(string->number starttime))
- (#:stoptime . ,(string->number stoptime))
- (#:log . ,log)
- (#:status . ,status)
- (#:last-status . ,last-status)
- (#:weather . ,weather)
- (#:priority . ,(string->number priority))
- (#:max-silent . ,(string->number max-silent))
- (#:timeout . ,(string->number timeout))
- (#:job-name . ,job-name)
- (#:system . ,system)
- (#:worker . ,worker)
- (#:nix-name . ,nix-name)
- (#:eval-id . ,(string->number eval-id))
- (#:specification . ,specification)
- (#:outputs . ,(format-outputs outputs-name
- outputs-path))
- (#:buildproducts .
- ,(format-build-products products-id
- products-type
- products-file-size
- products-checksum
- products-path)))
- result)))))))))
+ (loop rest
+ (cons `((#:derivation . ,derivation)
+ (#:id . ,(string->number id))
+ (#:timestamp . ,(string->number timestamp))
+ (#:starttime . ,(string->number starttime))
+ (#:stoptime . ,(string->number stoptime))
+ (#:log . ,log)
+ (#:status . ,(string->number status))
+ (#:last-status . ,(and last-status
+ (string->number last-status)))
+ (#:weather . ,(and weather
+ (string->number weather)))
+ (#:priority . ,(string->number priority))
+ (#:max-silent . ,(string->number max-silent))
+ (#:timeout . ,(string->number timeout))
+ (#:job-name . ,job-name)
+ (#:system . ,system)
+ (#:worker . ,worker)
+ (#:nix-name . ,nix-name)
+ (#:eval-id . ,(string->number eval-id))
+ (#:specification . ,specification)
+ (#:outputs . ,(format-outputs outputs-name
+ outputs-path))
+ (#:buildproducts .
+ ,(format-build-products products-id
+ products-type
+ products-file-size
+ products-checksum
+ products-path)))
+ result))))))))
(define (db-get-build derivation-or-id)
"Retrieve a build in the database which corresponds to DERIVATION-OR-ID."
diff --git a/src/schema.sql b/src/schema.sql
index 1cfdae4d..81063b91 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -64,6 +64,7 @@ CREATE TABLE Builds (
log TEXT NOT NULL,
status INTEGER NOT NULL,
last_status INTEGER,
+ weather INTEGER,
priority INTEGER NOT NULL DEFAULT 0,
max_silent INTEGER NOT NULL DEFAULT 0,
timeout INTEGER NOT NULL DEFAULT 0,
@@ -126,6 +127,7 @@ 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 Builds_priority_timestamp on Builds(priority ASC, timestamp DESC);
+CREATE INDEX Builds_weather_evaluation ON Builds (weather, evaluation);
CREATE INDEX Evaluations_status_index ON Evaluations (id, status);
CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id DESC);
diff --git a/src/sql/upgrade-4.sql b/src/sql/upgrade-4.sql
new file mode 100644
index 00000000..3de1e766
--- /dev/null
+++ b/src/sql/upgrade-4.sql
@@ -0,0 +1,6 @@
+BEGIN TRANSACTION;
+
+ALTER TABLE Builds ADD COLUMN weather INTEGER;
+CREATE INDEX Builds_weather_evaluation ON Builds (weather, evaluation);
+
+COMMIT;
diff --git a/tests/http.scm b/tests/http.scm
index b814c4eb..d6a9c6d3 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -65,7 +65,7 @@
(#:system . "x86_64-linux")
(#:nixname . "fake-1.0")
(#:buildstatus . 0)
- (#:weather . -1)
+ (#:weather . #nil)
(#:busy . 0)
(#:priority . 0)
(#:finished . 1)
--
GitLab