Subject: bug#32424: closed (Re: [bug#32424] [PATCH] database: Add a Checkouts table.)

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 27 Aug 2018 13:49:02 +0000

Your bug report

#32424: [PATCH] database: Add a Checkouts table.

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
32424: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=32424
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: [bug#32424] [PATCH] database: Add a Checkouts table.
From: Clément Lassieur <[email-masked]>
To: Ludovic Courtès <[email-masked]>
Cc: [email-masked]
Date: Mon, 27 Aug 2018 15:47:50 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Ludovic Courtès <[email-masked]> writes:

> Hello,
>
> Clément Lassieur <[email-masked]> skribis:
>
>> 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/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-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=?.
>
> Woow!  I really like the result (nice screenshot ;-)).  I took only a
> cursory look at the code, but you’re the expert now anyway, so if it
> works for you, got for it!  The new ‘Checkouts’ table make sense to me.
>
>> +         (log-message "Evaluation ~a for '~a' completed" eval-id spec-name)
>
> Nitpick: I prefer not to capitalize log messages because these are not
> full sentences.  (No big deal though.)
>
> Thank you!
>
> Ludo’.

Pushed with that change.  Thanks!

Subject: [PATCH] database: Add a Checkouts table.
From: Clément Lassieur <[email-masked]>
To: [email-masked]
Date: Sun, 12 Aug 2018 00:26:36 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

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/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-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=?.
---
 Makefile.am               |   3 +-
 bin/evaluate.in           |   4 +-
 doc/cuirass.texi          |  33 ++++++++++---
 src/cuirass/base.scm      |  49 ++++++++-----------
 src/cuirass/database.scm  | 100 ++++++++++++++++++++++++++------------
 src/cuirass/templates.scm |  35 ++++++++-----
 src/schema.sql            |  16 ++++--
 src/sql/upgrade-3.sql     |  46 ++++++++++++++++++
 tests/database.scm        |  31 +++++++-----
 tests/http.scm            |  55 ++++++++++++++-------
 10 files changed, 255 insertions(+), 117 deletions(-)
 create mode 100644 src/sql/upgrade-3.sql

diff --git a/Makefile.am b/Makefile.am
index db56165..2f83659 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -66,7 +66,8 @@ dist_pkgdata_DATA = src/schema.sql
 
 dist_sql_DATA = 				\
   src/sql/upgrade-1.sql				\
-  src/sql/upgrade-2.sql
+  src/sql/upgrade-2.sql				\
+  src/sql/upgrade-3.sql
 
 dist_css_DATA =					\
   src/static/css/bootstrap.css			\
