diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | doc/cuirass.texi | 55 | ||||
| -rw-r--r-- | src/cuirass/base.scm | 25 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 174 | ||||
| -rw-r--r-- | src/schema.sql | 28 | ||||
| -rw-r--r-- | src/sql/upgrade-2.sql | 49 | ||||
| -rw-r--r-- | tests/database.scm | 78 | ||||
| -rw-r--r-- | 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))) |