branch: master
commit 4db99f647b3677086a2007763726d05a59b0cdcb
Author: Clément Lassieur <clem...@lassieur.org>
Date: Wed Aug 1 00:03:12 2018 +0200
database: Merge Derivations into Builds table.
Fixes <https://bugs.gnu.org/32190>.
* Makefile.am (dist_sql_DATA): Add 'src/sql/upgrade-2.sql'.
* doc/cuirass.texi (Derivations): Remove section.
(Builds): Update accordingly. Add columns from the Derivations table.
(Outputs): Replace 'id' with 'derivation'.
* src/cuirass/base.scm (evaluate): Don't add jobs to the Derivations table.
(build-packages): Add columns that were in the Derivations table before.
Only
build the derivations that were successfully registered, that is, those that
didn't exist in the Builds table. Give a derivation instead of a build id
to
DB-GET-BUILD. Compute the number of failed jobs based on the derivations
that
were added to the table, instead of the jobs.
* src/cuirass/database.scm (db-add-derivation, db-get-derivation): Remove
exported procedures.
(db-add-build): Catch SQLITE_CONSTRAINT_PRIMARYKEY error, which means that
two
jobs produced the same derivation, and return #f in that case. Add columns
that were in the Derivations table before. Use 'derivation' as primary key
for the Outputs table.
(db-get-outputs): Use 'derivation' as identifier, instead of 'build-id'.
(filters->order): Replace 'id' with 'rowid'.
(db-get-builds): Add a 'derivation' filter. Replace 'id' with 'rowid'.
Remove the 'INNER JOIN Derivations'. Replace Derivations with Builds.
Return
'derivation' in first position to make it clear that it's the primary key.
Pass DERIVATION instead of ID to DB-GET-OUTPUTS.
(db-get-build): Allow to take a derivation as argument. Use NUMBER? to
differentiate between derivations and ids.
(db-get-pending-derivations): Remove the 'SELECT DISTINCT' clause now that
derivations are unique. Remove the 'INNER JOIN Builds'.
(db-get-evaluations-build-summary, db-get-builds-min, db-get-builds-max):
Replace 'id' with 'rowid'.
* src/schema.sql (Derivations): Remove table.
(Outputs): Replace Builds.id with Builds.derivation.
(Builds): Use 'derivation' as primary key. Remove the 'id' column. Add
'job_name', 'system', 'nix_name' columns that were in the Derivations table
before.
(Builds_Derivations_index): Rename to Builds_index. Update accordingly.
(Derivations_index): Remove index.
* src/sql/upgrade-2.sql: New file with SQL queries to upgrade the database.
* tests/database.scm (make-dummy-job, make-dummy-derivation): Remove
procedures.
(make-dummy-build): Add columns that were in MAKE-DUMMY-DERIVATION. Get the
DRV parameter to be mandatory because it's a primary key.
(%id): Remove parameter.
("db-add-derivation", "db-get-derivation"): Remove tests.
("db-add-build"): Expect #f, because it adds twice the same derivation.
Pass
the derivation argument to MAKE-DUMMY-BUILD.
("db-update-build-status!"): Rename 'id' to 'derivation'. Pass the
derivation
argument to MAKE-DUMMY-BUILD. Remove the DB-ADD-DERIVATION call.
("db-get-builds", "db-get-pending-derivations"): Pass the derivation
argument
to MAKE-DUMMY-BUILD. Remove the DB-ADD-DERIVATION calls.
* tests/http.scm ("fill-db"): Remove DERIVATION1 and DERIVATION2, and put
their content in BUILD1 and BUILD2. Remove the DB-ADD-DERIVATION calls.
---
Makefile.am | 3 +-
doc/cuirass.texi | 55 +++++----------
src/cuirass/base.scm | 25 ++++---
src/cuirass/database.scm | 174 ++++++++++++++++++++---------------------------
src/schema.sql | 28 +++-----
src/sql/upgrade-2.sql | 49 +++++++++++++
tests/database.scm | 78 +++++++--------------
tests/http.scm | 20 ++----
8 files changed, 193 insertions(+), 239 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index ac22601..db56165 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -65,7 +65,8 @@ nodist_webobject_DATA = \
dist_pkgdata_DATA = src/schema.sql
dist_sql_DATA = \
- src/sql/upgrade-1.sql
+ src/sql/upgrade-1.sql \
+ src/sql/upgrade-2.sql
dist_css_DATA = \
src/static/css/bootstrap.css \
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index d4c6ae1..b51cfad 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -249,9 +249,8 @@ Cuirass uses a SQLite database to store information about
jobs and past
build results, but also to coordinate the execution of jobs.
The database contains the following tables: @code{Specifications},
-@code{Inputs}, @code{Stamps}, @code{Evaluations}, @code{Derivations},
-@code{Builds} and @code{Outputs}. The purpose of each of these tables is
-explained below.
+@code{Inputs}, @code{Stamps}, @code{Evaluations}, @code{Builds} and
+@code{Outputs}. The purpose of each of these tables is explained below.
@section Specifications
@cindex specifications, database
@@ -349,9 +348,8 @@ and @code{stamp}, which holds the revisions (space
separated commit hashes).
@section Evaluations
@cindex evaluations, database
-An evaluation relates a specification with the revision of the
-repository specified therein. Derivations and builds (see below) each
-belong to a specific evaluation.
+An evaluation relates a specification with the revision of the repository
+specified therein. Builds (see below) belong to a specific evaluation.
The @code{Evaluations} table has the following columns:
@@ -368,20 +366,21 @@ This text field holds the revisions (space separated
commit hashes) of the
repositories specified as inputs of the related specification.
@end table
-@section Derivations
-@cindex derivations, database
+@section Builds
+@cindex builds, database
-This table associates a tuple of the absolute derivation file name and
-evaluation identifier with a job name.
+This table holds records of the derivations and their build status. Note that
+a job will be registered here only if its derivation doesn't already exist.
@table @code
@item derivation
-This column holds the absolute file name of the Guix derivation that is
-supposed to be evaluated for this job.
+This text field holds the absolute name of the derivation file that
+resulted in this build.
@item evaluation
-This field holds the @code{id} of an evaluation from the
-@code{Evaluations} table.
+This integer field references the evaluation identifier from the
+@code{Evaluations} table, indicating to which evaluation this build
+belongs.
@item job_name
This text field holds the name of the job.
@@ -393,28 +392,6 @@ This text field holds the system name of the derivation.
This text field holds the name of the derivation ---e.g.,
@code{coreutils-8.24}.
-@end table
-
-@section Builds
-@cindex builds, database
-
-This table holds records of completed or failed package builds. Note
-that builds are not in a one to one relationship with derivations in
-order to keep track of non-deterministic compilations.
-
-@table @code
-@item id
-This is an automatically incrementing numeric identifier.
-
-@item derivation
-This text field holds the absolute name of the derivation file that
-resulted in this build.
-
-@item evaluation
-This integer field references the evaluation identifier from the
-@code{Evaluations} table, indicating to which evaluation this build
-belongs.
-
@item log
This text field holds the absolute file name of the build log file.
@@ -442,9 +419,9 @@ stored in @code{Builds} table may have zero (if it has
failed), one or
multiple outputs.
@table @code
-@item build
-This field holds the @code{id} of a build from the
-@code{Builds} table.
+@item derivation
+This field holds the @code{derivation} of a build from the @code{Builds}
+table.
@item name
This text field holds the name of the output.
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 82f49a4..ab1ad31 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -280,11 +280,9 @@ Return a list of jobs."
db `((#:specification . ,spec-name)
(#:commits . ,commits)))))
(log-message "created evaluation ~a for '~a'" eval-id spec-name)
- (let ((jobs (map (lambda (job)
- (augment-job job eval-id))
- jobs)))
- (for-each (cut db-add-derivation db <>) jobs)
- jobs))))))
+ (map (lambda (job)
+ (augment-job job eval-id))
+ jobs))))))
;;;
@@ -546,6 +544,9 @@ procedure is meant to be called at startup."
(let* ((name (assq-ref job #:job-name))
(drv (assq-ref job #:derivation))
(eval-id (assq-ref job #:eval-id))
+ (job-name (assq-ref job #:job-name))
+ (system (assq-ref job #:system))
+ (nix-name (assq-ref job #:nix-name))
;; XXX: How to keep logs from several attempts?
(log (log-file store drv))
(outputs (filter-map (lambda (res)
@@ -556,6 +557,9 @@ procedure is meant to be called at startup."
(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.
@@ -568,13 +572,12 @@ procedure is meant to be called at startup."
(#:stoptime . 0))))
(db-add-build db build))))
- (define build-ids
- (map register jobs))
+ (define derivations
+ (filter-map register jobs))
- (spawn-builds store db
- (map (cut assq-ref <> #:derivation) jobs))
+ (spawn-builds store db derivations)
- (let* ((results (filter-map (cut db-get-build db <>) build-ids))
+ (let* ((results (filter-map (cut db-get-build db <>) derivations))
(status (map (cut assq-ref <> #:status) results))
(success (count (lambda (status)
(= status (build-status succeeded)))
@@ -584,7 +587,7 @@ procedure is meant to be called at startup."
(((_ (#:path . (? string? outputs))) ...)
outputs))
outputs))
- (fail (- (length jobs) success)))
+ (fail (- (length derivations) success)))
(log-message "outputs:\n~a" (string-join outs "\n"))
(log-message "success: ~a, fail: ~a" success fail)
results))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index e73b648..138da22 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -41,8 +41,6 @@
db-add-stamp
db-get-stamp
db-add-evaluation
- db-add-derivation
- db-get-derivation
db-get-pending-derivations
build-status
db-add-build
@@ -312,32 +310,6 @@ package_path_inputs, proc_input, proc_file, proc,
proc_args) \
(#:inputs . ,(db-get-inputs db name)))
specs))))))
-(define (db-add-derivation db job)
- "Store a derivation result in database DB and return its ID."
- (catch 'sqlite-error
- (lambda ()
- (sqlite-exec db "\
-INSERT INTO Derivations (derivation, job_name, system, nix_name, evaluation)\
- VALUES ("
- (assq-ref job #:derivation) ", "
- (assq-ref job #:job-name) ", "
- (assq-ref job #:system) ", "
- (assq-ref job #:nix-name) ", "
- (assq-ref job #:eval-id) ");")
- (last-insert-rowid db))
- (lambda (key who code message . rest)
- ;; If we get a unique-constraint-failed error, that means we have
- ;; already inserted the same (derivation,eval-id) tuple. That happens
- ;; when several jobs produce the same derivation, and we can ignore it.
- (if (= code SQLITE_CONSTRAINT_PRIMARYKEY)
- (sqlite-exec db "SELECT * FROM Derivations WHERE derivation="
- (assq-ref job #:derivation) ";")
- (apply throw key who code rest)))))
-
-(define (db-get-derivation db id)
- "Retrieve a job in database DB which corresponds to ID."
- (car (sqlite-exec db "SELECT * FROM Derivations WHERE derivation=" id ";")))
-
(define (db-add-evaluation db eval)
(sqlite-exec db "\
INSERT INTO Evaluations (specification, commits) VALUES ("
@@ -384,27 +356,39 @@ string."
(define (db-add-build db build)
"Store BUILD in database DB. BUILD eventual outputs are stored
in the OUTPUTS table."
- (let* ((build-exec
- (sqlite-exec db "\
-INSERT INTO Builds (derivation, evaluation, log, status, timestamp, starttime,
stoptime)\
- VALUES ("
- (assq-ref build #:derivation) ", "
- (assq-ref build #:eval-id) ", "
- (assq-ref build #:log) ", "
- (or (assq-ref build #:status)
- (build-status scheduled)) ", "
- (or (assq-ref build #:timestamp) 0) ", "
- (or (assq-ref build #:starttime) 0) ", "
- (or (assq-ref build #:stoptime) 0) ");"))
- (build-id (last-insert-rowid db)))
- (for-each (lambda (output)
- (match output
- ((name . path)
- (sqlite-exec db "\
-INSERT INTO Outputs (build, name, path) VALUES ("
- build-id ", " name ", " path ");"))))
- (assq-ref build #:outputs))
- build-id))
+ (catch 'sqlite-error
+ (lambda ()
+ (sqlite-exec db "
+INSERT INTO Builds (derivation, evaluation, job_name, system, nix_name, log,
+status, timestamp, starttime, stoptime)
+VALUES ("
+ (assq-ref build #:derivation) ", "
+ (assq-ref build #:eval-id) ", "
+ (assq-ref build #:job-name) ", "
+ (assq-ref build #:system) ", "
+ (assq-ref build #:nix-name) ", "
+ (assq-ref build #:log) ", "
+ (or (assq-ref build #:status)
+ (build-status scheduled)) ", "
+ (or (assq-ref build #:timestamp) 0) ", "
+ (or (assq-ref build #:starttime) 0) ", "
+ (or (assq-ref build #:stoptime) 0) ");")
+ (let ((derivation (assq-ref build #:derivation)))
+ (for-each (lambda (output)
+ (match output
+ ((name . path)
+ (sqlite-exec db "\
+INSERT INTO Outputs (derivation, name, path) VALUES ("
+ derivation ", " name ", " path ");"))))
+ (assq-ref build #:outputs))
+ derivation))
+ (lambda (key who code message . rest)
+ ;; If we get a unique-constraint-failed error, that means we have
+ ;; already inserted the same build. That happens when several jobs
+ ;; produce the same derivation, and we can ignore it.
+ (if (= code SQLITE_CONSTRAINT_PRIMARYKEY)
+ #f
+ (apply throw key who code rest)))))
(define* (db-update-build-status! db drv status #:key log-file)
"Update DB so that DRV's status is STATUS. This also updates the
@@ -429,11 +413,11 @@ log file for DRV."
", status=" status
"WHERE derivation=" drv " AND status != " status ";"))))
-(define (db-get-outputs db build-id)
- "Retrieve the OUTPUTS of the build identified by BUILD-ID in DB database."
+(define (db-get-outputs db derivation)
+ "Retrieve the OUTPUTS of the build identified by DERIVATION in DB database."
(let loop ((rows
- (sqlite-exec db "SELECT name, path FROM Outputs WHERE build="
- build-id ";"))
+ (sqlite-exec db "SELECT name, path FROM Outputs
+WHERE derivation =" derivation ";"))
(outputs '()))
(match rows
(() outputs)
@@ -445,56 +429,56 @@ log file for DRV."
(define (filters->order filters)
(match (assq 'order filters)
- (('order . 'build-id) "id ASC")
- (('order . 'decreasing-build-id) "id DESC")
+ (('order . 'build-id) "rowid ASC")
+ (('order . 'decreasing-build-id) "rowid DESC")
(('order . 'finish-time) "stoptime DESC")
- (('order . 'finish-time+build-id) "stoptime DESC, id DESC")
+ (('order . 'finish-time+build-id) "stoptime DESC, rowid DESC")
(('order . 'start-time) "starttime DESC")
(('order . 'submission-time) "timestamp DESC")
;; With this order, builds in 'running' state (-1) appear
;; before those in 'scheduled' state (-2).
(('order . 'status+submission-time) "status DESC, timestamp DESC")
- (_ "id DESC")))
+ (_ "rowid DESC")))
(define (db-get-builds db filters)
"Retrieve all builds in database DB which are matched by given FILTERS.
-FILTERS is an assoc list whose possible keys are 'id | 'jobset | 'job |
-'system | 'nr | 'order | 'status | 'evaluation."
+FILTERS is an assoc list whose possible keys are 'derivation | 'id | 'jobset |
+'job | 'system | 'nr | 'order | 'status | 'evaluation."
(let* ((order (filters->order filters))
(stmt-text (format #f "SELECT * FROM (
-SELECT Builds.id, Builds.timestamp, Builds.starttime, Builds.stoptime,
-Builds.log, Builds.status, Builds.derivation, Derivations.job_name,
-Derivations.system, Derivations.nix_name, Specifications.name
+SELECT Builds.derivation, Builds.rowid, Builds.timestamp, Builds.starttime,
+Builds.stoptime, Builds.log, Builds.status, Builds.job_name, Builds.system,
+Builds.nix_name, Specifications.name
FROM Builds
-INNER JOIN Derivations ON Builds.derivation = Derivations.derivation
-AND Builds.evaluation = Derivations.evaluation
-INNER JOIN Evaluations ON Derivations.evaluation = Evaluations.id
+INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
INNER JOIN Specifications ON Evaluations.specification = Specifications.name
-WHERE (:id IS NULL OR (:id = Builds.id))
+WHERE (:id IS NULL OR (:id = Builds.rowid))
+AND (:derivation IS NULL OR (:derivation = Builds.derivation))
AND (:jobset IS NULL OR (:jobset = Specifications.name))
-AND (:job IS NULL OR (:job = Derivations.job_name))
-AND (:system IS NULL OR (:system = Derivations.system))
+AND (:job IS NULL OR (:job = Builds.job_name))
+AND (:system IS NULL OR (:system = Builds.system))
AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation))
AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0)
OR (:status = 'pending' AND Builds.status < 0))
AND (:borderlowtime IS NULL OR :borderlowid IS NULL
- OR ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.id)))
+ OR ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.rowid)))
AND (:borderhightime IS NULL OR :borderhighid IS NULL
- OR ((:borderhightime, :borderhighid) > (Builds.stoptime, Builds.id)))
+ OR ((:borderhightime, :borderhighid) > (Builds.stoptime, Builds.rowid)))
ORDER BY
CASE WHEN :borderlowtime IS NULL
OR :borderlowid IS NULL THEN Builds.stoptime
ELSE -Builds.stoptime
END DESC,
CASE WHEN :borderlowtime IS NULL
- OR :borderlowid IS NULL THEN Builds.id
- ELSE -Builds.id
+ OR :borderlowid IS NULL THEN Builds.rowid
+ ELSE -Builds.rowid
END DESC
LIMIT :nr)
-ORDER BY ~a, id ASC;" order))
+ORDER BY ~a, rowid ASC;" order))
(stmt (sqlite-prepare db stmt-text #:cache? #t)))
(sqlite-bind-arguments
stmt
+ #:derivation (assq-ref filters 'derivation)
#:id (assq-ref filters 'id)
#:jobset (assq-ref filters 'jobset)
#:job (assq-ref filters 'job)
@@ -513,45 +497,37 @@ ORDER BY ~a, id ASC;" order))
(builds '()))
(match rows
(() (reverse builds))
- ((#(id timestamp starttime stoptime log status derivation job-name
- system nix-name specification) . rest)
+ ((#(derivation id timestamp starttime stoptime log status job-name
+ system nix-name specification) . rest)
(loop rest
- (cons `((#:id . ,id)
+ (cons `((#:derivation . ,derivation)
+ (#:id . ,id)
(#:timestamp . ,timestamp)
(#:starttime . ,starttime)
(#:stoptime . ,stoptime)
(#:log . ,log)
(#:status . ,status)
- (#:derivation . ,derivation)
(#:job-name . ,job-name)
(#:system . ,system)
(#:nix-name . ,nix-name)
(#:specification . ,specification)
- (#:outputs . ,(db-get-outputs db id)))
+ (#:outputs . ,(db-get-outputs db derivation)))
builds)))))))
-(define (db-get-build db id)
- "Retrieve a build in database DB which corresponds to ID."
- (match (db-get-builds db `((id . ,id)))
- ((build)
- build)
- (() #f)))
+(define (db-get-build db derivation-or-id)
+ "Retrieve a build in database DB which corresponds to DERIVATION-OR-ID."
+ (let ((key (if (number? derivation-or-id) 'id 'derivation)))
+ (match (db-get-builds db `((,key . ,derivation-or-id)))
+ ((build)
+ build)
+ (() #f))))
(define (db-get-pending-derivations db)
"Return the list of derivation file names corresponding to pending builds in
DB. The returned list is guaranteed to not have any duplicates."
- ;; This is of course much more efficient than calling 'delete-duplicates' on
- ;; a list of results obtained without DISTINCT, both in space and time.
- ;;
- ;; Here we use a subquery so that sqlite can use two indexes instead of
- ;; creating a "TEMP B-TREE" when doing a single flat query, as "EXPLAIN
- ;; QUERY PLAN" shows.
(map (match-lambda (#(drv) drv))
(sqlite-exec db "
-SELECT DISTINCT derivation FROM (
- SELECT Derivations.derivation FROM Derivations INNER JOIN Builds
- WHERE Derivations.derivation = Builds.derivation AND Builds.status < 0
-);")))
+SELECT derivation FROM Builds WHERE Builds.status < 0;")))
(define (db-get-stamp db spec)
"Return a stamp corresponding to specification SPEC in database DB."
@@ -596,7 +572,7 @@ AND (" border-high "IS NULL OR (id <" border-high "))
ORDER BY CASE WHEN " border-low "IS NULL THEN id ELSE -id END DESC
LIMIT " limit ") E
LEFT JOIN
-(SELECT id, evaluation, SUM(status=0) as succeeded,
+(SELECT rowid, evaluation, SUM(status=0) as succeeded,
SUM(status>0) as failed, SUM(status<0) as scheduled
FROM Builds
GROUP BY evaluation) B
@@ -632,8 +608,8 @@ WHERE specification=" spec)))
"Return the min build (stoptime, id) pair for
the given evaluation EVAL."
(let ((rows (sqlite-exec db "
-SELECT stoptime, MIN(id) FROM
-(SELECT id, stoptime FROM Builds
+SELECT stoptime, MIN(rowid) FROM
+(SELECT rowid, stoptime FROM Builds
WHERE evaluation=" eval " AND
stoptime = (SELECT MIN(stoptime)
FROM Builds WHERE evaluation=" eval "))")))
@@ -643,8 +619,8 @@ FROM Builds WHERE evaluation=" eval "))")))
"Return the max build (stoptime, id) pair for
the given evaluation EVAL."
(let ((rows (sqlite-exec db "
-SELECT stoptime, MAX(id) FROM
-(SELECT id, stoptime FROM Builds
+SELECT stoptime, MAX(rowid) FROM
+(SELECT rowid, stoptime FROM Builds
WHERE evaluation=" eval " AND
stoptime = (SELECT MAX(stoptime)
FROM Builds WHERE evaluation=" eval "))")))
diff --git a/src/schema.sql b/src/schema.sql
index eb0f7e9..0452495 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -37,43 +37,31 @@ CREATE TABLE Evaluations (
FOREIGN KEY (specification) REFERENCES Specifications (name)
);
-CREATE TABLE Derivations (
- derivation TEXT NOT NULL,
- evaluation INTEGER NOT NULL,
- job_name TEXT NOT NULL,
- system TEXT NOT NULL,
- nix_name TEXT NOT NULL,
- PRIMARY KEY (derivation, evaluation),
- FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
-);
-
CREATE TABLE Outputs (
- build INTEGER NOT NULL,
+ derivation TEXT NOT NULL,
name TEXT NOT NULL,
path TEXT NOT NULL,
- PRIMARY KEY (build, name),
- FOREIGN KEY (build) REFERENCES Builds (id)
+ PRIMARY KEY (derivation, name),
+ FOREIGN KEY (derivation) REFERENCES Builds (derivation)
);
--- Builds are not in a one to one relationship with derivations in order to
--- keep track of non deterministic compilations.
CREATE TABLE Builds (
- id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
- derivation TEXT NOT NULL,
+ derivation TEXT NOT NULL PRIMARY KEY,
evaluation INTEGER NOT NULL,
+ job_name TEXT NOT NULL,
+ system TEXT NOT NULL,
+ nix_name TEXT NOT NULL,
log TEXT NOT NULL,
status INTEGER NOT NULL,
timestamp INTEGER NOT NULL,
starttime INTEGER NOT NULL,
stoptime INTEGER NOT NULL,
- FOREIGN KEY (derivation) REFERENCES Derivations (derivation),
FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
);
-- Create indexes to speed up common queries, in particular those
-- corresponding to /api/latestbuilds and /api/queue HTTP requests.
-CREATE INDEX Builds_Derivations_index ON Builds(status ASC, timestamp ASC, id,
derivation, evaluation, stoptime DESC);
+CREATE INDEX Builds_index ON Builds(job_name, system, status ASC, timestamp
ASC, derivation, evaluation, stoptime DESC);
CREATE INDEX Inputs_index ON Inputs(specification, name, branch);
-CREATE INDEX Derivations_index ON Derivations(derivation, evaluation,
job_name, system);
COMMIT;
diff --git a/src/sql/upgrade-2.sql b/src/sql/upgrade-2.sql
new file mode 100644
index 0000000..dfb919b
--- /dev/null
+++ b/src/sql/upgrade-2.sql
@@ -0,0 +1,49 @@
+BEGIN TRANSACTION;
+
+DROP INDEX Derivations_index;
+DROP INDEX Builds_Derivations_index;
+
+ALTER TABLE Outputs RENAME TO tmp_Outputs;
+ALTER TABLE Builds RENAME TO tmp_Builds;
+
+CREATE TABLE Builds (
+ derivation TEXT NOT NULL PRIMARY KEY,
+ evaluation INTEGER NOT NULL,
+ job_name TEXT NOT NULL,
+ system TEXT NOT NULL,
+ nix_name TEXT NOT NULL,
+ log TEXT NOT NULL,
+ status INTEGER NOT NULL,
+ timestamp INTEGER NOT NULL,
+ starttime INTEGER NOT NULL,
+ stoptime INTEGER NOT NULL,
+ FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
+);
+
+CREATE TABLE Outputs (
+ derivation TEXT NOT NULL,
+ name TEXT NOT NULL,
+ path TEXT NOT NULL,
+ PRIMARY KEY (derivation, name),
+ FOREIGN KEY (derivation) REFERENCES Builds (derivation)
+);
+
+INSERT OR IGNORE INTO Builds (derivation, evaluation, job_name, system,
nix_name, log, status, timestamp, starttime, stoptime)
+SELECT Derivations.derivation, Derivations.evaluation, Derivations.job_name,
Derivations.system, Derivations.nix_name,
+ tmp_Builds.log, tmp_Builds.status, tmp_Builds.timestamp,
tmp_Builds.starttime, tmp_Builds.stoptime
+FROM Derivations
+INNER JOIN tmp_Builds ON tmp_Builds.derivation = Derivations.derivation
+ AND tmp_Builds.evaluation = Derivations.evaluation;
+
+INSERT OR IGNORE INTO Outputs (derivation, name, path)
+SELECT tmp_Builds.derivation, tmp_Outputs.name, tmp_Outputs.path
+FROM tmp_Outputs
+INNER JOIN tmp_Builds on tmp_Builds.id = tmp_Outputs.build;
+
+CREATE INDEX Builds_index ON Builds(job_name, system, status ASC, timestamp
ASC, derivation, evaluation, stoptime DESC);
+
+DROP TABLE tmp_Builds;
+DROP TABLE tmp_Outputs;
+DROP TABLE Derivations;
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index 17d48f5..af518bd 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -50,27 +50,14 @@
`((#:specification . "guix")
(#:commits . ,commits)))
-(define* (make-dummy-job #:optional (name "foo"))
- `((#:name . ,name)
- (#:job-name . "job")
- (#:system . "x86_64-linux")
- (#:derivation . ,(string-append name ".drv"))
- (#:nix-name . "foo")
- (#:specification 0)
- (#:eval-id . 42)))
-
-(define* (make-dummy-derivation drv #:optional (eval-id 0))
+(define* (make-dummy-build drv
+ #:optional (eval-id 42)
+ #:key (outputs '(("foo" . "/foo"))))
`((#:derivation . ,drv)
+ (#:eval-id . ,eval-id)
(#:job-name . "job")
(#:system . "x86_64-linux")
- (#:nix-name . ,(basename drv ".drv"))
- (#:eval-id . ,eval-id)))
-
-(define* (make-dummy-build #:optional (eval-id 42)
- #:key (drv "/foo.drv")
- (outputs '(("foo" . "/foo"))))
- `((#:derivation . ,drv)
- (#:eval-id . ,eval-id)
+ (#:nix-name . "foo")
(#:log . "log")
(#:outputs . (("foo" . "/foo")))))
@@ -86,10 +73,6 @@
;; Global Slot for a database object.
(make-parameter #t))
-(define %id
- ;; Global Slot for a job ID in the database.
- (make-parameter #t))
-
(define database-name
;; Use an empty and temporary database for the tests.
(string-append (getcwd) "/" (number->string (getpid)) "-tmp.db"))
@@ -114,21 +97,13 @@ INSERT INTO Evaluations (specification, commits) VALUES
(3, 3);")
(db-add-specification (%db) example-spec)
(car (db-get-specifications (%db)))))
- (test-assert "db-add-derivation"
- (let* ((job (make-dummy-job))
- (key (assq-ref job #:derivation)))
- (db-add-derivation (%db) job)
- (db-add-derivation (%db) job) ;idempotent
- (%id key)))
-
- (test-assert "db-get-derivation"
- (db-get-derivation (%db) (%id)))
-
- (test-assert "db-add-build"
- (let ((build (make-dummy-build)))
+ (test-equal "db-add-build"
+ #f
+ (let ((build (make-dummy-build "/foo.drv")))
(db-add-build (%db) build)
- ;; This should be idempotent, see <https://bugs.gnu.org/28094>.
+ ;; Should return #f when adding a build whose derivation is already
+ ;; there, see <https://bugs.gnu.org/28094>.
(db-add-build (%db) build)))
(test-equal "db-update-build-status!"
@@ -137,13 +112,12 @@ INSERT INTO Evaluations (specification, commits) VALUES
(3, 3);")
(build-status succeeded)
"/foo.drv.log")
(with-temporary-database db
- (let* ((id (db-add-build
- db
- (make-dummy-build 1 #:drv "/foo.drv"
- #:outputs '(("out" . "/foo")))))
+ (let* ((derivation (db-add-build
+ db
+ (make-dummy-build "/foo.drv" 1
+ #:outputs '(("out" . "/foo")))))
(get-status (lambda* (#:optional (key #:status))
- (assq-ref (db-get-build db id) key))))
- (db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
+ (assq-ref (db-get-build db derivation) key))))
(db-add-evaluation db (make-dummy-eval))
(db-add-specification db example-spec)
@@ -171,18 +145,15 @@ INSERT INTO Evaluations (specification, commits) VALUES
(3, 3);")
((3 "/baz.drv")) ;nr = 1
((2 "/bar.drv") (1 "/foo.drv") (3 "/baz.drv"))) ;status+submission-time
(with-temporary-database db
- ;; Populate the 'Builds', 'Derivations', 'Evaluations', and
+ ;; Populate the 'Builds'', 'Evaluations', and
;; 'Specifications' tables in a consistent way, as expected by the
;; 'db-get-builds' query.
- (db-add-build db (make-dummy-build 1 #:drv "/foo.drv"
+ (db-add-build db (make-dummy-build "/foo.drv" 1
#:outputs `(("out" . "/foo"))))
- (db-add-build db (make-dummy-build 2 #:drv "/bar.drv"
+ (db-add-build db (make-dummy-build "/bar.drv" 2
#:outputs `(("out" . "/bar"))))
- (db-add-build db (make-dummy-build 3 #:drv "/baz.drv"
+ (db-add-build db (make-dummy-build "/baz.drv" 3
#:outputs `(("out" . "/baz"))))
- (db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
- (db-add-derivation db (make-dummy-derivation "/bar.drv" 2))
- (db-add-derivation db (make-dummy-derivation "/baz.drv" 3))
(db-add-evaluation db (make-dummy-eval))
(db-add-evaluation db (make-dummy-eval))
(db-add-evaluation db (make-dummy-eval))
@@ -206,19 +177,16 @@ INSERT INTO Evaluations (specification, commits) VALUES
(3, 3);")
(test-equal "db-get-pending-derivations"
'("/bar.drv" "/foo.drv")
(with-temporary-database db
- ;; Populate the 'Builds', 'Derivations', 'Evaluations', and
+ ;; Populate the 'Builds', 'Evaluations', and
;; 'Specifications' tables. Here, two builds map to the same derivation
;; but the result of 'db-get-pending-derivations' must not contain any
;; duplicate.
- (db-add-build db (make-dummy-build 1 #:drv "/foo.drv"
+ (db-add-build db (make-dummy-build "/foo.drv" 1
#:outputs `(("out" . "/foo"))))
- (db-add-build db (make-dummy-build 2 #:drv "/bar.drv"
+ (db-add-build db (make-dummy-build "/bar.drv" 2
#:outputs `(("out" . "/bar"))))
- (db-add-build db (make-dummy-build 3 #:drv "/foo.drv"
+ (db-add-build db (make-dummy-build "/foo.drv" 3
#:outputs `(("out" . "/foo"))))
- (db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
- (db-add-derivation db (make-dummy-derivation "/bar.drv" 2))
- (db-add-derivation db (make-dummy-derivation "/foo.drv" 3))
(db-add-evaluation db (make-dummy-eval))
(db-add-evaluation db (make-dummy-eval))
(db-add-evaluation db (make-dummy-eval))
diff --git a/tests/http.scm b/tests/http.scm
index e05fdc5..a9fc3ef 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -142,6 +142,9 @@
(let* ((build1
`((#:derivation . "/gnu/store/fake.drv")
(#:eval-id . 1)
+ (#:job-name . "fake-job")
+ (#:system . "x86_64-linux")
+ (#:nix-name . "fake-1.0")
(#:log . "unused so far")
(#:status . ,(build-status succeeded))
(#:outputs . (("out" . "/gnu/store/fake-1.0")))
@@ -151,24 +154,15 @@
(build2
`((#:derivation . "/gnu/store/fake2.drv")
(#:eval-id . 1)
+ (#:job-name . "fake-job")
+ (#:system . "x86_64-linux")
+ (#:nix-name . "fake-2.0")
(#:log . "unused so far")
(#:status . ,(build-status scheduled))
(#:outputs . (("out" . "/gnu/store/fake-2.0")))
(#:timestamp . 1501347493)
(#:starttime . 0)
(#:stoptime . 0)))
- (derivation1
- '((#:derivation . "/gnu/store/fake.drv")
- (#:job-name . "fake-job")
- (#:system . "x86_64-linux")
- (#:nix-name . "fake-1.0")
- (#:eval-id . 1)))
- (derivation2
- '((#:derivation . "/gnu/store/fake2.drv")
- (#:job-name . "fake-job")
- (#:system . "x86_64-linux")
- (#:nix-name . "fake-2.0")
- (#:eval-id . 1)))
(specification
'((#:name . "guix")
(#:load-path-inputs . ("savannah"))
@@ -192,8 +186,6 @@
(#:commits . ("fakesha2" "fakesha3")))))
(db-add-build (%db) build1)
(db-add-build (%db) build2)
- (db-add-derivation (%db) derivation1)
- (db-add-derivation (%db) derivation2)
(db-add-specification (%db) specification)
(db-add-evaluation (%db) evaluation1)
(db-add-evaluation (%db) evaluation2)))