diff --git a/bin/evaluate.in b/bin/evaluate.in
index 3f08b92..19d0f12 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -44,7 +44,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
 (define (input-checkout checkouts input-name)
   "Find in CHECKOUTS the CHECKOUT corresponding to INPUT-NAME, and return it."
   (find (lambda (checkout)
-          (string=? (assq-ref checkout #:name)
+          (string=? (assq-ref checkout #:input)
                     input-name))
         checkouts))
 
@@ -91,7 +91,7 @@ entries are added because they could be useful during the evaluation."
        (match in
          (()
           (cons name out))
-         (((#:name . val) . rest)
+         (((#:input . val) . rest)
           (loop rest out (string->symbol val)))
          (((#:directory . val) . rest)
           (loop rest (cons `(file-name . ,val) out) name))
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index b51cfad..08ca832 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -249,7 +249,7 @@ 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{Builds} and
+@code{Inputs}, @code{Checkouts}, @code{Evaluations}, @code{Builds} and
 @code{Outputs}.  The purpose of each of these tables is explained below.
 
 @section Specifications
@@ -334,16 +334,33 @@ When this integer field holds the value @code{1} Cuirass will skip
 compilation for the specified repository.
 @end table
 
-@section Stamps
-@cindex stamps, database
+@section Checkouts
+@cindex checkouts, database
 
 When a specification is processed, the repositories must be downloaded at a
-certain revision as specified.  The @code{Stamps} table stores the current
-revisions for every specification when it is being processed.
+certain revision as specified.  The download is called a checkout.  The
+@code{Checkouts} table stores the new checkouts for every specification when
+it is being processed.
 
-The table only has two text columns: @code{specification}, which references a
-specification from the @code{Specifications} table via the field @code{name},
-and @code{stamp}, which holds the revisions (space separated commit hashes).
+The @code{Checkouts} table has the following columns:
+
+@table @code
+@item specification
+The specification associated with the checkout.
+
+@item revision
+The revision of the checkout. Within the same specification, two checkouts
+can't be identical: they can't have the same revision.
+
+@item evaluation
+The evaluation that was triggered by the addition of that new checkout.
+
+@item input
+The input associated with the checkout.
+
+@item directory
+The directory into which the checkout was extracted.
+@end table
 
 @section Evaluations
 @cindex evaluations, database
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index abbdb7b..52cd595 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -178,7 +178,7 @@ read-only directory."
                                                (string-append
                                                 (%package-cachedir) "/" name))
                            directory)))
-        `((#:name . ,name)
+        `((#:input . ,name)
           (#:directory . ,directory)
           (#:commit . ,commit)
           (#:load-path . ,(assq-ref input #:load-path))
@@ -248,10 +248,10 @@ fibers."
                    (logior (@ (fibers epoll) EPOLLERR)
                            (@ (fibers epoll) EPOLLHUP)))))
 
-(define (evaluate store spec checkouts commits)
+(define (evaluate store spec eval-id checkouts)
   "Evaluate and build package derivations defined in SPEC, using CHECKOUTS.
-Return a list of jobs."
-  (define (augment-job job eval-id)
+Return a list of jobs that are associated to EVAL-ID."
+  (define (augment-job job)
     (let ((drv (read-derivation-from-file
                 (assq-ref job #:derivation))))
       `((#:eval-id . ,eval-id)
@@ -275,14 +275,9 @@ Return a list of jobs."
     (close-pipe port)
     (match result
       (('evaluation jobs)
-       (let* ((spec-name (assq-ref spec #:name))
-              (eval-id (db-add-evaluation
-                        `((#:specification . ,spec-name)
-                          (#:commits . ,commits)))))
-         (log-message "created evaluation ~a for '~a'" eval-id spec-name)
-         (map (lambda (job)
-                (augment-job job eval-id))
-              jobs))))))
+       (let* ((spec-name (assq-ref spec #:name)))
+         (log-message "Evaluation ~a for '~a' completed" eval-id spec-name)
+         (map augment-job jobs))))))
 
 
 ;;;
@@ -539,7 +534,7 @@ started)."
       (spawn-builds store valid)
       (log-message "done with restarted builds"))))
 
-(define (build-packages store jobs)
+(define (build-packages store jobs eval-id)
   "Build JOBS and return a list of Build results."
   (define (register job)
     (let* ((name     (assq-ref job #:job-name))
@@ -576,6 +571,10 @@ started)."
   (define derivations
     (filter-map register jobs))
 
+  (log-message "Evaluation ~a registered ~a new derivations"
+               eval-id (length derivations))
+  (db-set-evaluation-done eval-id)
+
   (spawn-builds store derivations)
 
   (let* ((results (filter-map (cut db-get-build <>) derivations))
@@ -625,7 +624,7 @@ started)."
          (results (par-map %non-blocking thunks)))
     (map (lambda (checkout)
            (log-message "fetched input '~a' of spec '~a' (commit ~s)"
-                        (assq-ref checkout #:name)
+                        (assq-ref checkout #:input)
                         (assq-ref spec #:name)
                         (assq-ref checkout #:commit))
            checkout)
@@ -638,7 +637,7 @@ started)."
            (lambda (checkout)
              (lambda ()
                (log-message "compiling input '~a' of spec '~a' (commit ~s)"
-                            (assq-ref checkout #:name)
+                            (assq-ref checkout #:input)
                             (assq-ref spec #:name)
                             (assq-ref checkout #:commit))
                (compile checkout)))
@@ -646,7 +645,7 @@ started)."
          (results (par-map %non-blocking thunks)))
     (map (lambda (checkout)
            (log-message "compiled input '~a' of spec '~a' (commit ~s)"
-                        (assq-ref checkout #:name)
+                        (assq-ref checkout #:input)
                         (assq-ref spec #:name)
                         (assq-ref checkout #:commit))
            checkout)
@@ -656,15 +655,10 @@ started)."
   "Evaluate and build JOBSPECS and store results in the database."
   (define (process spec)
     (with-store store
-      (let* ((stamp (db-get-stamp spec))
-             (name (assoc-ref spec #:name))
+      (let* ((name (assoc-ref spec #:name))
              (checkouts (fetch-inputs spec))
-             (commits (map (cut assq-ref <> #:commit) checkouts))
-             (commits-str (string-join commits)))
-        (unless (equal? commits-str stamp)
-          ;; Immediately mark SPEC's INPUTS as being processed so we don't
-          ;; spawn a concurrent evaluation of that same commit.
-          (db-add-stamp spec commits-str)
+             (eval-id (db-add-evaluation name checkouts)))
+        (when eval-id
           (compile-checkouts spec (filter compile? checkouts))
           (spawn-fiber
            (lambda ()
@@ -672,13 +666,12 @@ started)."
                         (log-message "failed to evaluate spec '~a'"
                                      (evaluation-error-spec-name c))
                         #f))
-               (log-message "evaluating spec '~a': stamp ~s different from ~s"
-                            name commits-str stamp)
+               (log-message "evaluating spec '~a'" name)
                (with-store store
-                 (let ((jobs (evaluate store spec checkouts commits)))
+                 (let ((jobs (evaluate store spec eval-id checkouts)))
                    (log-message "building ~a jobs for '~a'"
                                 (length jobs) name)
-                   (build-packages store jobs))))))
+                   (build-packages store jobs eval-id))))))
 
           ;; 'spawn-fiber' returns zero values but we need one.
           *unspecified*))))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 2cd3c1f..6987bf0 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -38,9 +38,8 @@
             db-close
             db-add-specification
             db-get-specifications
-            db-add-stamp
-            db-get-stamp
             db-add-evaluation
+            db-set-evaluation-done
             db-get-pending-derivations
             build-status
             db-add-build
@@ -265,6 +264,29 @@ tag, revision, no_compile_p) VALUES ("
                  (if (assq-ref input #:no-compile?) 1 0) ");")
     (last-insert-rowid db)))
 
+(define (db-add-checkout spec-name eval-id checkout)
+  "Insert CHECKOUT associated with SPEC-NAME and EVAL-ID.  If a checkout with
+the same revision already exists for SPEC-NAME, return #f."
+  (with-db-critical-section db
+    (catch 'sqlite-error
+      (lambda ()
+        (sqlite-exec db "\
+INSERT INTO Checkouts (specification, revision, evaluation, input,
+directory) VALUES ("
+                     spec-name ", "
+                     (assq-ref checkout #:commit) ", "
+                     eval-id ", "
+                     (assq-ref checkout #:input) ", "
+                     (assq-ref checkout #:directory) ");")
+        (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 checkout.  That happens for each input
+        ;; that doesn't change between two evaluations.
+        (if (= code SQLITE_CONSTRAINT_PRIMARYKEY)
+            #f
+            (apply throw key who code rest))))))
+
 (define (db-add-specification spec)
   "Store SPEC in database the database.  SPEC inputs are stored in the INPUTS
 table."
@@ -328,13 +350,27 @@ package_path_inputs, proc_input, proc_file, proc, proc_args) \
                        (#:inputs . ,(db-get-inputs name)))
                      specs)))))))
 
-(define (db-add-evaluation eval)
+(define (db-add-evaluation spec-name checkouts)
+  "Add a new evaluation for SPEC-NAME only if one of the CHECKOUTS is new.
+Otherwise, return #f."
   (with-db-critical-section db
-    (sqlite-exec db "\
-INSERT INTO Evaluations (specification, commits) VALUES ("
-                 (assq-ref eval #:specification) ", "
-                 (string-join (assq-ref eval #:commits)) ");")
-    (last-insert-rowid db)))
+    (sqlite-exec db "BEGIN TRANSACTION;")
+    (sqlite-exec db "INSERT INTO Evaluations (specification, in_progress)
+VALUES (" spec-name ", true);")
+    (let* ((eval-id (last-insert-rowid db))
+           (new-checkouts (filter-map
+                           (cut db-add-checkout spec-name eval-id <>)
+                           checkouts)))
+      (if (null? new-checkouts)
+          (begin (sqlite-exec db "ROLLBACK;")
+                 #f)
+          (begin (sqlite-exec db "COMMIT;")
+                 eval-id)))))
+
+(define (db-set-evaluation-done eval-id)
+  (with-db-critical-section db
+    (sqlite-exec db "UPDATE Evaluations SET in_progress = false
+WHERE id = " eval-id ";")))
 
 (define-syntax-rule (with-database body ...)
   "Run BODY with %DB-CHANNEL being dynamically bound to a channel implementing
@@ -568,46 +604,44 @@ the database.  The returned list is guaranteed to not have any duplicates."
          (sqlite-exec db "
 SELECT derivation FROM Builds WHERE Builds.status < 0;"))))
 
-(define (db-get-stamp spec)
-  "Return a stamp corresponding to specification SPEC in the database."
+(define (db-get-checkouts eval-id)
   (with-db-critical-section db
-    (let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification="
-                            (assq-ref spec #:name) ";")))
-      (match res
-        (() #f)
-        ((#(spec stamp)) stamp)))))
-
-(define (db-add-stamp spec stamp)
-  "Associate STAMP to specification SPEC in the database."
-  (with-db-critical-section db
-    (if (db-get-stamp spec)
-        (sqlite-exec db "UPDATE Stamps SET stamp=" stamp
-                     "WHERE specification=" (assq-ref spec #:name) ";")
-        (sqlite-exec db "\
-INSERT INTO Stamps (specification, stamp) VALUES ("
-                     (assq-ref spec #:name) ", " stamp ");"))))
+    (let loop ((rows (sqlite-exec
+                      db "SELECT revision, input, directory FROM Checkouts
+WHERE evaluation =" eval-id ";"))
+               (checkouts '()))
+      (match rows
+        (() checkouts)
+        ((#(revision input directory)
+           . rest)
+         (loop rest
+               (cons `((#:commit . ,revision)
+                       (#:input . ,input)
+                       (#:directory . ,directory))
+                     checkouts)))))))
 
 (define (db-get-evaluations limit)
   (with-db-critical-section db
-    (let loop ((rows  (sqlite-exec db "SELECT id, specification, commits
+    (let loop ((rows  (sqlite-exec db "SELECT id, specification, in_progress
 FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
                (evaluations '()))
       (match rows
         (() (reverse evaluations))
-        ((#(id specification commits)
+        ((#(id specification in-progress)
            . rest)
          (loop rest
                (cons `((#:id . ,id)
                        (#:specification . ,specification)
-                       (#:commits . ,(string-tokenize commits)))
+                       (#:in-progress . ,in-progress)
+                       (#:checkouts . ,(db-get-checkouts id)))
                      evaluations)))))))
 
 (define (db-get-evaluations-build-summary spec limit border-low border-high)
   (with-db-critical-section db
     (let loop ((rows (sqlite-exec db "
-SELECT E.id, E.commits, B.succeeded, B.failed, B.scheduled
+SELECT E.id, E.in_progress, B.succeeded, B.failed, B.scheduled
 FROM
-(SELECT id, commits
+(SELECT id, in_progress
 FROM Evaluations
 WHERE (specification=" spec ")
 AND (" border-low "IS NULL OR (id >" border-low "))
@@ -624,10 +658,12 @@ ORDER BY E.id ASC;"))
                (evaluations '()))
       (match rows
         (() evaluations)
-        ((#(id commits succeeded failed scheduled) . rest)
+        ((#(id in-progress succeeded failed scheduled) . rest)
          (loop rest
                (cons `((#:id . ,id)
-                       (#:commits . ,commits)
+                       (#:in-progress . ,in-progress)
+                       (#:checkouts . ,(db-get-checkouts id))
+                       (#:in-progress . ,in-progress)
                        (#:succeeded . ,(or succeeded 0))
                        (#:failed . ,(or failed 0))
                        (#:scheduled . ,(or scheduled 0)))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 6ba3a06..7ee579c 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -100,6 +100,27 @@
                        (href ,last-link))
                     "Last >>"))))))
 
+(define (input-changes checkouts)
+  (let ((changes
+         (string-join
+          (map (lambda (checkout)
+                 (let ((input (assq-ref checkout #:input))
+                       (commit (assq-ref checkout #:commit)))
+                   (format #f "~a → ~a" input (substring commit 0 7))))
+               checkouts)
+          ", ")))
+    (if (string=? changes "") '(em "None") changes)))
+
+(define (evaluation-badges evaluation)
+  (if (zero? (assq-ref evaluation #:in-progress))
+      `((a (@ (href "#") (class "badge badge-success"))
+           ,(assq-ref evaluation #:succeeded))
+        (a (@ (href "#") (class "badge badge-danger"))
+           ,(assq-ref evaluation #:failed))
+        (a (@ (href "#") (class "badge badge-secondary"))
+           ,(assq-ref evaluation #:scheduled)))
+      '((em "In progress…"))))
+
 (define (evaluation-info-table name evaluations id-min id-max)
   "Return HTML for the EVALUATION table NAME. ID-MIN and ID-MAX are
   global minimal and maximal id."
@@ -111,7 +132,7 @@
            `((thead
               (tr
                (th (@ (scope "col")) "#")
-               (th (@ (scope "col")) Commits)
+               (th (@ (scope "col")) "Input changes")
                (th (@ (scope "col")) Success)))
              (tbody
               ,@(map
@@ -119,16 +140,8 @@
                    `(tr (th (@ (scope "row"))
                             (a (@ (href "/eval/" ,(assq-ref row #:id)))
                                ,(assq-ref row #:id)))
-                        (td ,(string-join
-                              (map (cut substring <> 0 7)
-                                   (string-tokenize (assq-ref row #:commits)))
-                              ", "))
-                        (td (a (@ (href "#") (class "badge badge-success"))
-                               ,(assq-ref row #:succeeded))
-                            (a (@ (href "#") (class "badge badge-danger"))
-                               ,(assq-ref row #:failed))
-                            (a (@ (href "#") (class "badge badge-secondary"))
-                               ,(assq-ref row #:scheduled)))))
+                        (td ,(input-changes (assq-ref row #:checkouts)))
+                        (td ,@(evaluation-badges row))))
                  evaluations)))))
     ,(if (null? evaluations)
          (pagination "" "" "" "")
diff --git a/src/schema.sql b/src/schema.sql
index 0452495..ebe32ec 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -24,16 +24,22 @@ CREATE TABLE Inputs (
   FOREIGN KEY (specification) REFERENCES Specifications (name)
 );
 
-CREATE TABLE Stamps (
-  specification TEXT NOT NULL PRIMARY KEY,
-  stamp         TEXT NOT NULL,
-  FOREIGN KEY (specification) REFERENCES Specifications (name)
+CREATE TABLE Checkouts (
+  specification TEXT NOT NULL,
+  revision      INTEGER NOT NULL,
+  evaluation    TEXT NOT NULL,
+  input         TEXT NOT NULL,
+  directory     TEXT NOT NULL,
+  PRIMARY KEY (specification, revision),
+  FOREIGN KEY (evaluation) REFERENCES Evaluations (id),
+  FOREIGN KEY (specification) REFERENCES Specifications (name),
+  FOREIGN KEY (input) REFERENCES Inputs (name)
 );
 
 CREATE TABLE Evaluations (
   id            INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
   specification TEXT NOT NULL,
-  commits       TEXT NOT NULL,
+  in_progress   INTEGER NOT NULL,
   FOREIGN KEY (specification) REFERENCES Specifications (name)
 );
 
diff --git a/src/sql/upgrade-3.sql b/src/sql/upgrade-3.sql
new file mode 100644
index 0000000..8123190
--- /dev/null
+++ b/src/sql/upgrade-3.sql
@@ -0,0 +1,46 @@
+BEGIN TRANSACTION;
+
+ALTER TABLE Evaluations RENAME TO tmp_Evaluations;
+
+CREATE TABLE Evaluations (
+  id            INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
+  specification TEXT NOT NULL,
+  in_progress   INTEGER NOT NULL,
+  FOREIGN KEY (specification) REFERENCES Specifications (name)
+);
+
+CREATE TABLE Checkouts (
+  specification TEXT NOT NULL,
+  revision      INTEGER NOT NULL,
+  evaluation    TEXT NOT NULL,
+  input         TEXT NOT NULL,
+  directory     TEXT NOT NULL,
+  PRIMARY KEY (specification, revision),
+  FOREIGN KEY (evaluation) REFERENCES Evaluations (id),
+  FOREIGN KEY (specification) REFERENCES Specifications (name),
+  FOREIGN KEY (input) REFERENCES Inputs (name)
+);
+
+INSERT INTO Evaluations (id, specification, in_progress)
+SELECT id, specification, false
+FROM tmp_Evaluations;
+
+-- Copied from https://www.samuelbosch.com/2018/02/split-into-rows-sqlite.html.
+INSERT OR IGNORE INTO Checkouts (specification, revision, evaluation, input, directory)
+WITH RECURSIVE split(id, specification, revision, rest) AS (
+  SELECT id, specification, '', commits || ' ' FROM tmp_Evaluations
+   UNION ALL
+  SELECT id, 
+         specification,
+         substr(rest, 0, instr(rest, ' ')),
+         substr(rest, instr(rest, ' ') + 1)
+    FROM split
+   WHERE rest <> '')
+SELECT specification, revision, id, 'unknown', 'unknown'
+  FROM split 
+ WHERE revision <> '';
+
+DROP TABLE tmp_Evaluations;
+DROP TABLE Stamps;
+
+COMMIT;
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"
@@ -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)))
-- 
2.18.0