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=?.

2 files changed, 56 insertions, 30 deletions

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<?)))
diff --git a/tests/http.scm b/tests/http.scm
index 38e4175..ae56356 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -44,9 +44,12 @@
               (hash-table-keys t2))
        (hash-fold (lambda (key value result)
                     (and result
-                         (let ((equal? (if (hash-table? value)
-                                           hash-table=?
-                                           equal?)))
+                         (let ((equal?
+                                (match value
+                                  ((? hash-table?) hash-table=?)
+                                  (((? hash-table?) ...)
+                                   (cut every hash-table=? <> <>))
+                                  (_ 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"
@@ -180,18 +186,33 @@
                             (#: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)))