From 8d40c49170971ad7bbf8b97336934dbb3d949fc1 Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Sat, 11 Aug 2018 20:30:11 +0200 Subject: database: Add a Checkouts table. It is used to know when a new evaluation must be triggered and to display input changes. * Makefile.am (dist_sql_DATA): Add 'src/sql/upgrade-3.sql'. * bin/cuirass.in (main): Call DB-SET-EVALUATION-DONE at startup to clear 'in-progress' evaluations. * bin/evaluate.in (input-checkout, format-checkouts): Rename '#:name' to '#:input'. * doc/cuirass.texi (Stamps): Remove section. (Checkouts): New section. * src/cuirass/base.scm (fetch-input, fetch-inputs, compile-checkouts): Rename '#:name' to '#:input'. (evaluate): Remove the COMMITS argument. Add an EVAL-ID argument. Don't call DB-ADD-EVALUATION because it was called sooner. Remove the EVAL-ID argument to AUGMENT-JOB because it's a closure. (build-packages): Add an EVAL-ID argument. Call DB-SET-EVALUATION-DONE once all the derivations are registered. (process-specs): Replace the stamping mechanism by the primary key constraint of the Checkouts table: call "evaluate" only when DB-ADD-EVALUATION is true, which means that at least one checkout was added. Change the EVALUATE and BUILD-PACKAGES arguments accordingly. * src/cuirass/database.scm (db-add-stamp, db-get-stamp): Remove procedures. (db-set-evaluations-done, db-set-evaluation-done): New exported procedure. (db-add-checkout): New procedure that returns #f if a checkout with the same revision already exists. (db-add-evaluation): Replace the EVAL argument with a SPEC-NAME and a CHECKOUTS arguments. Insert the evaluation only if at least one checkout was inserted. Return #f otherwise. (db-get-checkouts): New procedure. (db-get-evaluations, db-get-evaluations-build-summary): Handle the 'in_progress' column, remove the 'commits' column. Return the result of DB-GET-CHECKOUTS as part of the evaluation. * src/cuirass/templates.scm (input-changes, evaluation-badges): New procedures. (evaluation-info-table): Rename "Commits" to "Input changes". Use INPUT-CHANGES to display the input changes that triggered the evaluation. Use EVALUATION-BADGES to display a message indicating that the evaluation is in progress. * src/schema.sql (Stamps): Remove table. (Checkouts): New table. (Evaluations): Remove the 'commits' column. Add an 'in_progress' column. * src/sql/upgrade-3.sql: New file with SQL queries to upgrade the database. * tests/database.scm (make-dummy-eval): Remove procedure. (make-dummy-checkouts): New procedure. ("sqlite-exec"): Remove the 'commits' column. Add the 'in_progress' column. ("db-update-build-status!", "db-get-builds", "db-get-pending-derivations"): Update the arguments of DB-ADD-EVALUATION accordingly. * tests/http.scm (hash-table=?): Add support for lists of hash tables. (evaluations-query-result): Replace '#:commits' with '#:checkouts'. Return a list instead of returning one element, for symmetry. ("fill-db"): Add a new input so that the second checkout can refer to it. Replace EVALUATION1 and EVALUATION2 with CHECKOUTS1 and CHECKOUTS2. Update the arguments of DB-ADD-EVALUATION accordingly. ("/api/queue?nr=100"): Take the CAR of the EVALUATIONS-QUERY-RESULT list to make it symmetrical with the other argument of HASH-TABLE=?. --- tests/database.scm | 31 +++++++++++++++++------------- tests/http.scm | 55 +++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 56 insertions(+), 30 deletions(-) (limited to 'tests') diff --git a/tests/database.scm b/tests/database.scm index cdc7872..21a12f4 100644 --- a/tests/database.scm +++ b/tests/database.scm @@ -47,9 +47,13 @@ (#:commit . #f) (#:no-compile? . #f)))))) -(define* (make-dummy-eval #:optional (commits '("cabba3e 61730ea"))) - `((#:specification . "guix") - (#:commits . ,commits))) +(define (make-dummy-checkouts fakesha1 fakesha2) + `(((#:commit . ,fakesha1) + (#:input . "guix") + (#:directory . "foo")) + ((#:commit . ,fakesha2) + (#:input . "packages") + (#:directory . "bar")))) (define* (make-dummy-build drv #:optional (eval-id 42) @@ -88,11 +92,11 @@ (test-assert "sqlite-exec" (begin (sqlite-exec (%db) "\ -INSERT INTO Evaluations (specification, commits) VALUES (1, 1);") +INSERT INTO Evaluations (specification, in_progress) VALUES (1, false);") (sqlite-exec (%db) "\ -INSERT INTO Evaluations (specification, commits) VALUES (2, 2);") +INSERT INTO Evaluations (specification, in_progress) VALUES (2, false);") (sqlite-exec (%db) "\ -INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") +INSERT INTO Evaluations (specification, in_progress) VALUES (3, false);") (sqlite-exec (%db) "SELECT * FROM Evaluations;"))) (test-equal "db-add-specification" @@ -121,7 +125,8 @@ INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") #:outputs '(("out" . "/foo"))))) (get-status (lambda* (#:optional (key #:status)) (assq-ref (db-get-build derivation) key)))) - (db-add-evaluation (make-dummy-eval)) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" + "fakesha2")) (db-add-specification example-spec) (let ((status0 (get-status))) @@ -157,9 +162,9 @@ INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") #:outputs `(("out" . "/bar")))) (db-add-build (make-dummy-build "/baz.drv" 3 #:outputs `(("out" . "/baz")))) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha2")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha3")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakssha2" "fakesha3")) (db-add-specification example-spec) (db-update-build-status! "/bar.drv" (build-status started) @@ -188,9 +193,9 @@ INSERT INTO Evaluations (specification, commits) VALUES (3, 3);") #:outputs `(("out" . "/bar")))) (db-add-build (make-dummy-build "/foo.drv" 3 #:outputs `(("out" . "/foo")))) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) - (db-add-evaluation (make-dummy-eval)) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha2")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1" "fakesha3")) + (db-add-evaluation "guix" (make-dummy-checkouts "fakssha2" "fakesha3")) (db-add-specification example-spec) (sort (db-get-pending-derivations) string <>)) + (_ equal?)))) (equal? value (hash-ref t2 key))))) #t @@ -95,9 +98,12 @@ (#:buildinputs_builds . #nil))) (define evaluations-query-result - '((#:id . 2) - (#:specification . "guix") - (#:commits . ("fakesha2" "fakesha3")))) + '(((#:id . 2) + (#:specification . "guix") + (#:in-progress . 1) + (#:checkouts . (((#:commit . "fakesha2") + (#:input . "savannah") + (#:directory . "dir3"))))))) (test-group-with-cleanup "http" (test-assert "object->json-string" @@ -175,23 +181,38 @@ (#:proc . hydra-jobs) (#:proc-args (subset . "hello")) (#:inputs . (((#:name . "savannah") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:branch . "master") + (#:tag . #f) + (#:commit . #f) + (#:no-compile? . #f)) + ((#:name . "packages") (#:url . "git://git.savannah.gnu.org/guix.git") (#:load-path . ".") (#:branch . "master") (#:tag . #f) (#:commit . #f) (#:no-compile? . #f)))))) - (evaluation1 - '((#:specification . "guix") - (#:commits . ("fakesha1" "fakesha3")))) - (evaluation2 - '((#:specification . "guix") - (#:commits . ("fakesha2" "fakesha3"))))) + (checkouts1 + '(((#:commit . "fakesha1") + (#:input . "savannah") + (#:directory . "dir1")) + ((#:commit . "fakesha3") + (#:input . "packages") + (#:directory . "dir2")))) + (checkouts2 + '(((#:commit . "fakesha2") + (#:input . "savannah") + (#:directory . "dir3")) + ((#:commit . "fakesha3") + (#:input . "packages") + (#:directory . "dir4"))))) (db-add-build build1) (db-add-build build2) (db-add-specification specification) - (db-add-evaluation evaluation1) - (db-add-evaluation evaluation2))) + (db-add-evaluation "guix" checkouts1) + (db-add-evaluation "guix" checkouts2))) (test-assert "/build/1" (hash-table=? @@ -271,9 +292,9 @@ (and (= (length hash-list) 1) (hash-table=? (car hash-list) - (call-with-input-string - (object->json-string evaluations-query-result) - json->scm))))) + (car (call-with-input-string + (object->json-string evaluations-query-result) + json->scm)))))) (test-assert "db-close" (db-close (%db))) -- cgit v1.2.3