guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Mathieu Othacehe
Date: Sun, 3 Jan 2021 05:18:54 -0500 (EST)

branch: wip-offload
commit 828322ec9ce1236e87fc16a94a2220cb374e4f80
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sun Dec 27 13:00:54 2020 +0100

    Switch to PostgreSQL.
---
 .dir-locals.el                |    3 -
 Makefile.am                   |   26 +-
 README                        |   78 +-
 bin/cuirass.in                |  171 ++---
 build-aux/guix.scm            |    6 +-
 configure.ac                  |    2 +-
 doc/cuirass.texi              |   14 +-
 src/cuirass/base.scm          |    3 +-
 src/cuirass/database.scm      | 1567 +++++++++++++++++++----------------------
 src/cuirass/http.scm          |    4 +-
 src/cuirass/metrics.scm       |  279 ++++----
 src/cuirass/remote-server.scm |  113 +--
 src/cuirass/templates.scm     |    2 +
 src/cuirass/utils.scm         |   74 +-
 src/schema.sql                |   62 +-
 src/sql/upgrade-1.sql         |   75 --
 src/sql/upgrade-10.sql        |   12 -
 src/sql/upgrade-11.sql        |   11 -
 src/sql/upgrade-12.sql        |    7 -
 src/sql/upgrade-13.sql        |    5 -
 src/sql/upgrade-14.sql        |    5 -
 src/sql/upgrade-15.sql        |    7 -
 src/sql/upgrade-16.sql        |    5 -
 src/sql/upgrade-17.sql        |    5 -
 src/sql/upgrade-18.sql        |   10 -
 src/sql/upgrade-19.sql        |   11 -
 src/sql/upgrade-2.sql         |   49 --
 src/sql/upgrade-3.sql         |   46 --
 src/sql/upgrade-4.sql         |   18 -
 src/sql/upgrade-5.sql         |   15 -
 src/sql/upgrade-6.sql         |   47 --
 src/sql/upgrade-7.sql         |   15 -
 src/sql/upgrade-8.sql         |    7 -
 src/sql/upgrade-9.sql         |    9 -
 tests/database.scm            |  401 ++++++++---
 tests/http.scm                |   26 +-
 tests/metrics.scm             |  149 ++--
 37 files changed, 1532 insertions(+), 1807 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 0423a7e..b0223cc 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -13,9 +13,6 @@
   (eval put 'test-error 'scheme-indent-function 1)
   (eval put 'make-parameter 'scheme-indent-function 1)
   (eval put 'with-database 'scheme-indent-function 0)
-  (eval put 'with-queue-writer-worker 'scheme-indent-function 0)
-  (eval put 'with-db-worker-thread 'scheme-indent-function 1)
-  (eval put 'with-db-writer-worker-thread 'scheme-indent-function 1))
  (texinfo-mode
   (indent-tabs-mode)
   (fill-column . 72)
diff --git a/Makefile.am b/Makefile.am
index 59d2c25..280ccae 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -79,25 +79,7 @@ nodist_webobject_DATA =                              \
 dist_pkgdata_DATA = src/schema.sql
 
 dist_sql_DATA =                                \
-  src/sql/upgrade-1.sql                                \
-  src/sql/upgrade-2.sql                                \
-  src/sql/upgrade-3.sql                                \
-  src/sql/upgrade-4.sql                                \
-  src/sql/upgrade-5.sql                                \
-  src/sql/upgrade-6.sql                        \
-  src/sql/upgrade-7.sql                                \
-  src/sql/upgrade-8.sql                                \
-  src/sql/upgrade-9.sql                                \
-  src/sql/upgrade-10.sql                       \
-  src/sql/upgrade-11.sql                       \
-  src/sql/upgrade-12.sql                       \
-  src/sql/upgrade-13.sql                       \
-  src/sql/upgrade-14.sql                       \
-  src/sql/upgrade-15.sql                       \
-  src/sql/upgrade-16.sql                       \
-  src/sql/upgrade-17.sql                       \
-  src/sql/upgrade-18.sql                       \
-  src/sql/upgrade-19.sql
+  src/sql/upgrade-1.sql
 
 dist_css_DATA =                                        \
   src/static/css/cuirass.css                   \
@@ -163,12 +145,6 @@ CLEANFILES =                                       \
   $(nodist_guileobject_DATA)                   \
   src/cuirass/config.go
 
-.PHONY:        sql-check
-sql-check: src/schema.sql
-       @echo "$<"
-       $(AM_V_at)sqlite3 tmp-$$$.db < $< ; \
-       rm tmp-$$$.db
-
 ## -------------- ##
 ## Distribution.  ##
 ## -------------- ##
diff --git a/README b/README
index 18aa37c..9758bbc 100644
--- a/README
+++ b/README
@@ -1,8 +1,8 @@
-Cuirass is a continuous integration tool using GNU Guix.  It is intended as a
-replacement for Hydra.
+-*- mode: org -*-
 
-Requirements
-============
+Cuirass is a continuous integration tool using GNU Guix.
+
+* Requirements
 
 Cuirass currently depends on the following packages:
 
@@ -10,7 +10,7 @@ Cuirass currently depends on the following packages:
   - GNU Guix (and all its development dependencies)
   - GNU Make
   - Guile-JSON 3.x
-  - Guile-SQLite3
+  - Guile-Squee
   - Guile-Git
   - Guile-zlib
   - Fibers
@@ -18,52 +18,94 @@ Cuirass currently depends on the following packages:
 A convenient way to install those dependencies is to install Guix and execute
 the following command:
 
+#+BEGIN_EXAMPLE
    $ guix environment -l build-aux/guix.scm
+#+END_EXAMPLE
 
 This will build and enter an environment which provides all the necessary
 dependencies.
 
-Build Instructions
-==================
+* Build Instructions
 
 When all the dependencies are available on you system, in order to build and
 install Cuirass, you can proceed with the usual:
 
+#+BEGIN_EXAMPLE
    $ ./configure && sudo make install
+#+END_EXAMPLE
 
 An alternative way is to directly install Cuirass in your Guix profile, using:
 
+#+BEGIN_EXAMPLE
    $ guix package -f build-aux/guix.scm
+#+END_EXAMPLE
 
 To build it, but not install it, run:
 
+#+BEGIN_EXAMPLE
    $ guix build -f build-aux/guix.scm
+#+END_EXAMPLE
+
+* Database connection
+
+Cuirass uses PostgreSQL to store information about jobs, past build results
+and to coordinate the execution of jobs.  The database connection string must
+be passed to Cuirass using the =database= argument, under the keyword/value
+format described 
[[https://www.postgresql.org/docs/10/libpq-connect.html#LIBPQ-CONNSTRING][here]].
  The PostgreSQL database must be created beforehand.
+
+For instance, to connect using Unix sockets to the =cuirass= database:
+
+#+BEGIN_EXAMPLE
+  ./pre-inst-env cuirass --database="dbname=cuirass host=/var/run/postgresql"
+#+END_EXAMPLE
+
+or using a TCP connection:
+
+#+BEGIN_EXAMPLE
+  ./pre-inst-env cuirass --database="dbname=cuirass host=127.0.0.1"
+#+END_EXAMPLE
+
+* Run tests
+
+Cuirass tests also require an access to a PostgreSQL database.  This database
+must be dedicated to testing as its content will be dropped.  The database
+name and host must be passed using =CUIRASS_DATABASE= and =CUIRASS_HOST=
+environment variables respectively.
+
+#+BEGIN_EXAMPLE
+CUIRASS_DATABASE="test_tmp" CUIRASS_HOST="/var/run/postgresql" make check 
+#+END_EXAMPLE
 
-Example
-=======
+* Example
 
 A quick way to manually test Cuirass is to execute:
 
-  ./pre-inst-env cuirass --specifications=examples/hello-singleton.scm 
--database=test.db
+#+BEGIN_EXAMPLE
+  ./pre-inst-env cuirass --specifications=examples/hello-singleton.scm 
--database="dbname=cuirass host=/var/run/postgresql"
+#+END_EXAMPLE
 
-This will read the file "examples/hello-singleton.scm" which contains a list of
-specifications and add them to the database "test.db" which is created if it
-doesn't already exist.
+This will read the file "examples/hello-singleton.scm" which contains a list
+of specifications and add them to the =cuirass= database.
 
-'cuirass' then loops evaluating/building the specs.  The database keeps track
+Cuirass then loops evaluating/building the specs.  The database keeps track
 of the specifications in order to allow users to accumulate specifications.
 To resume the evaluation/build process you can execute the same command
 without the '--specifications' option:
 
-  ./pre-inst-env cuirass --database=test.db
+#+BEGIN_EXAMPLE
+  ./pre-inst-env cuirass --database="dbname=cuirass host=/var/run/postgresql"
+#+END_EXAMPLE
 
 To start the web interface run:
 
-  ./pre-inst-env cuirass --web
+#+BEGIN_EXAMPLE
+  ./pre-inst-env cuirass --database="dbname=cuirass host=/var/run/postgresql" 
--web
+#+END_EXAMPLE
 
-Contributing
-============
+* Contributing
 
 See the manual for useful hacking informations, by running
 
+#+BEGIN_EXAMPLE
   info -f doc/cuirass.info "Contributing"
+#+END_EXAMPLE
diff --git a/bin/cuirass.in b/bin/cuirass.in
index 20c2447..81247cd 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -57,8 +57,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
   -p  --port=NUM            Port of the HTTP server.
       --listen=HOST         Listen on the network interface for HOST
   -I, --interval=N          Wait N seconds between each poll
-  -Q, --queue-size=N        Set the writer queue size to N elements.
-      --log-queries=FILE    Log SQL queries in FILE.
       --build-remote        Use the remote build mechanism
       --use-substitutes     Allow usage of pre-built substitutes
       --record-events       Record events for distribution
@@ -77,12 +75,10 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" 
"$@"
     (port           (single-char #\p) (value #t))
     (listen                           (value #t))
     (interval       (single-char #\I) (value #t))
-    (queue-size     (single-char #\Q) (value #t))
     (build-remote                     (value #f))
     (use-substitutes                  (value #f))
     (threads                          (value #t))
     (fallback                         (value #f))
-    (log-queries                      (value #t))
     (record-events                    (value #f))
     (ttl                              (value #t))
     (version        (single-char #\V) (value #f))
@@ -110,9 +106,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" 
"$@"
          (%fallback? (option-ref opts 'fallback #f))
          (%record-events? (option-ref opts 'record-events #f))
          (%gc-root-ttl
-          (time-second (string->duration (option-ref opts 'ttl "30d"))))
-         (%db-writer-queue-size
-          (string->number (option-ref opts 'queue-size "1"))))
+          (time-second (string->duration (option-ref opts 'ttl "30d")))))
       (cond
        ((option-ref opts 'help #f)
         (show-help)
@@ -129,7 +123,6 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" 
"$@"
               (host (option-ref opts 'listen "localhost"))
               (interval (string->number (option-ref opts 'interval "300")))
               (specfile (option-ref opts 'specifications #f))
-              (queries-file (option-ref opts 'log-queries #f))
 
               ;; Since our work is mostly I/O-bound, default to a maximum of 4
               ;; kernel threads.  Going beyond that can increase overhead (GC
@@ -140,95 +133,87 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" 
"$@"
                              (min (current-processor-count) 4))))
           (prepare-git)
 
-          (unless (option-ref opts 'web #f)
-            (log-message "performing database optimizations")
-            (db-optimize))
-
           (log-message "running Fibers on ~a kernel threads" threads)
           (run-fibers
            (lambda ()
              (with-database
-               (with-queue-writer-worker
-                 (and specfile
-                      (let ((new-specs (save-module-excursion
-                                        (lambda ()
-                                          (set-current-module
-                                           (make-user-module '()))
-                                          (primitive-load specfile)))))
-                        (for-each db-add-specification new-specs)))
-
-                 (when queries-file
-                   (log-message "Enable SQL query logging.")
-                   (db-log-queries queries-file))
-
-                 (if one-shot?
-                     (process-specs (db-get-specifications))
-                     (let ((exit-channel (make-channel)))
-                       (start-watchdog)
-                       (if (option-ref opts 'web #f)
-                           (begin
-                             (spawn-fiber
-                              (essential-task
-                               'web exit-channel
-                               (lambda ()
-                                 (run-cuirass-server #:host host
-                                                     #:port port)))
-                              #:parallel? #t)
-
-                             (spawn-fiber
-                              (essential-task
-                               'monitor exit-channel
-                               (lambda ()
-                                 (while #t
-                                   (log-monitoring-stats)
-                                   (sleep 600))))))
-
-                           (begin
-                             (clear-build-queue)
-
-                             ;; If Cuirass was stopped during an evaluation,
-                             ;; abort it. Builds that were not registered
-                             ;; during this evaluation will be registered
-                             ;; during the next evaluation.
-                             (db-abort-pending-evaluations)
-
-                             ;; First off, restart builds that had not
-                             ;; completed or were not even started on a
-                             ;; previous run.
-                             (spawn-fiber
-                              (essential-task
-                               'restart-builds exit-channel
-                               (lambda ()
-                                 (restart-builds))))
-
-                             (spawn-fiber
-                              (essential-task
-                               'build exit-channel
-                               (lambda ()
-                                 (while #t
-                                   (process-specs (db-get-specifications))
-                                   (log-message
-                                    "next evaluation in ~a seconds" interval)
-                                   (sleep interval)))))
-
-                             (spawn-fiber
-                              (essential-task
-                               'metrics exit-channel
-                               (lambda ()
-                                 (while #t
-                                   (with-time-logging
-                                    "Metrics update"
-                                    (db-update-metrics))
-                                   (sleep 3600)))))
-
-                             (spawn-fiber
-                              (essential-task
-                               'monitor exit-channel
-                               (lambda ()
-                                 (while #t
-                                   (log-monitoring-stats)
-                                   (sleep 600)))))))
-                       (primitive-exit (get-message exit-channel)))))))
+               (and specfile
+                    (let ((new-specs (save-module-excursion
+                                      (lambda ()
+                                        (set-current-module
+                                         (make-user-module '()))
+                                        (primitive-load specfile)))))
+
+                      (for-each db-add-specification new-specs)))
+
+               (if one-shot?
+                   (process-specs (db-get-specifications))
+                   (let ((exit-channel (make-channel)))
+                     (start-watchdog)
+                     (if (option-ref opts 'web #f)
+                         (begin
+                           (spawn-fiber
+                            (essential-task
+                             'web exit-channel
+                             (lambda ()
+                               (run-cuirass-server #:host host
+                                                   #:port port)))
+                            #:parallel? #t)
+
+                           (spawn-fiber
+                            (essential-task
+                             'monitor exit-channel
+                             (lambda ()
+                               (while #t
+                                 (log-monitoring-stats)
+                                 (sleep 600))))))
+
+                         (begin
+                           (clear-build-queue)
+
+                           ;; If Cuirass was stopped during an evaluation,
+                           ;; abort it. Builds that were not registered
+                           ;; during this evaluation will be registered
+                           ;; during the next evaluation.
+                           (db-abort-pending-evaluations)
+
+                           ;; First off, restart builds that had not
+                           ;; completed or were not even started on a
+                           ;; previous run.
+                           (spawn-fiber
+                            (essential-task
+                             'restart-builds exit-channel
+                             (lambda ()
+                               (restart-builds))))
+
+                           (spawn-fiber
+                            (essential-task
+                             'build exit-channel
+                             (lambda ()
+                               (while #t
+                                 (process-specs (db-get-specifications))
+                                 (log-message
+                                  "next evaluation in ~a seconds" interval)
+                                 (sleep interval)))))
+
+                           (spawn-fiber
+                            (essential-task
+                             'metrics exit-channel
+                             (lambda ()
+                               (while #t
+                                 (with-time-logging
+                                  "Metrics update"
+                                  (db-update-metrics))
+                                 (sleep 3600)))))
+
+                           (spawn-fiber
+                            (essential-task
+                             'monitor exit-channel
+                             (lambda ()
+                               (while #t
+                                 (log-monitoring-stats)
+                                 (sleep 600)))))))
+                     (primitive-exit (get-message exit-channel))))))
 
            ;; Most of our code is I/O so preemption doesn't matter much (it
            ;; could help while we're doing SQL requests, for instance, but it
diff --git a/build-aux/guix.scm b/build-aux/guix.scm
index 2dbdd6e..b03f173 100644
--- a/build-aux/guix.scm
+++ b/build-aux/guix.scm
@@ -67,11 +67,11 @@
            ;; Wrap the 'cuirass' command to refer to the right modules.
            (let* ((out    (assoc-ref outputs "out"))
                   (json   (assoc-ref inputs "guile-json"))
-                  (sqlite (assoc-ref inputs "guile-sqlite3"))
+                  (squee  (assoc-ref inputs "guile-squee"))
                   (zlib   (assoc-ref inputs "guile-zlib"))
                   (guix   (assoc-ref inputs "guix"))
                   (mods   (string-append json "/share/guile/site/3.0:"
-                                         sqlite "/share/guile/site/3.0:"
+                                         squee "/share/guile/site/3.0:"
                                          zlib "/share/guile/site/3.0:"
                                          guix "/share/guile/site/3.0")))
              (wrap-program (string-append out "/bin/cuirass")
@@ -82,7 +82,7 @@
         '("guile"
           "guile-fibers"
           "guile-json"
-          "guile-sqlite3"
+          "guile-squee"
           "guile-git"
           "guile-zlib"
           "guix")))
diff --git a/configure.ac b/configure.ac
index 159e9fe..4bbb2f3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -47,7 +47,7 @@ GUILE_MODULE_REQUIRED([guix])
 GUILE_MODULE_REQUIRED([guix git])
 GUILE_MODULE_REQUIRED([git])
 GUILE_MODULE_REQUIRED([json])
-GUILE_MODULE_REQUIRED([sqlite3])
+GUILE_MODULE_REQUIRED([squee])
 GUILE_MODULE_REQUIRED([fibers])
 GUILE_MODULE_REQUIRED([zlib])
 
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 00baf4a..75bbd84 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -173,7 +173,7 @@ Currently the only way to add those specifications to 
cuirass is to put
 a list of them in a file and set the @code{--specifications} command
 line option argument with the file name when launching the daemon
 (@pxref{Invocation}).  The specifications are persistent (they are kept
-in a SQLite database) so the next time @command{cuirass} is run the
+in a PostgreSQL database) so the next time @command{cuirass} is run the
 previously added specifications will remain active even if you don't
 keep the @code{--specifications} option.
 
@@ -209,9 +209,9 @@ database before launching the evaluation and build 
processes.
 @item --database=@var{database}
 @itemx -D @var{database}
 Use @var{database} as the database containing the jobs and the past
-build results. Since @code{cuirass} uses SQLite as a database engine,
-@var{database} must be a file name.  If the file doesn't exist, it will
-be created.
+build results. Since @code{cuirass} uses PostgreSQL as a database
+engine, @var{database} must be a file name.  If the file doesn't exist,
+it will be created.
 
 @item --ttl=@var{duration}
 Cuirass registers build results as garbage collector (GC) roots, thereby
@@ -263,11 +263,11 @@ Display an help message that summarize all the options 
provided.
 @node Database
 @chapter Database schema
 @cindex cuirass database
-@cindex sqlite database
+@cindex postgresql database
 @cindex persistent configuration
 
-Cuirass uses a SQLite database to store information about jobs and past
-build results, but also to coordinate the execution of jobs.
+Cuirass uses a PostgreSQL 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{Checkouts}, @code{Evaluations}, @code{Builds} and
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 53b9832..548690c 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -635,8 +635,7 @@ updating the database accordingly."
   "Reset the status of builds in the database that are marked as \"started\".
 This procedure is meant to be called at startup."
   (log-message "marking stale builds as \"scheduled\"...")
-  (with-db-worker-thread db
-    (sqlite-exec db "UPDATE Builds SET status = -2 WHERE status = -1;")))
+  (db-clear-build-queue))
 
 (define (restart-builds)
   "Restart builds whose status in the database is \"pending\" (scheduled or
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 236f192..bfc375d 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -26,6 +26,7 @@
   #:use-module (cuirass config)
   #:use-module (cuirass remote)
   #:use-module (cuirass utils)
+  #:use-module (squee)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 ftw)
@@ -37,160 +38,175 @@
   #:use-module (srfi srfi-26)
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
-  #:use-module (sqlite3)
   #:export (;; Procedures.
             db-init
             db-open
             db-close
-            db-optimize
-            db-log-queries
+            exec-query/bind-params
+            expect-one-row
+            read-sql-file
+            db-add-input
+            db-add-checkout
             db-add-specification
             db-remove-specification
+            db-get-inputs
             db-get-specification
             db-get-specifications
             evaluation-status
-            last-insert-rowid
-            expect-one-row
             db-add-evaluation
             db-abort-pending-evaluations
             db-set-evaluation-status
             db-set-evaluation-time
-            db-get-pending-derivations
             build-status
+            db-add-output
             db-add-build
             db-add-build-product
+            db-get-output
+            db-get-outputs
+            db-get-time-since-previous-build
             db-register-builds
             db-update-build-status!
             db-update-build-worker!
-            db-get-output
-            db-get-inputs
-            db-get-build
-            db-get-builds
-            db-get-time-since-previous-build
+            db-get-build-products
             db-get-builds-by-search
-            db-get-builds-min
-            db-get-builds-max
-            db-get-builds-query-min
-            db-get-builds-query-max
-            db-add-event
+            db-get-builds
+            db-get-build
             db-get-events
             db-delete-events-with-ids-<=-to
+            db-get-pending-derivations
+            db-get-checkouts
             db-get-evaluation
             db-get-evaluations
             db-get-evaluations-build-summary
             db-get-evaluations-id-min
             db-get-evaluations-id-max
+            db-get-evaluation-summary
+            db-get-builds-query-min
+            db-get-builds-query-max
+            db-get-builds-min
+            db-get-builds-max
             db-get-evaluation-specification
             db-get-build-product-path
-            db-get-build-products
             db-add-worker
             db-get-workers
             db-clear-workers
-            db-get-evaluation-summary
-            db-get-checkouts
-            read-sql-file
-            read-quoted-string
-            %sqlite-exec
-            sqlite-exec
-            catch-sqlite-error
-            ;; Constants.
-            SQLITE_CONSTRAINT_PRIMARYKEY
-            SQLITE_CONSTRAINT_UNIQUE
-            SQLITE_BUSY_SNAPSHOT
+            db-clear-build-queue
             ;; Parameters.
             %package-database
             %package-schema-file
             %db-channel
-            %db-writer-channel
             %record-events?
-            %db-writer-queue-size
             ;; Macros.
-            with-db-worker-thread
-            with-db-writer-worker-thread
-            with-db-writer-worker-thread/force
+            exec-query/bind
             with-database
-            with-queue-writer-worker))
+            with-db-worker-thread))
 
 ;; Maximum priority for a Build or Specification.
 (define max-priority 9)
 
-(define (%sqlite-exec db sql . args)
-  "Evaluate the given SQL query with the given ARGS.  Return the list of
-rows."
-  (define (normalize arg)
-    ;; Turn ARG into a string, unless it's a primitive SQL datatype.
-    (if (or (null? arg) (pair? arg) (vector? arg))
-        (object->string arg)
-        arg))
-
-  (let ((stmt (sqlite-prepare db sql #:cache? #t)))
-    (for-each (lambda (arg index)
-                (sqlite-bind stmt index (normalize arg)))
-              args (iota (length args) 1))
-    (let ((result (sqlite-fold-right cons '() stmt)))
-      (sqlite-reset stmt)
-      result)))
-
-(define-syntax sqlite-exec/bind
+(define (%exec-query db query args)
+  (exec-query db query args))
+
+(define (normalize obj)
+  (if (string? obj)
+      obj
+      (and obj (object->string obj))))
+
+(define-syntax %exec-query/bind
   (lambda (s)
-    ;; Expand to an '%sqlite-exec' call where the query string has
+    ;; Expand to an 'exec-query' call where the query string has
     ;; interspersed question marks and the argument list is separate.
     (define (string-literal? s)
       (string? (syntax->datum s)))
 
+    (define (interleave a b)
+      (if (null? b)
+          (list (car a))
+          `(,(car a) ,(car b) ,@(interleave (cdr a) (cdr b)))))
+
+    (define (interleave-arguments str)
+      (string-join
+       (interleave str
+                   (map (lambda (i)
+                          (string-append "$"
+                                         (number->string (1+ i))))
+                        (iota (1- (length str)))))
+       " "))
+
     (syntax-case s ()
       ((_ db (bindings ...) tail str arg rest ...)
-       #'(sqlite-exec/bind db
+       #'(%exec-query/bind db
                            (bindings ... (str arg))
                            tail
                            rest ...))
       ((_ db (bindings ...) tail str)
-       #'(sqlite-exec/bind db (bindings ...) str))
+       #'(%exec-query/bind db (bindings ...) str))
       ((_ db ((strings args) ...) tail)
-       (and (every string-literal? #'(strings ...))
-            (string-literal? #'tail))
        ;; Optimized case: only string literals.
-       (with-syntax ((query (string-join
-                             (append (syntax->datum #'(strings ...))
-                                     (list (syntax->datum #'tail)))
-                             "? ")))
-         #'(%sqlite-exec db query args ...)))
-      ((_ db ((strings args) ...) tail)
-       ;; Fallback case: some of the strings aren't literals.
-       #'(%sqlite-exec db (string-join (list strings ... tail) "? ")
-                       args ...)))))
-
-(define-syntax-rule (sqlite-exec db query args ...)
-  "Execute the specific QUERY with the given ARGS.  Uses of 'sqlite-exec'
+       (with-syntax ((query
+                      (interleave-arguments
+                       (append (syntax->datum #'(strings ...))
+                               (list (syntax->datum #'tail))))))
+         #'(%exec-query db query (map normalize (list args ...))))))))
+
+(define-syntax-rule (exec-query/bind db query args ...)
+  "Execute the specific QUERY with the given ARGS.  Uses of 'exec-query/bind'
 typically look like this:
 
-  (sqlite-exec db \"SELECT * FROM Foo WHERE x = \"
-                  x \"AND Y=\" y \";\")
+  (exec-query/bind db \"SELECT * FROM Foo WHERE x = \" x \"AND Y=\" y \";\")
 
-References to variables 'x' and 'y' here are replaced by question marks in the
-SQL query, and then 'sqlite-bind' is used to bind them.
+References to variables 'x' and 'y' here are replaced by $1 and $2 in the
+SQL query.
 
 This ensures that (1) SQL injection is impossible, and (2) the number of
-question marks matches the number of arguments to bind."
-  (sqlite-exec/bind db () "" query args ...))
-
-(define-syntax catch-sqlite-error
-  (syntax-rules (on =>)
-    "Run EXP..., catching SQLite error and handling the given code as
-specified."
-    ((_ exp ... (on error => handle ...))
-     (catch 'sqlite-error
-       (lambda ()
-         exp ...)
-       (lambda (key who code message . rest)
-         (if (= code error)
-             (begin handle ...)
-             (apply throw key who code message rest)))))))
+parameters matches the number of arguments to bind."
+  (%exec-query/bind db () "" query args ...))
+
+(define (exec-query/bind-params db query params)
+  (define param-regex
+    (make-regexp ":[a-zA-Z]+"))
+
+  (define (argument-indexes arguments)
+    (let loop ((res '())
+               (bindings '())
+               (counter 1)
+               (arguments arguments))
+      (if (null? arguments)
+          (reverse res)
+          (let* ((arg (car arguments))
+                 (index (assoc-ref bindings arg)))
+            (if index
+                (loop (cons index res)
+                      bindings
+                      counter
+                      (cdr arguments))
+                (loop (cons counter res)
+                      `((,arg . ,counter) ,@bindings)
+                      (1+ counter)
+                      (cdr arguments)))))))
+
+  (let* ((args
+          (reverse
+           (fold-matches param-regex query
+                         '() (lambda (m p)
+                               (cons (match:substring m) p)))))
+         (indexes (argument-indexes args))
+         (proc (lambda (m)
+                 (let ((index (car indexes)))
+                   (set! indexes (cdr indexes))
+                   (string-append "$" (number->string index)))))
+         (query (regexp-substitute/global #f param-regex query
+                                          'pre proc 'post))
+         (params (map (lambda (arg)
+                        (let ((symbol
+                               (symbol->keyword
+                                (string->symbol (substring arg 1)))))
+                          (assoc-ref params symbol)))
+                      (delete-duplicates args))))
+    (exec-query db query (map normalize params))))
 
 (define %package-database
-  ;; Define to the database file name of this package.
-  (make-parameter (string-append %localstatedir "/lib/" %package
-                                 "/" %package ".db")))
+  (make-parameter #f))
 
 (define %package-schema-file
   ;; Define to the database schema file of this package.
@@ -207,14 +223,20 @@ specified."
 (define %db-channel
   (make-parameter #f))
 
-(define %db-writer-channel
-  (make-parameter #f))
-
 (define %record-events?
   (make-parameter #f))
 
-(define %db-writer-queue-size
-  (make-parameter #f))
+(define-syntax-rule (with-database body ...)
+  "Run BODY with %DB-CHANNEL being dynamically bound to a channel providing a
+worker thread that allows database operations to run without interfering with
+fibers."
+  (parameterize ((%db-channel
+                  (make-worker-thread-channel
+                   (lambda ()
+                     (list (db-open)))
+                   #:parallelism
+                   (min (current-processor-count) 8))))
+    body ...))
 
 (define-syntax-rule (with-db-worker-thread db exp ...)
   "Evaluate EXP... in the critical section corresponding to %DB-CHANNEL.
@@ -241,27 +263,6 @@ This must only be used for reading queries, i.e SELECT 
queries."
                 (number->string receive-timeout)
                 caller-name))))))
 
-(define-syntax with-db-writer-worker-thread
-  (syntax-rules ()
-    "Similar to WITH-DB-WORKER-THREAD but evaluates EXP in a database worker
-dedicated to writing.  EXP evaluation is deferred and will only be run once
-the worker evaluation queue in full.  To force an immediate evaluation the
-#:FORCE? option or the alias below may be used.  This macro is reserved for
-writing queries, i.e CREATE, DELETE, DROP, INSERT, or UPDATE queries."
-    ((_ db #:force? force exp ...)
-     (call-with-worker-thread
-      (%db-writer-channel)
-      (lambda (db) exp ...)
-      #:options `((#:force? . ,force))))
-    ((_ db exp ...)
-     (with-db-writer-worker-thread db #:force? #f exp ...))))
-
-(define-syntax with-db-writer-worker-thread/force
-  (syntax-rules ()
-    "Alias for WITH-DB-WRITER-WORKER-THREAD with FORCE? option set."
-    ((_ db exp ...)
-     (with-db-writer-worker-thread db #:force? #t exp ...))))
-
 (define (read-sql-file file-name)
   "Return a list of string containing SQL instructions from FILE-NAME."
   (call-with-input-file file-name
@@ -274,42 +275,30 @@ writing queries, i.e CREATE, DELETE, DROP, INSERT, or 
UPDATE queries."
               (reverse! insts)
               (loop (cons inst insts))))))))
 
-(define (set-db-options db)
-  "Set various options for DB and return it."
-
-  ;; Turn DB in "write-ahead log" mode and return it.
-  (sqlite-exec db "PRAGMA journal_mode=WAL;")
-
-  ;; Install a busy handler such that, when the database is locked, sqlite
-  ;; retries until 30 seconds have passed, at which point it gives up and
-  ;; throws SQLITE_BUSY.  This is useful when we have several fibers or
-  ;; threads accessing the database concurrently.
-  ;;(sqlite-busy-timeout db (* 30 1000))
-  (sqlite-exec db "PRAGMA busy_timeout = 30000;")
-
-  ;; The want to prioritize read operations over write operations as we can
-  ;; have a large number of clients, while the number of write operations is
-  ;; modest.  Use a small WAL journal to do that, and try to reduce disk I/O
-  ;; by increasing RAM usage as described here:
-  ;; 
https://wiki.mozilla.org/Performance/Avoid_SQLite_In_Your_Next_Firefox_Feature
-  (sqlite-exec db "PRAGMA wal_autocheckpoint = 16;")
-  (sqlite-exec db "PRAGMA journal_size_limit = 1536;")
-  (sqlite-exec db "PRAGMA page_size = 32768;")
-  (sqlite-exec db "PRAGMA cache_size = -500000;")
-  (sqlite-exec db "PRAGMA temp_store = MEMORY;")
-  (sqlite-exec db "PRAGMA synchronous = NORMAL;")
-  db)
+(define (expect-one-row rows)
+  "Several SQL queries expect one result, or zero if not found.  This gets rid
+of the list, and returns #f when there is no result."
+  (match rows
+    ((row) row)
+    (() #f)))
 
 (define (db-load db schema)
   "Evaluate the file SCHEMA, which may contain SQL queries, into DB."
-  (for-each (cut sqlite-exec db <>)
+  (for-each (cut exec-query db <>)
             (read-sql-file schema)))
 
 (define (db-schema-version db)
-  (vector-ref (car (sqlite-exec db "PRAGMA user_version;")) 0))
+  (catch 'psql-query-error
+    (lambda ()
+      (match (expect-one-row
+              (exec-query db "SELECT version FROM SchemaVersion"))
+        ((version) (string->number version))))
+    (lambda _ #f)))
 
 (define (db-set-schema-version db version)
-  (sqlite-exec db (format #f "PRAGMA user_version = ~d;" version)))
+  (exec-query db "DELETE FROM SchemaVersion")
+  (exec-query/bind db "INSERT INTO SchemaVersion (version) VALUES
+ (" version ")"))
 
 (define (latest-db-schema-version)
   "Return the version to which the schema should be upgraded, based on the
@@ -319,19 +308,14 @@ upgrade-n.sql files, or 0 if there are no such files."
                (filter-map (cut string-match "^upgrade-([0-9]+)\\.sql$" <>)
                            (or (scandir (%package-sql-dir)) '())))))
 
-(define* (db-init #:optional (db-name (%package-database))
-                  #:key (schema (%package-schema-file)))
+(define* (db-init db
+                  #:key
+                  (schema (%package-schema-file)))
   "Open the database to store and read jobs and builds informations.  Return a
 database object."
-  (when (file-exists? db-name)
-    (format (current-error-port) "Removing leftover database ~a~%" db-name)
-    (delete-file db-name))
-  (let ((db (sqlite-open db-name (logior SQLITE_OPEN_CREATE
-                                         SQLITE_OPEN_READWRITE
-                                         SQLITE_OPEN_NOMUTEX))))
-    (db-load db schema)
-    (db-set-schema-version db (latest-db-schema-version))
-    db))
+  (db-load db schema)
+  (db-set-schema-version db (latest-db-schema-version))
+  db)
 
 (define (schema-upgrade-file version)
   "Return the file containing the SQL instructions that upgrade the schema
@@ -348,144 +332,107 @@ upgrade-n.sql files."
               (iota (- (latest-db-schema-version) current) (1+ current))))
   db)
 
-(define* (db-open #:optional (db (%package-database)))
+(define* (db-open #:key
+                  (database (%package-database)))
   "Open database to store or read jobs and builds informations.  Return a
 database object."
-  ;; Use "write-ahead log" mode because it improves concurrency and should
-  ;; avoid SQLITE_LOCKED errors when we have several readers:
-  ;; <https://www.sqlite.org/wal.html>.
-
-  ;; SQLITE_OPEN_NOMUTEX disables mutexing on database connection and prepared
-  ;; statement objects, thus making us responsible for serializing access to
-  ;; database connections and prepared statements.
-  (set-db-options (if (file-exists? db)
-                      (db-upgrade
-                       (sqlite-open db (logior SQLITE_OPEN_READWRITE
-                                               SQLITE_OPEN_NOMUTEX)))
-                      (db-init db))))
+  (let* ((param (or database
+                    (format #f "dbname=~a host=~a"
+                            (getenv "CUIRASS_DATABASE")
+                            (getenv "CUIRASS_HOST"))))
+         (db (connect-to-postgres-paramstring param)))
+    (match (db-schema-version db)
+      (#f
+       (db-init db))
+      (else
+       (db-upgrade db)))))
 
 (define (db-close db)
   "Close database object DB."
-  (sqlite-close db))
-
-(define* (db-optimize #:optional (db-file (%package-database)))
-  "Open the database and perform optimizations."
-  (let ((db (db-open db-file)))
-    (sqlite-exec db "PRAGMA optimize;")
-    (sqlite-exec db "PRAGMA wal_checkpoint(TRUNCATE);")
-    (db-close db)))
-
-(define (trace-callback trace p x)
-  (log-query (pointer->string
-              (sqlite-expanded-sql p))
-             (make-time 'time-duration
-                        (bytevector-uint-ref
-                         (pointer->bytevector x (sizeof uint64))
-                         0 (native-endianness)
-                         (sizeof uint64))
-                        0)))
-
-(define (db-log-queries file)
-  (with-db-worker-thread db
-    (query-logging-port (open-output-file file))
-    (sqlite-trace db SQLITE_TRACE_PROFILE trace-callback)))
-
-(define (last-insert-rowid db)
-  (vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();"))
-              0))
-
-(define (changes-count db)
-  "The number of database rows that were changed or inserted or deleted by the
-most recently completed INSERT, DELETE, or UPDATE statement."
-  (vector-ref (car (sqlite-exec db "SELECT changes();"))
-              0))
-
-(define (expect-one-row rows)
-  "Several SQL queries expect one result, or zero if not found.  This gets rid
-of the list, and returns #f when there is no result."
-  (match rows
-    ((row) row)
-    (() #f)))
+  (pg-conn-finish db))
 
 (define (db-add-input spec-name input)
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "\
-INSERT OR IGNORE INTO Inputs (specification, name, url, load_path, branch, \
+  (with-db-worker-thread db
+    (exec-query/bind db "\
+INSERT INTO Inputs (specification, name, url, load_path, branch, \
 tag, revision, no_compile_p) VALUES ("
-                 spec-name ", "
-                 (assq-ref input #:name) ", "
-                 (assq-ref input #:url) ", "
-                 (assq-ref input #:load-path) ", "
-                 (assq-ref input #:branch) ", "
-                 (assq-ref input #:tag) ", "
-                 (assq-ref input #:commit) ", "
-                 (if (assq-ref input #:no-compile?) 1 0) ");")))
+                     spec-name ", "
+                     (assq-ref input #:name) ", "
+                     (assq-ref input #:url) ", "
+                     (assq-ref input #:load-path) ", "
+                     (assq-ref input #:branch) ", "
+                     (assq-ref input #:tag) ", "
+                     (assq-ref input #:commit) ", "
+                     (if (assq-ref input #:no-compile?) 1 0) ")
+ON CONFLICT ON CONSTRAINT inputs_pkey DO NOTHING;")))
 
 (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-writer-worker-thread/force db
-    (catch-sqlite-error
-     (sqlite-exec db "\
+  (with-db-worker-thread db
+    (match (expect-one-row
+            (exec-query/bind db "\
 INSERT INTO Checkouts (specification, revision, evaluation, input,
 directory, timestamp) VALUES ("
-                  spec-name ", "
-                  (assq-ref checkout #:commit) ", "
-                  eval-id ", "
-                  (assq-ref checkout #:input) ", "
-                  (assq-ref checkout #:directory) ", "
-                  (or (assq-ref checkout #:timestamp) 0) ");")
-     (last-insert-rowid db)
-
-     ;; 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.
-     (on SQLITE_CONSTRAINT_PRIMARYKEY => #f))))
+                             spec-name ", "
+                             (assq-ref checkout #:commit) ", "
+                             eval-id ", "
+                             (assq-ref checkout #:input) ", "
+                             (assq-ref checkout #:directory) ", "
+                             (or (assq-ref checkout #:timestamp) 0) ")
+ON CONFLICT ON CONSTRAINT checkouts_pkey DO NOTHING
+RETURNING (specification, revision);"))
+      (x x)
+      (() #f))))
 
 (define (db-add-specification spec)
   "Store SPEC in database the database.  SPEC inputs are stored in the INPUTS
 table."
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "\
-INSERT OR IGNORE INTO Specifications (name, load_path_inputs, \
+  (with-db-worker-thread db
+    (match (expect-one-row
+            (exec-query/bind db "\
+INSERT INTO Specifications (name, load_path_inputs, \
 package_path_inputs, proc_input, proc_file, proc, proc_args, \
 build_outputs, priority) \
   VALUES ("
-                 (assq-ref spec #:name) ", "
-                 (assq-ref spec #:load-path-inputs) ", "
-                 (assq-ref spec #:package-path-inputs) ", "
-                 (assq-ref spec #:proc-input) ", "
-                 (assq-ref spec #:proc-file) ", "
-                 (symbol->string (assq-ref spec #:proc)) ", "
-                 (assq-ref spec #:proc-args) ", "
-                 (assq-ref spec #:build-outputs) ", "
-                 (or (assq-ref spec #:priority) max-priority) ");")
-    (let ((spec-id (last-insert-rowid db)))
-      (for-each (lambda (input)
-                  (db-add-input (assq-ref spec #:name) input))
-                (assq-ref spec #:inputs))
-      spec-id)))
+                             (assq-ref spec #:name) ", "
+                             (assq-ref spec #:load-path-inputs) ", "
+                             (assq-ref spec #:package-path-inputs) ", "
+                             (assq-ref spec #:proc-input) ", "
+                             (assq-ref spec #:proc-file) ", "
+                             (symbol->string (assq-ref spec #:proc)) ", "
+                             (assq-ref spec #:proc-args) ", "
+                             (assq-ref spec #:build-outputs) ", "
+                             (or (assq-ref spec #:priority) max-priority) ")
+ON CONFLICT ON CONSTRAINT specifications_pkey DO NOTHING
+RETURNING name;"))
+      ((name)
+       (for-each (lambda (input)
+                   (db-add-input (assq-ref spec #:name) input))
+                 (assq-ref spec #:inputs))
+       name)
+      (else #f))))
 
 (define (db-remove-specification name)
   "Remove the specification matching NAME from the database and its inputs."
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "BEGIN TRANSACTION;")
-    (sqlite-exec db "\
+  (with-db-worker-thread db
+    (exec-query db "BEGIN TRANSACTION;")
+    (exec-query/bind db "\
 DELETE FROM Inputs WHERE specification=" name ";")
-    (sqlite-exec db "\
+    (exec-query/bind db "\
 DELETE FROM Specifications WHERE name=" name ";")
-    (sqlite-exec db "COMMIT;")))
+    (exec-query db "COMMIT;")))
 
 (define (db-get-inputs spec-name)
   (with-db-worker-thread db
-    (let loop ((rows (sqlite-exec
+    (let loop ((rows (exec-query/bind
                       db "SELECT * FROM Inputs WHERE specification="
-                      spec-name ";"))
+                      spec-name "ORDER BY name;"))
                (inputs '()))
       (match rows
-        (() inputs)
-        ((#(specification name url load-path branch tag revision no-compile-p)
-           . rest)
+        (() (reverse inputs))
+        (((specification name url load-path branch tag revision no-compile-p)
+          . rest)
          (loop rest
                (cons `((#:name . ,name)
                        (#:url . ,url)
@@ -493,43 +440,43 @@ DELETE FROM Specifications WHERE name=" name ";")
                        (#:branch . ,branch)
                        (#:tag . ,tag)
                        (#:commit . ,revision)
-                       (#:no-compile? . ,(positive? no-compile-p)))
+                       (#:no-compile? . ,(positive?
+                                          (string->number no-compile-p))))
                      inputs)))))))
 
 (define (db-get-specification name)
   "Retrieve a specification in the database with the given NAME."
-  (with-db-worker-thread db
-    (expect-one-row (db-get-specifications name))))
+  (expect-one-row (db-get-specifications name)))
 
 (define* (db-get-specifications #:optional name)
   (with-db-worker-thread db
     (let loop
         ((rows  (if name
-                    (sqlite-exec db "
+                    (exec-query/bind db "
 SELECT * FROM Specifications WHERE name =" name ";")
-                    (sqlite-exec db "
-SELECT * FROM Specifications ORDER BY name DESC;")))
+                    (exec-query db "
+SELECT * FROM Specifications ORDER BY name ASC;")))
          (specs '()))
-         (match rows
-           (() specs)
-           ((#(name load-path-inputs package-path-inputs proc-input proc-file 
proc
-                    proc-args build-outputs priority)
-             . rest)
-            (loop rest
-                  (cons `((#:name . ,name)
-                          (#:load-path-inputs .
-                           ,(with-input-from-string load-path-inputs read))
-                          (#:package-path-inputs .
-                           ,(with-input-from-string package-path-inputs read))
-                          (#:proc-input . ,proc-input)
-                          (#:proc-file . ,proc-file)
-                          (#:proc . ,(with-input-from-string proc read))
-                          (#:proc-args . ,(with-input-from-string proc-args 
read))
-                          (#:inputs . ,(db-get-inputs name))
-                          (#:build-outputs .
-                           ,(with-input-from-string build-outputs read))
-                          (#:priority . ,priority))
-                        specs)))))))
+      (match rows
+        (() (reverse specs))
+        (((name load-path-inputs package-path-inputs proc-input proc-file proc
+                proc-args build-outputs priority)
+          . rest)
+         (loop rest
+               (cons `((#:name . ,name)
+                       (#:load-path-inputs .
+                        ,(with-input-from-string load-path-inputs read))
+                       (#:package-path-inputs .
+                        ,(with-input-from-string package-path-inputs read))
+                       (#:proc-input . ,proc-input)
+                       (#:proc-file . ,proc-file)
+                       (#:proc . ,(with-input-from-string proc read))
+                       (#:proc-args . ,(with-input-from-string proc-args read))
+                       (#:inputs . ,(db-get-inputs name))
+                       (#:build-outputs .
+                        ,(with-input-from-string build-outputs read))
+                       (#:priority . ,(string->number priority)))
+                     specs)))))))
 
 (define-enumeration evaluation-status
   (started          -1)
@@ -537,6 +484,17 @@ SELECT * FROM Specifications ORDER BY name DESC;")))
   (failed            1)
   (aborted           2))
 
+(define (db-add-event type timestamp details)
+  (with-db-worker-thread db
+    (when (%record-events?)
+      (exec-query/bind db "\
+INSERT INTO Events (type, timestamp, event_json) VALUES ("
+                       (symbol->string type) ", "
+                       timestamp ", "
+                       (object->json-string details)
+                       ");")
+      #t)))
+
 (define* (db-add-evaluation spec-name checkouts
                             #:key
                             (checkouttime 0)
@@ -547,99 +505,49 @@ Otherwise, return #f."
   (define now
     (or timestamp (time-second (current-time time-utc))))
 
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "BEGIN TRANSACTION;")
-    (sqlite-exec db "INSERT INTO Evaluations (specification, status,
-timestamp, checkouttime, evaltime)
+  (with-db-worker-thread db
+    (exec-query db "BEGIN TRANSACTION;")
+    (let* ((eval-id
+            (match (expect-one-row
+                    (exec-query/bind db "\
+INSERT INTO Evaluations (specification, status, timestamp,
+checkouttime, evaltime)
 VALUES (" spec-name "," (evaluation-status started) ","
-now "," checkouttime "," evaltime ");")
-    (let* ((eval-id (last-insert-rowid db))
+now "," checkouttime "," evaltime ")
+RETURNING id;"))
+              ((id) (string->number id))))
            (new-checkouts (filter-map
                            (cut db-add-checkout spec-name eval-id <>)
                            checkouts)))
       (if (null? new-checkouts)
-          (begin (sqlite-exec db "ROLLBACK;")
+          (begin (exec-query db "ROLLBACK;")
                  #f)
           (begin (db-add-event 'evaluation
                                (time-second (current-time time-utc))
                                `((#:evaluation    . ,eval-id)
                                  (#:specification . ,spec-name)
                                  (#:in_progress   . #t)))
-                 (sqlite-exec db "COMMIT;")
+                 (exec-query db "COMMIT;")
                  eval-id)))))
 
 (define (db-abort-pending-evaluations)
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "UPDATE Evaluations SET status =
+  (with-db-worker-thread db
+    (exec-query/bind db "UPDATE Evaluations SET status =
 " (evaluation-status aborted) " WHERE status = "
 (evaluation-status started))))
 
 (define (db-set-evaluation-status eval-id status)
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "UPDATE Evaluations SET status =
+  (with-db-worker-thread db
+    (exec-query/bind db "UPDATE Evaluations SET status =
 " status " WHERE id = " eval-id ";")))
 
 (define (db-set-evaluation-time eval-id)
   (define now
     (time-second (current-time time-utc)))
 
-  (with-db-writer-worker-thread/force
-   db
-   (sqlite-exec db "UPDATE Evaluations SET evaltime = " now
-                "WHERE id = " eval-id ";")))
-
-(define-syntax-rule (with-database body ...)
-  "Run BODY with %DB-CHANNEL being dynamically bound to a channel providing a
-worker thread that allows database operations to run without interfering with
-fibers."
-  (parameterize ((%db-channel
-                  (make-worker-thread-channel
-                   (lambda ()
-                     (list (db-open)))
-                   #:parallelism
-                   (min (current-processor-count) 4))))
-    body ...))
-
-(define-syntax-rule (with-queue-writer-worker body ...)
-  "Run BODY with %DB-WRITER-CHANNEL being dynamically bound to a channel
-providing a worker thread that allow database write operations to run
-without interfering with fibers.
-
-The worker will queue write operations and run them in a single transaction
-when the queue is full. As write operations are exclusive in SQLite, do not
-allocate more than one worker."
-  (parameterize ((%db-writer-channel
-                  (make-worker-thread-channel
-                   (lambda ()
-                     (list (db-open)))
-                   #:parallelism 1
-                   #:queue-size (%db-writer-queue-size)
-                   #:queue-proc
-                   (lambda (db run-queue)
-                     (sqlite-exec db "BEGIN TRANSACTION;")
-                     (run-queue)
-                     (sqlite-exec db "COMMIT;")))))
-    body ...))
-
-(define* (read-quoted-string #:optional (port (current-input-port)))
-  "Read all of the characters out of PORT and return them as a SQL quoted
-string."
-  (let loop ((chars '()))
-    (let ((char (read-char port)))
-      (cond ((eof-object? char) (list->string (reverse! chars)))
-            ((char=? char #\')  (loop (cons* char char chars)))
-            (else (loop (cons char chars)))))))
-
-;; Extended error codes (see <sqlite3.h>).
-;; XXX: This should be defined by (sqlite3).
-(define SQLITE_BUSY 5)
-(define SQLITE_CONSTRAINT 19)
-(define SQLITE_CONSTRAINT_PRIMARYKEY
-  (logior SQLITE_CONSTRAINT (ash 6 8)))
-(define SQLITE_CONSTRAINT_UNIQUE
-  (logior SQLITE_CONSTRAINT (ash 8 8)))
-(define SQLITE_BUSY_SNAPSHOT
-  (logior SQLITE_BUSY (ash 2 8)))
+  (with-db-worker-thread db
+    (exec-query/bind db "UPDATE Evaluations SET evaltime = " now
+                     "WHERE id = " eval-id ";")))
 
 (define-enumeration build-status
   ;; Build status as expected by Hydra's API.  Note: the negative values are
@@ -654,70 +562,103 @@ string."
   (canceled          4))
 
 (define (db-add-output derivation output)
-  "Insert OUTPUT associated with DERIVATION.  If an output with the same path
-already exists, return #f."
-  (with-db-writer-worker-thread/force db
-    (catch-sqlite-error
-     (match output
-       ((name . path)
-        (sqlite-exec db "\
+  "Insert OUTPUT associated with DERIVATION."
+  (with-db-worker-thread db
+    (match output
+      ((name . path)
+       (exec-query/bind db "\
 INSERT INTO Outputs (derivation, name, path) VALUES ("
-                     derivation ", " name ", " path ");")))
-     (last-insert-rowid db)
-
-     ;; If we get a unique-constraint-failed error, that means we have
-     ;; already inserted the same output.  That happens with fixed-output
-     ;; derivations.
-     (on SQLITE_CONSTRAINT_PRIMARYKEY => #f))))
+                        derivation ", " name ", " path ")
+ON CONFLICT ON CONSTRAINT outputs_pkey DO NOTHING;")))))
 
 (define (db-add-build build)
   "Store BUILD in database the database only if one of its outputs is new.
 Return #f otherwise.  BUILD outputs are stored in the OUTPUTS table."
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "
+  (with-db-worker-thread db
+    (exec-query/bind db "
 INSERT INTO Builds (derivation, evaluation, job_name, system, nix_name, log,
 status, priority, max_silent, timeout, 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)) ", "
-                 (assq-ref build #:priority) ", "
-                 (or (assq-ref build #:max-silent) 0) ", "
-                 (or (assq-ref build #:timeout) 0) ", "
-                 (or (assq-ref build #:timestamp) 0) ", "
-                 (or (assq-ref build #:starttime) 0) ", "
-                 (or (assq-ref build #:stoptime) 0) ");")
-    (let* ((derivation (assq-ref build #:derivation))
-           (outputs (assq-ref build #:outputs))
-           (new-outputs (filter-map (cut db-add-output derivation <>)
-                                    outputs)))
-      (db-add-event 'build
-                    (assq-ref build #:timestamp)
-                    `((#:derivation . ,(assq-ref build #:derivation))
-                      ;; TODO Ideally this would use the value
-                      ;; from build, with a default of scheduled,
-                      ;; but it's hard to convert to the symbol,
-                      ;; so just hard code scheduled for now.
-                      (#:event       . scheduled)))
-      derivation)))
+                     (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 #:priority) max-priority) ", "
+                         (or (assq-ref build #:max-silent) 0) ", "
+                         (or (assq-ref build #:timeout) 0) ", "
+                         (or (assq-ref build #:timestamp) 0) ", "
+                         (or (assq-ref build #:starttime) 0) ", "
+                         (or (assq-ref build #:stoptime) 0) ");"))
+  (let* ((derivation (assq-ref build #:derivation))
+         (outputs (assq-ref build #:outputs))
+         (new-outputs (filter-map (cut db-add-output derivation <>)
+                                  outputs)))
+    (db-add-event 'build
+                  (assq-ref build #:timestamp)
+                  `((#:derivation . ,derivation)
+                    ;; TODO Ideally this would use the value
+                    ;; from build, with a default of scheduled,
+                    ;; but it's hard to convert to the symbol,
+                    ;; so just hard code scheduled for now.
+                    (#:event       . scheduled)))
+    derivation))
 
 (define (db-add-build-product product)
   "Insert PRODUCT into BuildProducts table."
-  (with-db-writer-worker-thread/force db
-    (sqlite-exec db "\
-INSERT OR IGNORE INTO BuildProducts (build, type, file_size, checksum,
+  (with-db-worker-thread db
+    (exec-query/bind db "\
+INSERT INTO BuildProducts (build, type, file_size, checksum,
 path) VALUES ("
-                 (assq-ref product #:build) ", "
-                 (assq-ref product #:type) ", "
-                 (assq-ref product #:file-size) ", "
-                 (assq-ref product #:checksum) ", "
-                 (assq-ref product #:path) ");")
-    (last-insert-rowid db)))
+                     (assq-ref product #:build) ", "
+                     (assq-ref product #:type) ", "
+                     (assq-ref product #:file-size) ", "
+                     (assq-ref product #:checksum) ", "
+                     (assq-ref product #:path) ");")))
+
+(define (db-get-output path)
+  "Retrieve the OUTPUT for PATH."
+  (with-db-worker-thread db
+    (match (exec-query/bind db "SELECT derivation, name FROM Outputs
+WHERE path =" path "
+LIMIT 1;")
+      (() #f)
+      (((derivation name))
+       `((#:derivation . ,derivation)
+         (#:name . ,name))))))
+
+(define (db-get-outputs derivation)
+  "Retrieve the OUTPUTS of the build identified by DERIVATION in the
+database."
+  (with-db-worker-thread db
+    (let loop ((rows
+                (exec-query/bind db "SELECT name, path FROM Outputs
+WHERE derivation =" derivation ";"))
+               (outputs '()))
+      (match rows
+        (() (reverse outputs))
+        (((name path)
+          . rest)
+         (loop rest
+               (cons `(,name . ((#:path . ,path)))
+                     outputs)))))))
+
+(define (db-get-time-since-previous-build job-name specification)
+  "Return the time difference in seconds between the current time and the
+registration time of the last build for JOB-NAME and SPECIFICATION."
+  (with-db-worker-thread db
+    (match (expect-one-row
+            (exec-query/bind db "
+SELECT extract(epoch from now())::int - Builds.timestamp FROM Builds
+INNER JOIN Evaluations on Builds.evaluation = Evaluations.id
+WHERE job_name  = " job-name "AND specification = " specification
+"ORDER BY Builds.timestamp DESC LIMIT 1"))
+      ((time)
+       (string->number time))
+      (else #f))))
 
 (define (db-register-builds jobs eval-id specification)
   (define (new-outputs? outputs)
@@ -734,8 +675,7 @@ path) VALUES ("
       (+ (* spec-priority 10) priority)))
 
   (define (register job)
-    (let* ((name       (assq-ref job #:job-name))
-           (drv        (assq-ref job #:derivation))
+    (let* ((drv        (assq-ref job #:derivation))
            (job-name   (assq-ref job #:job-name))
            (system     (assq-ref job #:system))
            (nix-name   (assq-ref job #:nix-name))
@@ -779,11 +719,11 @@ path) VALUES ("
   ;; Use the database worker dedicated to write queries.  We don't want this
   ;; query to be queued as it is already a quite large transaction by itself,
   ;; so pass the #:FORCE? option.
-  (with-db-writer-worker-thread/force db
+  (with-db-worker-thread db
     (log-message "Registering builds for evaluation ~a." eval-id)
-    (sqlite-exec db "BEGIN TRANSACTION;")
+    (exec-query db "BEGIN TRANSACTION;")
     (let ((derivations (filter-map register jobs)))
-      (sqlite-exec db "COMMIT;")
+      (exec-query db "COMMIT;")
       derivations)))
 
 (define* (db-update-build-status! drv status #:key log-file)
@@ -800,11 +740,11 @@ log file for DRV."
       (,(build-status failed-other)      . "failed (other)")
       (,(build-status canceled)          . "canceled")))
 
-  (with-db-writer-worker-thread db
+  (with-db-worker-thread db
     (if (= status (build-status started))
         (begin
-          (sqlite-exec db "UPDATE Builds SET starttime=" now ", status="
-                       status "WHERE derivation=" drv ";")
+          (exec-query/bind db "UPDATE Builds SET starttime=" now ", status="
+                           status "WHERE derivation=" drv ";")
           (db-add-event 'build
                         now
                         `((#:derivation . ,drv)
@@ -815,56 +755,29 @@ log file for DRV."
         ;; and doesn't change every time we mark DRV as 'succeeded' several
         ;; times in a row, for instance.
         (begin
-          (if log-file
-              (sqlite-exec db "UPDATE Builds SET stoptime=" now
-                           ", status=" status ", log=" log-file
-                           "WHERE derivation=" drv "AND status != " status ";")
-              (sqlite-exec db "UPDATE Builds SET stoptime=" now
-                           ", status=" status
-                           "WHERE derivation=" drv " AND status != " status
-                           ";"))
-          (when (positive? (changes-count db))
-            (db-add-event 'build
-                          now
-                          `((#:derivation . ,drv)
-                            (#:event      . ,(assq-ref status-names
-                                                       status)))))))))
+          (let ((rows
+                 (if log-file
+                     (exec-query/bind db "UPDATE Builds SET stoptime=" now
+                                      ", status=" status ", log=" log-file
+                                      "WHERE derivation=" drv
+                                      "AND status != " status ";")
+                     (exec-query/bind db "UPDATE Builds SET stoptime=" now
+                                      ", status=" status
+                                      "WHERE derivation=" drv
+                                      " AND status != " status
+                                      ";"))))
+            (when (positive? rows)
+              (db-add-event 'build
+                            now
+                            `((#:derivation . ,drv)
+                              (#:event      . ,(assq-ref status-names
+                                                         status))))))))))
 
 (define* (db-update-build-worker! drv worker)
   "Update the database so that DRV's worker is WORKER."
-  (with-db-writer-worker-thread db
-    (sqlite-exec db "UPDATE Builds SET worker=" worker
-                 "WHERE derivation=" drv ";")))
-
-(define (db-get-output path)
-  "Retrieve the OUTPUT for PATH."
   (with-db-worker-thread db
-    ;; There isn't a unique index on path, but because Cuirass avoids adding
-    ;; derivations which introduce the same outputs, there should only be one
-    ;; result.
-    (match (sqlite-exec db "SELECT derivation, name FROM Outputs
-WHERE path =" path "
-LIMIT 1;")
-      (() #f)
-      ((#(derivation name))
-       `((#:derivation . ,derivation)
-         (#:name . ,name))))))
-
-(define (db-get-outputs derivation)
-  "Retrieve the OUTPUTS of the build identified by DERIVATION in the
-database."
-  (with-db-worker-thread db
-    (let loop ((rows
-                (sqlite-exec db "SELECT name, path FROM Outputs
-WHERE derivation =" derivation ";"))
-               (outputs '()))
-      (match rows
-        (() outputs)
-        ((#(name path)
-           . rest)
-         (loop rest
-               (cons `(,name . ((#:path . ,path)))
-                     outputs)))))))
+    (exec-query/bind db "UPDATE Builds SET worker=" worker
+                     "WHERE derivation=" drv ";")))
 
 (define (query->bind-arguments query-string)
   "Return a list of keys to query strings by parsing QUERY-STRING."
@@ -874,91 +787,103 @@ WHERE derivation =" derivation ";"))
       ("failed-dependency" . ,(build-status failed-dependency))
       ("failed-other" . ,(build-status failed-other))
       ("canceled" . ,(build-status canceled))))
-  (let ((args (append-map
+  (let ((args (map
                (lambda (token)
                  (match (string-split token #\:)
                    (("system" system)
-                    `(#:system ,system))
+                    `(#:system . ,system))
                    (("spec" spec)
-                    `(#:spec ,spec))
+                    `(#:spec . ,spec))
                    (("status" status)
-                    `(#:status ,(assoc-ref status-values status)))
+                    `(#:status . ,(assoc-ref status-values status)))
                    ((_ invalid) '())    ; ignore
                    ((query)
                     ;; Remove any '%' that could make the search too slow and
                     ;; add one at the end of the query.
-                    `(#:query ,(string-append
-                                (string-join
-                                 (string-split query #\%)
-                                 "")
-                                "%")))))
+                    `(#:query . ,(string-append
+                                  (string-join
+                                   (string-split query #\%)
+                                   "")
+                                  "%")))))
                (string-tokenize query-string))))
     ;; Normalize arguments
     (fold (lambda (key acc)
-            (if (member key acc)
+            (if (assq key acc)
                 acc
-                (append (list key #f) acc)))
+                (cons (cons key #f) acc)))
           args '(#:spec #:system))))
 
+(define (db-get-build-products build-id)
+  "Return the build products associated to the given BUILD-ID."
+  (with-db-worker-thread db
+    (let loop ((rows (exec-query/bind db "
+SELECT id, type, file_size, checksum, path from BuildProducts
+WHERE build = " build-id))
+               (products '()))
+      (match rows
+        (() (reverse products))
+        (((id type file-size checksum path)
+          . rest)
+         (loop rest
+               (cons `((#:id . ,id)
+                       (#:type . ,type)
+                       (#:file-size . ,file-size)
+                       (#:checksum . ,checksum)
+                       (#:path . ,path))
+                     products)))))))
+
 (define (db-get-builds-by-search filters)
   "Retrieve all builds in the database which are matched by given FILTERS.
 FILTERS is an assoc list whose possible keys are the symbols query,
 border-low-id, border-high-id, and nr."
   (with-db-worker-thread db
-    (let* ((stmt-text (format #f "SELECT Builds.rowid, Builds.timestamp,
+    (let* ((query (format #f "SELECT Builds.id, Builds.timestamp,
 Builds.starttime,Builds.stoptime, Builds.log, Builds.status,
 Builds.job_name, Builds.system, Builds.nix_name, Specifications.name
 FROM Builds
 INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
 INNER JOIN Specifications ON Evaluations.specification = Specifications.name
 WHERE (Builds.nix_name LIKE :query)
-AND (:status IS NULL
- OR (Builds.status = :status))
-AND (:spec IS NULL
- OR (Specifications.name = :spec))
-AND (:system IS NULL
- OR (Builds.system = :system))
-AND (:borderlowid IS NULL
- OR (:borderlowid < Builds.rowid))
-AND (:borderhighid IS NULL
- OR (:borderhighid > Builds.rowid))
+AND ((Builds.status = :status) OR :status IS NULL)
+AND ((Specifications.name = :spec) OR :spec IS NULL)
+AND ((Builds.system = :system) OR :system IS NULL)
+AND ((:borderlowid < Builds.id) OR :borderlowid IS NULL)
+AND ((:borderhighid > Builds.id) OR :borderhighid IS NULL)
 ORDER BY
-CASE WHEN :borderlowid IS NULL THEN Builds.rowid
-                               ELSE -Builds.rowid
+CASE WHEN :borderlowid IS NULL THEN Builds.id
+                               ELSE -Builds.id
 END DESC
 LIMIT :nr;"))
-           (stmt (sqlite-prepare db stmt-text #:cache? #t)))
-      (apply sqlite-bind-arguments
-             stmt
-             (append (list
-                      #:borderlowid (assq-ref filters 'border-low-id)
-                      #:borderhighid (assq-ref filters 'border-high-id)
-                      #:nr (match (assq-ref filters 'nr)
-                             (#f -1)
-                             (x x)))
-                     (query->bind-arguments (assq-ref filters 'query))))
-      (let ((builds
-             (sqlite-fold-right
-              (lambda (row result)
-                (match row
-                  (#(id timestamp starttime stoptime log status job-name
-                        system nix-name specification)
-                   (cons `((#:id . ,id)
-                           (#:timestamp . ,timestamp)
-                           (#:starttime . ,starttime)
-                           (#:stoptime . ,stoptime)
-                           (#:log . ,log)
-                           (#:status . ,status)
-                           (#:job-name . ,job-name)
-                           (#:system . ,system)
-                           (#:nix-name . ,nix-name)
-                           (#:specification . ,specification)
-                           (#:buildproducts . ,(db-get-build-products id)))
-                         result))))
-              '()
-              stmt)))
-        (sqlite-reset stmt)
-        builds))))
+           (builds
+            (exec-query/bind-params
+             db
+             query
+             `((#:borderlowid . ,(assq-ref filters 'border-low-id))
+               (#:borderhighid . ,(assq-ref filters 'border-high-id))
+               (#:nr . ,(match (assq-ref filters 'nr)
+                          (#f -1)
+                          (x x)))
+               ,@(query->bind-arguments (assq-ref filters 'query))))))
+      (let loop ((builds builds)
+                 (result '()))
+        (match builds
+          (() result)
+          (((id timestamp starttime stoptime log status job-name
+                system nix-name specification)
+            . rest)
+           (loop rest
+                 (cons `((#:id . ,(string->number id))
+                         (#:timestamp . ,(string->number timestamp))
+                         (#:starttime . ,(string->number starttime))
+                         (#:stoptime . ,(string->number stoptime))
+                         (#:log . ,log)
+                         (#:status . ,(string->number status))
+                         (#:job-name . ,job-name)
+                         (#:system . ,system)
+                         (#:nix-name . ,nix-name)
+                         (#:specification . ,specification)
+                         (#:buildproducts . ,(db-get-build-products id)))
+                       result))))))))
 
 (define (db-get-builds filters)
   "Retrieve all builds in the database which are matched by given FILTERS.
@@ -969,22 +894,22 @@ FILTERS is an assoc list whose possible keys are 
'derivation | 'id | 'jobset |
   (define (filters->order filters)
     (lambda (inner)
       (match (assq 'order filters)
-        (('order . 'build-id) "Builds.rowid ASC")
+        (('order . 'build-id) "Builds.id ASC")
         (('order . 'finish-time) "stoptime DESC")
         (('order . 'finish-time+build-id)
          (if inner
-             "CASE WHEN :borderlowid IS NULL THEN
+             "CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
  stoptime ELSE -stoptime END DESC,
-CASE WHEN :borderlowid IS NULL THEN
- Builds.rowid ELSE -Builds.rowid END DESC"
-             "stoptime DESC, Builds.rowid DESC"))
+CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
+ Builds.id ELSE -Builds.id END DESC"
+             "stoptime DESC, Builds.id DESC"))
         ;; With this order, builds in 'running' state (-1) appear
         ;; before those in 'scheduled' state (-2).
         (('order . 'status+submission-time)
-         "Builds.status DESC, Builds.timestamp DESC, Builds.rowid ASC")
+         "Builds.status DESC, Builds.timestamp DESC, Builds.id ASC")
         (('order . 'priority+timestamp)
-         "Builds.priority DESC, Builds.timestamp ASC")
-        (_ "Builds.rowid DESC"))))
+         "Builds.priority DESC, Builds.timestamp DESC")
+        (_ "Builds.id DESC"))))
 
   ;; XXX: Make sure that all filters are covered by an index.
   (define (where-conditions filters)
@@ -1005,11 +930,11 @@ CASE WHEN :borderlowid IS NULL THEN
                               ('succeeded "Builds.status = 0")
                               ('failed    "Builds.status > 0")))
         (border-low-time
-         . "(:borderlowtime IS NULL OR :borderlowid IS NULL OR
- ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.rowid)))")
+         . "(((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.id))
+OR :borderlowtime IS NULL OR :borderlowid IS NULL)")
         (border-high-time
-         . "(:borderhightime IS NULL OR :borderhighid IS NULL OR
- ((:borderhightime, :borderhighid) > (Builds.stoptime, Builds.rowid)))")))
+         . "(((:borderhightime, :borderhighid) > (Builds.stoptime, Builds.id))
+OR :borderhightime IS NULL OR :borderhighid IS NULL)")))
 
     (filter
      string?
@@ -1055,422 +980,389 @@ CASE WHEN :borderlowid IS NULL THEN
                     ((first-condition rest ...)
                      (string-append "WHERE " first-condition "\n  AND "
                                     (string-join rest " AND ")))))
-           (stmt-text
-            (format #f "
-SELECT Builds.*,
-GROUP_CONCAT(Outputs.name), GROUP_CONCAT(Outputs.path),
-GROUP_CONCAT(BP.rowid), GROUP_CONCAT(BP.type), GROUP_CONCAT(BP.file_size),
-GROUP_CONCAT(BP.checksum), GROUP_CONCAT(BP.path) FROM
-(SELECT Builds.derivation, Builds.rowid, Builds.timestamp, Builds.starttime,
-        Builds.stoptime, Builds.log, Builds.status, Builds.priority,
-        Builds.max_silent, Builds.timeout, Builds.job_name,
-        Builds.system, Builds.nix_name, Builds.evaluation,
-        Specifications.name
-FROM Builds
+           (query
+            (format #f " SELECT Builds.derivation, Builds.id, Builds.timestamp,
+Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.priority,
+Builds.max_silent, Builds.timeout, Builds.job_name, Builds.system,
+Builds.nix_name, Builds.evaluation, agg.name, agg.outputs_name,
+agg.outputs_path,agg.bp_build, agg.bp_type, agg.bp_file_size,
+agg.bp_checksum, agg.bp_path
+FROM
+(SELECT B.id, B.derivation, B.name,
+string_agg(Outputs.name, ',') AS outputs_name,
+string_agg(Outputs.path, ',') AS outputs_path,
+string_agg(cast(BP.build AS text), ',') AS bp_build,
+string_agg(BP.type, ',') AS bp_type,
+string_agg(cast(BP.file_size AS text), ',') AS bp_file_size,
+string_agg(BP.checksum, ',') AS bp_checksum,
+string_agg(BP.path, ',') AS bp_path FROM
+(SELECT Builds.id, Builds.derivation, Specifications.name FROM Builds
 INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
 INNER JOIN Specifications ON Evaluations.specification = Specifications.name
 ~a
 ORDER BY ~a
-LIMIT :nr) Builds
-INNER JOIN Outputs ON Outputs.derivation = Builds.derivation
-LEFT JOIN BuildProducts as BP ON BP.build = Builds.rowid
-GROUP BY Builds.derivation
+LIMIT :nr) B
+INNER JOIN Outputs ON Outputs.derivation = B.derivation
+LEFT JOIN BuildProducts as BP ON BP.build = B.id
+GROUP BY B.derivation, B.id, B.name) agg
+JOIN Builds on agg.id = Builds.id
 ORDER BY ~a;"
                     where (order #t) (order #f)))
-           (stmt (sqlite-prepare db stmt-text #:cache? #t)))
-
-      (sqlite-bind stmt 'nr (match (assq-ref filters 'nr)
-                              (#f -1)
-                              (x x)))
-      (for-each (match-lambda
-                  (('nr . _) #f)        ; Handled above
-                  (('order . _) #f)     ; Doesn't need binding
-                  (('status . _) #f)    ; Doesn't need binding
-                  ((name . value)
-                   (when value
-                     (sqlite-bind stmt
-                                  (or (assq-ref
-                                       '((border-low-time  . borderlowtime)
-                                         (border-high-time . borderhightime)
-                                         (border-low-id    . borderlowid)
-                                         (border-high-id   . borderhighid))
-                                       name)
-                                      name)
-                                  value))))
-                filters)
-      (let ((builds
-             (sqlite-fold-right
-              (lambda (row result)
-                (match row
-                  (#(derivation id timestamp starttime stoptime log status
-                                priority max-silent timeout job-name
-                                system nix-name eval-id specification
-                                outputs-name outputs-path
-                                products-id products-type products-file-size
-                                products-checksum products-path)
-                   (cons `((#:derivation . ,derivation)
-                           (#:id . ,id)
-                           (#:timestamp . ,timestamp)
-                           (#:starttime . ,starttime)
-                           (#:stoptime . ,stoptime)
-                           (#:log . ,log)
-                           (#:status . ,status)
-                           (#:priority . ,priority)
-                           (#:max-silent . ,max-silent)
-                           (#:timeout . ,timeout)
-                           (#:job-name . ,job-name)
-                           (#:system . ,system)
-                           (#:nix-name . ,nix-name)
-                           (#:eval-id . ,eval-id)
-                           (#:specification . ,specification)
-                           (#:outputs . ,(format-outputs outputs-name
-                                                         outputs-path))
-                           (#:buildproducts .
-                            ,(format-build-products products-id
-                                                    products-type
-                                                    products-file-size
-                                                    products-checksum
-                                                    products-path)))
-                         result))))
-              '()
-              stmt)))
-        (sqlite-reset stmt)
-        builds))))
+           (params
+            (map (match-lambda
+                   ((name . value)
+                    (let ((key
+                           (symbol->keyword
+                            (or (assq-ref
+                                 '((border-low-time  . borderlowtime)
+                                   (border-high-time . borderhightime)
+                                   (border-low-id    . borderlowid)
+                                   (border-high-id   . borderhighid))
+                                 name)
+                                name)))
+                          (value
+                           (match name
+                             ('nr (or value -1))
+                             ('order #f) ; Doesn't need binding.
+                             ('status #f) ; Doesn't need binding.
+                             (else value))))
+                      (cons key value))))
+                 filters))
+           (builds (exec-query/bind-params db query params)))
+      (let loop ((builds builds)
+                 (result '()))
+        (match builds
+          (() (reverse result))
+          (((derivation id timestamp starttime stoptime log status
+                        priority max-silent timeout job-name
+                        system nix-name eval-id specification
+                        outputs-name outputs-path
+                        products-id products-type products-file-size
+                        products-checksum products-path)
+            . rest)
+           (loop rest
+                 (cons `((#:derivation . ,derivation)
+                         (#:id . ,(string->number id))
+                         (#:timestamp . ,(string->number timestamp))
+                         (#:starttime . ,(string->number starttime))
+                         (#:stoptime . ,(string->number stoptime))
+                         (#:log . ,log)
+                         (#:status . ,(string->number status))
+                         (#:priority . ,(string->number priority))
+                         (#:max-silent . ,(string->number max-silent))
+                         (#:timeout . ,(string->number timeout))
+                         (#:job-name . ,job-name)
+                         (#:system . ,system)
+                         (#:nix-name . ,nix-name)
+                         (#:eval-id . ,(string->number eval-id))
+                         (#:specification . ,specification)
+                         (#:outputs . ,(format-outputs outputs-name
+                                                       outputs-path))
+                         (#:buildproducts .
+                          ,(format-build-products products-id
+                                                  products-type
+                                                  products-file-size
+                                                  products-checksum
+                                                  products-path)))
+                       result))))))))
 
 (define (db-get-build derivation-or-id)
   "Retrieve a build in the database which corresponds to DERIVATION-OR-ID."
-  (with-db-worker-thread db
-    (let ((key (if (number? derivation-or-id) 'id 'derivation)))
-      (expect-one-row (db-get-builds `((,key . ,derivation-or-id)))))))
-
-(define (db-get-time-since-previous-build job-name specification)
-  "Return the time difference in seconds between the current time and the
-registration time of the last build for JOB-NAME and SPECIFICATION."
-  (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
-SELECT strftime('%s', 'now') - Builds.timestamp FROM Builds
-INNER JOIN Evaluations on Builds.evaluation = Evaluations.id
-WHERE job_name  = " job-name "AND specification = " specification
-"ORDER BY Builds.timestamp DESC LIMIT 1")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
-
-(define (db-add-event type timestamp details)
-  (when (%record-events?)
-    (with-db-writer-worker-thread db
-      (sqlite-exec db "\
-INSERT INTO Events (type, timestamp, event_json) VALUES ("
-                   (symbol->string type) ", "
-                   timestamp ", "
-                   (object->json-string details)
-                   ");")
-      #t)))
+  (let ((key (if (number? derivation-or-id) 'id 'derivation)))
+    (expect-one-row (db-get-builds `((,key . ,derivation-or-id))))))
 
 (define (db-get-events filters)
   (with-db-worker-thread db
-    (let* ((stmt-text "\
+    (let* ((query "\
 SELECT Events.id,
        Events.type,
        Events.timestamp,
        Events.event_json
 FROM Events
-WHERE (:type IS NULL OR (:type = Events.type))
-  AND (:borderlowtime IS NULL OR
-       :borderlowid IS NULL OR
-       ((:borderlowtime, :borderlowid) <
-        (Events.timestamp, Events.id)))
-  AND (:borderhightime IS NULL OR
-       :borderhighid IS NULL OR
-       ((:borderhightime, :borderhighid) >
-        (Events.timestamp, Events.id)))
+WHERE (:type = Events.type OR :type IS NULL)
+  AND (((:borderlowtime, :borderlowid) <
+        (Events.timestamp, Events.id)) OR
+       :borderlowtime IS NULL OR
+       :borderlowid IS NULL)
+  AND (((:borderhightime, :borderhighid) >
+        (Events.timestamp, Events.id)) OR
+       :borderhightime IS NULL OR
+       :borderhighid IS NULL)
 ORDER BY Events.id ASC
 LIMIT :nr;")
-           (stmt (sqlite-prepare db stmt-text #:cache? #t)))
-      (sqlite-bind-arguments
-       stmt
-       #:type (and=> (assq-ref filters 'type)
-                     symbol->string)
-       #:nr (match (assq-ref filters 'nr)
-              (#f -1)
-              (x x)))
-      (let ((events
-             (sqlite-fold-right
-              (lambda (row result)
-                (match row
-                  (#(id type timestamp event_json)
-                   (cons `((#:id . ,id)
-                           (#:type . ,type)
-                           (#:timestamp . ,timestamp)
-                           (#:event_json . ,event_json))
-                         result))))
-              '()
-              stmt)))
-        (sqlite-reset stmt)
-        events))))
+           (params `((#:type . ,(and=> (assq-ref filters 'type)
+                                       symbol->string))
+                     (#:nr . ,(match (assq-ref filters 'nr)
+                                (#f -1)
+                                (x x)))))
+           (events (exec-query/bind-params db query params)))
+      (let loop ((events events)
+                 (result '()))
+        (match events
+          (() (reverse result))
+          (((id type timestamp event_json)
+            . rest)
+           (loop rest
+                 (cons `((#:id . ,(string->number id))
+                         (#:type . ,(string->symbol type))
+                         (#:timestamp . ,(string->number timestamp))
+                         (#:event_json . ,event_json))
+                       result))))))))
 
 (define (db-delete-events-with-ids-<=-to id)
-  (with-db-writer-worker-thread db
-    (sqlite-exec
-     db
-     "DELETE FROM Events WHERE id <= " id ";")))
+  (with-db-worker-thread db
+    (exec-query/bind db "DELETE FROM Events WHERE id <= " id ";")))
 
 (define (db-get-pending-derivations)
   "Return the list of derivation file names corresponding to pending builds in
 the database.  The returned list is guaranteed to not have any duplicates."
   (with-db-worker-thread db
-    (map (match-lambda (#(drv) drv))
-         (sqlite-exec db "
+    (map (match-lambda ((drv) drv))
+         (exec-query db "
 SELECT derivation FROM Builds WHERE Builds.status < 0;"))))
 
 (define (db-get-checkouts eval-id)
   (with-db-worker-thread db
-    (let loop ((rows (sqlite-exec
+    (let loop ((rows (exec-query/bind
                       db "SELECT revision, input, directory FROM Checkouts
 WHERE evaluation =" eval-id ";"))
                (checkouts '()))
       (match rows
-        (() checkouts)
-        ((#(revision input directory)
-           . rest)
+        (() (reverse checkouts))
+        (((revision input directory)
+          . rest)
          (loop rest
                (cons `((#:commit . ,revision)
                        (#:input . ,input)
                        (#:directory . ,directory))
                      checkouts)))))))
 
+(define (parse-evaluation evaluation)
+  (match evaluation
+    ((id specification status timestamp checkouttime evaltime)
+     `((#:id . ,(string->number id))
+       (#:specification . ,specification)
+       (#:status . ,(string->number status))
+       (#:timestamp . ,(string->number timestamp))
+       (#:checkouttime . ,(string->number checkouttime))
+       (#:evaltime . ,(string->number evaltime))
+       (#:checkouts . ,(db-get-checkouts id))))))
+
 (define (db-get-evaluation id)
   (with-db-worker-thread db
-    (match (sqlite-exec db "SELECT id, specification, status,
+    (match (exec-query/bind db "SELECT id, specification, status,
 timestamp, checkouttime, evaltime
 FROM Evaluations WHERE id = " id)
       (() #f)
-      ((#(id specification status timestamp checkouttime evaltime))
-       `((#:id . ,id)
-         (#:specification . ,specification)
-         (#:status . ,status)
-         (#:timestamp . ,timestamp)
-         (#:checkouttime . ,checkouttime)
-         (#:evaltime . ,evaltime)
-         (#:checkouts . ,(db-get-checkouts id)))))))
+      ((evaluation)
+       (parse-evaluation evaluation)))))
 
 (define (db-get-evaluations limit)
   (with-db-worker-thread db
-    (let loop ((rows  (sqlite-exec db "SELECT id, specification, status,
+    (let loop ((rows  (exec-query/bind db "SELECT id, specification, status,
 timestamp, checkouttime, evaltime
 FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
                (evaluations '()))
       (match rows
         (() (reverse evaluations))
-        ((#(id specification status timestamp checkouttime evaltime)
-           . rest)
+        ((evaluation . rest)
          (loop rest
-               (cons `((#:id . ,id)
-                       (#:specification . ,specification)
-                       (#:status . ,status)
-                       (#:timestamp . ,timestamp)
-                       (#:checkouttime . ,checkouttime)
-                       (#:evaltime . ,evaltime)
-                       (#:checkouts . ,(db-get-checkouts id)))
-                     evaluations)))))))
+               (cons (parse-evaluation evaluation) evaluations)))))))
 
 (define (db-get-evaluations-build-summary spec limit border-low border-high)
   (with-db-worker-thread db
-    (let loop ((rows (sqlite-exec db "
-SELECT E.id, E.status, SUM(B.status=0) as succeeded,
-SUM(B.status>0) as failed, SUM(B.status<0) as scheduled FROM
+    (let ((query "
+SELECT E.id, E.status,
+SUM(CASE WHEN B.status = 0 THEN 1 ELSE 0 END) as succeeded,
+SUM(CASE WHEN B.status > 0 THEN 1 ELSE 0 END) as failed,
+SUM(CASE WHEN B.status < 0 THEN 1 ELSE 0 END) as scheduled FROM
 (SELECT id, status FROM Evaluations
-WHERE (specification=" spec ")
-AND (" border-low "IS NULL OR (id >" border-low "))
-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
+WHERE specification=:spec
+AND (id > :borderlow OR :borderlow IS NULL)
+AND (id < :borderhigh OR :borderhigh IS NULL)
+ORDER BY CASE WHEN :borderlow IS NULL THEN id ELSE -id END DESC
+LIMIT :limit) E
 LEFT JOIN Builds as B
 ON B.evaluation=E.id
-GROUP BY E.id
-ORDER BY E.id ASC;"))
-               (evaluations '()))
-      (match rows
-        (() evaluations)
-        ((#(id status succeeded failed scheduled) . rest)
-         (loop rest
-               (cons `((#:id . ,id)
-                       (#:status . ,status)
-                       (#:checkouts . ,(db-get-checkouts id))
-                       (#:succeeded . ,(or succeeded 0))
-                       (#:failed . ,(or failed 0))
-                       (#:scheduled . ,(or scheduled 0)))
-                     evaluations)))))))
+GROUP BY E.id, E.status
+ORDER BY E.id DESC;")
+          (params `((#:spec . ,spec)
+                    (#:limit . ,limit)
+                    (#:borderlow . ,border-low)
+                    (#:borderhigh . ,border-high))))
+      (let loop ((rows (exec-query/bind-params db query params))
+                 (evaluations '()))
+        (match rows
+          (() (reverse evaluations))
+          (((id status succeeded failed scheduled) . rest)
+           (loop rest
+                 (cons `((#:id . ,(string->number id))
+                         (#:status . ,(string->number status))
+                         (#:checkouts . ,(db-get-checkouts id))
+                         (#:succeeded . ,(or (string->number succeeded) 0))
+                         (#:failed . ,(or (string->number failed) 0))
+                         (#:scheduled . ,(or (string->number scheduled) 0)))
+                       evaluations))))))))
 
 (define (db-get-evaluations-id-min spec)
   "Return the min id of evaluations for the given specification SPEC."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
+    (match (expect-one-row
+            (exec-query/bind db "
 SELECT MIN(id) FROM Evaluations
-WHERE specification=" spec)))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+WHERE specification=" spec))
+      ((min) (and min (string->number min))))))
 
 (define (db-get-evaluations-id-max spec)
   "Return the max id of evaluations for the given specification SPEC."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
+    (match (expect-one-row
+            (exec-query/bind db "
 SELECT MAX(id) FROM Evaluations
-WHERE specification=" spec)))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+WHERE specification=" spec))
+      ((max) (and max (string->number max))))))
 
 (define (db-get-evaluation-summary id)
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
-SELECT E.id, E.status, E.timestamp, E.checkouttime, E.evaltime,
-SUM(B.status>-100) as total, SUM(B.status=0) as succeeded,
-SUM(B.status>0) as failed, SUM(B.status<0) as scheduled FROM
-(SELECT id, status, timestamp, checkouttime, evaltime FROM
-        Evaluations WHERE (id=" id ")) E
+    (match (expect-one-row
+            (exec-query/bind db "
+SELECT Evaluations.id, Evaluations.status, Evaluations.timestamp,
+Evaluations.checkouttime, Evaluations.evaltime,
+SUM(CASE WHEN B.status > -100 THEN 1 ELSE 0 END) as total,
+SUM(CASE WHEN B.status = 0 THEN 1 ELSE 0 END) as succeeded,
+SUM(CASE WHEN B.status > 0 THEN 1 ELSE 0 END) as failed,
+SUM(CASE WHEN B.status < 0 THEN 1 ELSE 0 END) as scheduled
+FROM Evaluations
 LEFT JOIN Builds as B
-ON B.evaluation=E.id
-ORDER BY E.id ASC;")))
-      (and=> (expect-one-row rows)
-             (match-lambda
-               (#(id status timestamp checkouttime evaltime
-                     total succeeded failed scheduled)
-                `((#:id . ,id)
-                  (#:status . ,status)
-                  (#:total . ,(or total 0))
-                  (#:timestamp . ,timestamp)
-                  (#:checkouttime . ,checkouttime)
-                  (#:evaltime . ,evaltime)
-                  (#:succeeded . ,(or succeeded 0))
-                  (#:failed . ,(or failed 0))
-                  (#:scheduled . ,(or scheduled 0)))))))))
-
-(define (db-get-builds-query-min query)
+ON B.evaluation = Evaluations.id
+WHERE Evaluations.id = " id
+"GROUP BY Evaluations.id
+ORDER BY Evaluations.id ASC;"))
+      ((id status timestamp checkouttime evaltime
+           total succeeded failed scheduled)
+       `((#:id . ,(string->number id))
+         (#:status . ,(string->number status))
+         (#:total . ,(or (string->number total) 0))
+         (#:timestamp . ,(string->number timestamp))
+         (#:checkouttime . ,(string->number checkouttime))
+         (#:evaltime . ,(string->number evaltime))
+         (#:succeeded . ,(or (string->number succeeded) 0))
+         (#:failed . ,(or (string->number failed) 0))
+         (#:scheduled . ,(or (string->number scheduled) 0))))
+      (else #f))))
+
+(define (db-get-builds-query-min filters)
   "Return the smallest build row identifier matching QUERY."
   (with-db-worker-thread db
-    (let* ((stmt-text "SELECT MIN(Builds.rowid) FROM Builds
+    (let* ((query "SELECT MIN(Builds.id) FROM Builds
 INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
 INNER JOIN Specifications ON Evaluations.specification = Specifications.name
 WHERE (Builds.nix_name LIKE :query)
-AND (:status IS NULL
- OR (Builds.status = :status))
-AND (:spec IS NULL
- OR (Specifications.name = :spec))
-AND (:system IS NULL
- OR (Builds.system = :system));")
-           (stmt (sqlite-prepare db stmt-text #:cache? #t)))
-      (apply sqlite-bind-arguments stmt
-             (query->bind-arguments query))
-      (let ((rows (sqlite-fold-right cons '() stmt)))
-        (sqlite-reset stmt)
-        (and=> (expect-one-row rows) vector->list)))))
-
-(define (db-get-builds-query-max query)
+AND (Builds.status = :status OR :status IS NULL)
+AND (Specifications.name = :spec OR :spec IS NULL)
+AND (Builds.system = :system OR :system IS NULL);")
+           (params (query->bind-arguments filters)))
+      (match (expect-one-row
+              (exec-query/bind-params db query params))
+        ((min) (and min
+                    (list (string->number min))))))))
+
+(define (db-get-builds-query-max filters)
   "Return the largest build row identifier matching QUERY."
   (with-db-worker-thread db
-    (let* ((stmt-text "SELECT MAX(Builds.rowid) FROM Builds
+    (let* ((query "SELECT MAX(Builds.id) FROM Builds
 INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
 INNER JOIN Specifications ON Evaluations.specification = Specifications.name
 WHERE (Builds.nix_name LIKE :query)
-AND (:status IS NULL
- OR (Builds.status = :status))
-AND (:spec IS NULL
- OR (Specifications.name = :spec))
-AND (:system IS NULL
- OR (Builds.system = :system));")
-           (stmt (sqlite-prepare db stmt-text #:cache? #t)))
-      (apply sqlite-bind-arguments stmt
-             (query->bind-arguments query))
-      (let ((rows (sqlite-fold-right cons '() stmt)))
-        (sqlite-reset stmt)
-        (and=> (expect-one-row rows) vector->list)))))
+AND (Builds.status = :status OR :status IS NULL)
+AND (Specifications.name = :spec OR :spec IS NULL)
+AND (Builds.system = :system OR :system IS NULL);")
+           (params (query->bind-arguments filters)))
+      (match (expect-one-row
+              (exec-query/bind-params db query params))
+        ((max) (and max
+                    (list (string->number max))))))))
 
 (define (db-get-builds-min eval status)
   "Return the min build (stoptime, rowid) pair for the given evaluation EVAL
 and STATUS."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
-SELECT stoptime, rowid FROM Builds
-WHERE evaluation=" eval "
-AND (" status " IS NULL OR (" status " = 'pending'
-                            AND Builds.status < 0)
-                        OR (" status " = 'succeeded'
-                            AND Builds.status = 0)
-                        OR (" status " = 'failed'
-                            AND Builds.status > 0))
-ORDER BY stoptime ASC, rowid ASC
-LIMIT 1")))
-      (and=> (expect-one-row rows) vector->list))))
+    (let ((query "SELECT stoptime, id FROM Builds
+WHERE evaluation = :eval AND
+((:status = 'pending' AND Builds.status < 0) OR
+(:status = 'succeeded' AND Builds.status = 0) OR
+(:status = 'failed' AND Builds.status > 0) OR
+:status IS NULL)
+ORDER BY stoptime ASC, id ASC
+LIMIT 1")
+          (params `((#:eval . ,eval)
+                    (#:status . ,status))))
+      (match (expect-one-row
+              (exec-query/bind-params db query params))
+        ((stoptime id) (list (string->number stoptime)
+                             (string->number id)))
+        (else #f)))))
 
 (define (db-get-builds-max eval status)
   "Return the max build (stoptime, rowid) pair for the given evaluation EVAL
 and STATUS."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
-SELECT stoptime, rowid FROM Builds
-WHERE evaluation=" eval "
-AND (" status " IS NULL OR (" status " = 'pending'
-                            AND Builds.status < 0)
-                        OR (" status " = 'succeeded'
-                            AND Builds.status = 0)
-                        OR (" status " = 'failed'
-                            AND Builds.status > 0))
-ORDER BY stoptime DESC, rowid DESC
-LIMIT 1")))
-      (and=> (expect-one-row rows) vector->list))))
+    (let ((query "SELECT stoptime, id FROM Builds
+WHERE evaluation = :eval AND
+((:status = 'pending' AND Builds.status < 0) OR
+(:status = 'succeeded' AND Builds.status = 0) OR
+(:status = 'failed' AND Builds.status > 0) OR
+:status IS NULL)
+ORDER BY stoptime DESC, id DESC
+LIMIT 1")
+          (params `((#:eval . ,eval)
+                    (#:status . ,status))))
+      (match (expect-one-row
+              (exec-query/bind-params db query params))
+        ((stoptime id) (list (string->number stoptime)
+                             (string->number id)))
+        (else #f)))))
 
 (define (db-get-evaluation-specification eval)
   "Return specification of evaluation with id EVAL."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
+    (match (expect-one-row
+            (exec-query/bind db "
 SELECT specification FROM Evaluations
-WHERE id = " eval)))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+WHERE id = " eval))
+      ((spec) spec)
+      (else #f))))
 
 (define (db-get-build-product-path id)
   "Return the build product with the given ID."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "
+    (match (expect-one-row
+            (exec-query/bind db "
 SELECT path FROM BuildProducts
-WHERE rowid = " id)))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
-
-(define (db-get-build-products build-id)
-  "Return the build products associated to the given BUILD-ID."
-  (with-db-worker-thread db
-    (let loop ((rows  (sqlite-exec db "
-SELECT rowid, type, file_size, checksum, path from BuildProducts
-WHERE build = " build-id))
-               (products '()))
-      (match rows
-        (() (reverse products))
-        ((#(id type file-size checksum path)
-           . rest)
-         (loop rest
-               (cons `((#:id . ,id)
-                       (#:type . ,type)
-                       (#:file-size . ,file-size)
-                       (#:checksum . ,checksum)
-                       (#:path . ,path))
-                     products)))))))
+WHERE id = " id))
+      ((path) path)
+      (else #f))))
 
 (define (db-add-worker worker)
   "Insert WORKER into Worker table."
-  (with-db-writer-worker-thread db
-    (sqlite-exec db "\
-INSERT OR REPLACE INTO Workers (name, address, systems, last_seen)
+  (with-db-worker-thread db
+    (exec-query/bind db "\
+INSERT INTO Workers (name, address, systems, last_seen)
 VALUES ("
-                 (worker-name worker) ", "
-                 (worker-address worker) ", "
-                 (string-join (worker-systems worker) ",") ", "
-                 (worker-last-seen worker) ");")
-    (last-insert-rowid db)))
+                     (worker-name worker) ", "
+                     (worker-address worker) ", "
+                     (string-join (worker-systems worker) ",") ", "
+                     (worker-last-seen worker) ");")))
 
 (define (db-get-workers)
   "Return the workers in Workers table."
   (with-db-worker-thread db
-    (let loop ((rows  (sqlite-exec db "
+    (let loop ((rows (exec-query db "
 SELECT name, address, systems, last_seen from Workers"))
                (workers '()))
       (match rows
         (() (reverse workers))
-        ((#(name address systems last-seen)
+        (((name address systems last-seen)
           . rest)
          (loop rest
                (cons (worker
@@ -1482,5 +1374,14 @@ SELECT name, address, systems, last_seen from Workers"))
 
 (define (db-clear-workers)
   "Remove all workers from Workers table."
-  (with-db-writer-worker-thread db
-    (sqlite-exec db "DELETE FROM Workers;")))
+  (with-db-worker-thread db
+    (exec-query db "DELETE FROM Workers;")))
+
+(define (db-clear-build-queue)
+  "Reset the status of builds in the database that are marked as \"started\"."
+  (with-db-worker-thread db
+    (exec-query db "UPDATE Builds SET status = -2 WHERE status < 0;")))
+
+;;; Local Variables:
+;;; eval: (put 'with-db-worker-thread 'scheme-indent-function 1)
+;;; End:
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 3ac7ef9..6bca85c 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -250,14 +250,14 @@ Hydra format."
     #:avg-eval-build-start-time
     (db-get-metrics-with-id 'average-eval-build-start-time
                             #:limit 100
-                            #:order "field ASC")
+                            #:order "cast(field as int) ASC")
     #:builds-per-day
     (db-get-metrics-with-id 'builds-per-day
                             #:limit 100)
     #:eval-completion-speed
     (db-get-metrics-with-id 'evaluation-completion-speed
                             #:limit 100
-                            #:order "field ASC")
+                            #:order "cast(field as int) ASC")
     #:new-derivations-per-day
     (db-get-metrics-with-id 'new-derivations-per-day
                             #:limit 100)
diff --git a/src/cuirass/metrics.scm b/src/cuirass/metrics.scm
index 9a0fd14..f993cf2 100644
--- a/src/cuirass/metrics.scm
+++ b/src/cuirass/metrics.scm
@@ -20,13 +20,16 @@
   #:use-module (cuirass database)
   #:use-module (cuirass logging)
   #:use-module (guix records)
+  #:use-module (squee)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 i18n)
   #:use-module (ice-9 match)
   #:export (metric
             metric?
             metric-id
+            metric-field-type
             metric-proc
 
             %metrics
@@ -47,6 +50,8 @@
   metric?
   (id              metric-id)
   (compute-proc    metric-compute-proc)
+  (field-type      metric-field-type
+                   (default 'int))
   (field-proc      metric-field-proc
                    (default #f)))
 
@@ -55,72 +60,98 @@
 ;;; Database procedures.
 ;;;
 
+(define-syntax-rule (return-exact body ...)
+  (match (expect-one-row body ...)
+    ((result)
+     (and result (string->number result)))))
+
+(define-syntax-rule (return-inexact body ...)
+  (match (expect-one-row body ...)
+    ((result)
+     (and result (locale-string->inexact result)))))
+
 (define* (db-average-eval-duration-per-spec spec #:key limit)
   "Return the average evaluation duration for SPEC.  Limit the average
 computation to the most recent LIMIT records if this argument is set."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "SELECT AVG(duration) FROM
+    (let ((query "\
+SELECT AVG(m.duration) FROM
 (SELECT (evaltime - timestamp) as duration
-FROM Evaluations WHERE specification = " spec
-" AND evaltime != 0 ORDER BY rowid DESC
-LIMIT " (or limit -1) ");")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+FROM Evaluations WHERE specification = :spec
+AND evaltime != 0 ORDER BY id DESC LIMIT ~a) m;")
+          (params `((#:spec . ,spec))))
+      (return-inexact
+       (exec-query/bind-params db
+                               (format #f query
+                                       (if limit
+                                           (number->string limit)
+                                           "ALL"))
+                               params)))))
 
 (define (db-builds-previous-day _)
   "Return the builds count of the previous day."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "SELECT COUNT(*) from Builds
-WHERE date(timestamp, 'unixepoch') = date('now', '-1 day') AND
-date(stoptime, 'unixepoch') = date('now', '-1 day');")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+    (return-exact
+     (exec-query/bind db "SELECT COUNT(*) from Builds
+WHERE to_timestamp(timestamp)::date = 'yesterday'::date AND
+to_timestamp(stoptime)::date = 'yesterday'::date;"))))
 
 (define (db-new-derivations-previous-day _)
   "Return the new derivations count of the previous day."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "SELECT COUNT(*) from Builds
-WHERE date(timestamp, 'unixepoch') = date('now', '-1 day');")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+    (return-exact
+     (exec-query/bind db "SELECT COUNT(*) from Builds
+WHERE to_timestamp(timestamp)::date = 'yesterday'::date;"))))
 
 (define (db-pending-builds _)
   "Return the current pending builds count."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "SELECT COUNT(*) from Builds
-WHERE status < 0;")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+    (return-exact
+     (exec-query/bind db "SELECT COUNT(*) from Builds
+WHERE status < 0;"))))
 
 (define* (db-percentage-failed-eval-per-spec spec #:key limit)
   "Return the failed evaluation percentage for SPEC.  If LIMIT is set, limit
 the percentage computation to the most recent LIMIT records."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "\
-SELECT 100 * CAST(SUM(status > 0) as float) / COUNT(*) FROM
-(SELECT status from Evaluations WHERE specification = " spec
-" ORDER BY rowid DESC LIMIT " (or limit -1) ");")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+    (let ((query "\
+SELECT 100 *
+CAST(SUM(CASE WHEN m.status > 0 THEN 1 ELSE 0 END) as float) /
+COUNT(*) FROM
+(SELECT status from Evaluations WHERE specification = :spec
+ORDER BY id DESC LIMIT ~a) m")
+          (params `((#:spec . ,spec))))
+      (return-inexact
+       (exec-query/bind-params db
+                               (format #f query
+                                       (if limit
+                                           (number->string limit)
+                                           "ALL"))
+                               params)))))
 
 (define* (db-average-build-start-time-per-eval eval)
   "Return the average build start time for the given EVAL."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "\
+    (return-inexact
+     (exec-query/bind db "\
 SELECT AVG(B.starttime - E.evaltime) FROM
 (SELECT id, evaltime
 FROM Evaluations WHERE id = " eval ") E
 LEFT JOIN Builds as B
 ON E.id = B.evaluation and B.starttime > 0
-GROUP BY E.id;")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+GROUP BY E.id;"))))
 
 (define* (db-average-build-complete-time-per-eval eval)
   "Return the average build complete time for the given EVAL."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "\
+    (return-inexact
+     (exec-query/bind db "\
 SELECT AVG(B.stoptime - E.evaltime) FROM
 (SELECT id, evaltime
 FROM Evaluations WHERE id = " eval ") E
 LEFT JOIN Builds as B
 ON E.id = B.evaluation and B.stoptime > 0
-GROUP BY E.id;")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+GROUP BY E.id;"))))
 
 (define* (db-evaluation-completion-speed eval)
   "Return the evaluation completion speed of the given EVAL. The speed is
@@ -133,45 +164,45 @@ expressed in builds per hour."
   ;; evaluation_duration (seconds) = max(build_stop_time) - eval_start_time
   ;; If the evaluation builds are all completed.
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "\
+    (return-inexact
+     (exec-query/bind db "\
 SELECT
-3600.0 * SUM(B.status = 0) /
-(CASE SUM(status < 0)
+3600.0 * SUM(CASE WHEN B.status = 0 THEN 1 ELSE 0 END) /
+(CASE SUM(CASE WHEN status < 0 THEN 1 ELSE 0 END)
    WHEN 0 THEN MAX(stoptime)
-   ELSE strftime('%s', 'now')
+   ELSE extract(epoch from 'today'::date)
 END - E.evaltime) FROM
 (SELECT id, evaltime
 FROM Evaluations WHERE id = " eval ") E
 LEFT JOIN Builds as B
 ON E.id = B.evaluation and B.stoptime > 0
-GROUP BY E.id;")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+GROUP BY E.id, E.evaltime;"))))
 
 (define (db-previous-day-timestamp)
   "Return the timestamp of the previous day."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "SELECT strftime('%s',
-date('now', '-1 day'));")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+    (return-exact
+     (exec-query
+      db "SELECT extract(epoch from 'yesterday'::date);"))))
 
 (define (db-current-day-timestamp)
   "Return the timestamp of the current day."
   (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "SELECT strftime('%s',
-date('now'));")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+    (return-exact
+     (exec-query
+      db "SELECT extract(epoch from 'today'::date);"))))
 
 (define* (db-latest-evaluations #:key (days 3))
   "Return the successful evaluations added during the previous DAYS."
   (with-db-worker-thread db
     (let ((query (format #f "SELECT id from Evaluations
-WHERE date(timestamp, 'unixepoch') > date('now', '-~a day') AND
-status = 0 ORDER BY rowid DESC" days)))
-      (let loop ((rows (sqlite-exec db query))
+WHERE to_timestamp(timestamp)::date > 'today'::date - interval '~a day' AND
+status = 0 ORDER BY id DESC" days)))
+      (let loop ((rows (exec-query db query))
                  (evaluations '()))
         (match rows
           (() (reverse evaluations))
-          ((#(id) . rest)
+          (((id) . rest)
            (loop rest
                  (cons id evaluations))))))))
 
@@ -187,16 +218,19 @@ status = 0 ORDER BY rowid DESC" days)))
    ;; Average evaluation duration per specification.
    (metric
     (id 'average-10-last-eval-duration-per-spec)
+    (field-type 'string)
     (compute-proc
      (cut db-average-eval-duration-per-spec <> #:limit 10)))
 
    (metric
     (id 'average-100-last-eval-duration-per-spec)
+    (field-type 'string)
     (compute-proc
      (cut db-average-eval-duration-per-spec <> #:limit 100)))
 
    (metric
     (id 'average-eval-duration-per-spec)
+    (field-type 'string)
     (compute-proc db-average-eval-duration-per-spec))
 
    ;; Builds count per day.
@@ -220,16 +254,19 @@ status = 0 ORDER BY rowid DESC" days)))
    ;; Percentage of failed evaluations per specification.
    (metric
     (id 'percentage-failure-10-last-eval-per-spec)
+    (field-type 'string)
     (compute-proc
      (cut db-percentage-failed-eval-per-spec <> #:limit 10)))
 
    (metric
     (id 'percentage-failure-100-last-eval-per-spec)
+    (field-type 'string)
     (compute-proc
      (cut db-percentage-failed-eval-per-spec <> #:limit 100)))
 
    (metric
     (id 'percentage-failed-eval-per-spec)
+    (field-type 'string)
     (compute-proc db-percentage-failed-eval-per-spec))
 
    ;; Average time to start a build for an evaluation.
@@ -268,33 +305,38 @@ to identify the metric type in database."
 
 (define* (db-get-metric id field)
   "Return the metric with the given ID and FIELD."
-  (let* ((metric (find-metric id))
-         (type (metric->type metric)))
-    (with-db-worker-thread db
-    (let ((rows (sqlite-exec db "SELECT value from Metrics
-WHERE type = " type " AND field = " field ";")))
-      (and=> (expect-one-row rows) (cut vector-ref <> 0))))))
+  (with-db-worker-thread db
+    (let* ((metric (find-metric id))
+           (type (metric->type metric)))
+      (return-inexact
+       (exec-query/bind db "SELECT value from Metrics
+WHERE type = " type " AND field = " field ";")))))
 
 (define* (db-get-metrics-with-id id
                                  #:key
                                  limit
-                                 (order "rowid DESC"))
+                                 (order "id DESC"))
   "Return the metrics with the given ID.  If LIMIT is set, the resulting list
 if restricted to LIMIT records."
-  (let* ((metric (find-metric id))
-         (type (metric->type metric))
-         (limit (or limit -1)))
-    (with-db-worker-thread db
+  (with-db-worker-thread db
+    (let* ((metric (find-metric id))
+           (type (metric->type metric))
+           (field-type (metric-field-type metric))
+           (limit (or limit "ALL")))
       (let ((query (format #f "SELECT field, value from Metrics
-WHERE type = ? ORDER BY ~a LIMIT ~a" order limit)))
-        (let loop ((rows (%sqlite-exec db query type))
+WHERE type = :type ORDER BY ~a LIMIT ~a" order limit))
+            (params `((#:type . ,type))))
+        (let loop ((rows (exec-query/bind-params db query params))
                    (metrics '()))
           (match rows
             (() (reverse metrics))
-            ((#(field value) . rest)
-             (loop rest
-                   `((,field . ,value)
-                     ,@metrics)))))))))
+            (((field value) . rest)
+             (let ((field (match field-type
+                            ('int (string->number field))
+                            (else field))))
+               (loop rest
+                     `((,field . ,(locale-string->inexact value))
+                       ,@metrics))))))))))
 
 (define* (db-update-metric id #:optional field)
   "Compute and update the value of the metric ID in database.
@@ -306,67 +348,66 @@ for periodical metrics for instance."
   (define now
     (time-second (current-time time-utc)))
 
-  (let* ((metric (find-metric id))
-         (field-proc (metric-field-proc metric))
-         (field (or field (field-proc)))
-         (value (compute-metric metric field)))
-    (if value
-        (begin
-          (log-message "Updating metric ~a (~a) to ~a."
-                       (symbol->string id) field value)
-          (with-db-worker-thread db
-            (sqlite-exec db "\
-INSERT OR REPLACE INTO Metrics (field, type, value,
+  (with-db-worker-thread db
+    (let* ((metric (find-metric id))
+           (field-proc (metric-field-proc metric))
+           (field (or field (field-proc)))
+           (value (compute-metric metric field)))
+      (if value
+          (begin
+            (log-message "Updating metric ~a (~a) to ~a."
+                         (symbol->string id) field value)
+            (exec-query/bind db "\
+INSERT INTO Metrics (field, type, value,
 timestamp) VALUES ("
-                         field ", "
-                         (metric->type metric) ", "
-                         value ", "
-                         now ");")
-            (last-insert-rowid db)))
-        (log-message "Failed to compute metric ~a (~a)."
-                     (symbol->string id) field))))
+                             field ", "
+                             (metric->type metric) ", "
+                             value ", "
+                             now ")
+ON CONFLICT ON CONSTRAINT metrics_pkey DO
+UPDATE SET value = " value ", timestamp = " now ";"))
+          (log-message "Failed to compute metric ~a (~a)."
+                       (symbol->string id) field)))))
 
 (define (db-update-metrics)
   "Compute and update all available metrics in database."
-  (with-db-writer-worker-thread/force db
-    (catch-sqlite-error
-     ;; We can not update all evaluations metrics for performance reasons.
-     ;; Limit to the evaluations that were added during the past three days.
-     (let ((specifications
-            (map (cut assq-ref <> #:name) (db-get-specifications)))
-           (evaluations (db-latest-evaluations)))
-       (sqlite-exec db "BEGIN TRANSACTION;")
-
-       (db-update-metric 'builds-per-day)
-       (db-update-metric 'new-derivations-per-day)
-       (db-update-metric 'pending-builds)
-
-       ;; Update specification related metrics.
-       (for-each (lambda (spec)
-                   (db-update-metric
-                    'average-10-last-eval-duration-per-spec spec)
-                   (db-update-metric
-                    'average-100-last-eval-duration-per-spec spec)
-                   (db-update-metric
-                    'average-eval-duration-per-spec spec)
-
-                   (db-update-metric
-                    'percentage-failure-10-last-eval-per-spec spec)
-                   (db-update-metric
-                    'percentage-failure-100-last-eval-per-spec spec)
-                   (db-update-metric
-                    'percentage-failed-eval-per-spec spec))
-                 specifications)
-
-       ;; Update evaluation related metrics.
-       (for-each (lambda (evaluation)
-                   (db-update-metric
-                    'average-eval-build-start-time evaluation)
-                   (db-update-metric
-                    'average-eval-build-complete-time evaluation)
-                   (db-update-metric
-                    'evaluation-completion-speed evaluation))
-                 evaluations)
-
-       (sqlite-exec db "COMMIT;"))
-     (on SQLITE_BUSY_SNAPSHOT => #f))))
+  ;; We can not update all evaluations metrics for performance reasons.
+  ;; Limit to the evaluations that were added during the past three days.
+  (with-db-worker-thread db
+    (let ((specifications
+           (map (cut assq-ref <> #:name) (db-get-specifications)))
+          (evaluations (db-latest-evaluations)))
+      (exec-query db "BEGIN TRANSACTION;")
+
+      (db-update-metric 'builds-per-day)
+      (db-update-metric 'new-derivations-per-day)
+      (db-update-metric 'pending-builds)
+
+      ;; Update specification related metrics.
+      (for-each (lambda (spec)
+                  (db-update-metric
+                   'average-10-last-eval-duration-per-spec spec)
+                  (db-update-metric
+                   'average-100-last-eval-duration-per-spec spec)
+                  (db-update-metric
+                   'average-eval-duration-per-spec spec)
+
+                  (db-update-metric
+                   'percentage-failure-10-last-eval-per-spec spec)
+                  (db-update-metric
+                   'percentage-failure-100-last-eval-per-spec spec)
+                  (db-update-metric
+                   'percentage-failed-eval-per-spec spec))
+                specifications)
+
+      ;; Update evaluation related metrics.
+      (for-each (lambda (evaluation)
+                  (db-update-metric
+                   'average-eval-build-start-time evaluation)
+                  (db-update-metric
+                   'average-eval-build-complete-time evaluation)
+                  (db-update-metric
+                   'evaluation-completion-speed evaluation))
+                evaluations)
+
+      (exec-query db "COMMIT;"))))
diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 70c1504..b485f90 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -18,6 +18,7 @@
 
 (define-module (cuirass remote-server)
   #:use-module (cuirass base)
+  #:use-module (cuirass config)
   #:use-module (cuirass database)
   #:use-module (cuirass logging)
   #:use-module (cuirass remote)
@@ -66,7 +67,7 @@
 (define %cache-directory
   (make-parameter #f))
 
-(define %log-directory
+(define %trigger-substitute-url
   (make-parameter #f))
 
 (define %private-key
@@ -92,7 +93,8 @@ Start a remote build server.\n"))
   (display (G_ "
   -c, --cache=DIRECTORY     cache built items to DIRECTORY"))
   (display (G_ "
-  -l, --log-directory=DIRECTORY   cache log files to DIRECTORY"))
+  -t, --trigger-substitute-url=URL
+                            trigger substitute baking at URL"))
   (display (G_ "
   -u, --user=USER           change privileges to USER as soon as possible"))
   (display (G_ "
@@ -115,9 +117,9 @@ Start a remote build server.\n"))
         (option '(#\V "version") #f #f
                 (lambda _
                   (show-version-and-exit "guix publish")))
-        (option '(#\a "add-to-store") #t #f
+        (option '(#\a "add-to-store") #f #f
                 (lambda (opt name arg result)
-                  (alist-cons 'add-to-store? arg result)))
+                  (alist-cons 'add-to-store? #t result)))
         (option '(#\b "backend-port") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'backend-port (string->number* arg) result)))
@@ -130,9 +132,9 @@ Start a remote build server.\n"))
         (option '(#\c "cache") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'cache arg result)))
-        (option '(#\l "log-directory") #t #f
+        (option '(#\t "trigger-substitute-url") #t #f
                 (lambda (opt name arg result)
-                  (alist-cons 'log-directory arg result)))
+                  (alist-cons 'trigger-substitute-url arg result)))
         (option '(#\u "user") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'user arg result)))
@@ -202,7 +204,7 @@ be used to reply to the worker."
     (('worker-ready worker)
      (update-workers! worker
                       (lambda (name)
-                        (info (G_ "Worker `~a' is ready.~%") name))))
+                        (log-message (G_ "Worker `~a' is ready.") name))))
     (('worker-request-work name)
      (let ((build (pop-build name)))
        (if build
@@ -210,14 +212,15 @@ be used to reply to the worker."
                  (priority (assq-ref build #:priority))
                  (timeout (assq-ref build #:timeout))
                  (max-silent (assq-ref build #:max-silent)))
+             (db-update-build-worker! derivation name)
              (db-update-build-status! derivation (build-status submitted))
              (reply-worker
               (zmq-build-request-message derivation
                                          #:priority priority
                                          #:timeout timeout
-                                         #:max-silent max-silent))))
-         (reply-worker
-          (zmq-no-build-message))))
+                                         #:max-silent max-silent)))
+           (reply-worker
+            (zmq-no-build-message)))))
     (('worker-ping worker)
      (update-workers! worker (const #t))
      (db-clear-workers)
@@ -289,7 +292,7 @@ be used to reply to the worker."
       (display path port))))
 
 (define (log-path cache-directory output)
-  (string-append cache-directory "/" (basename output) ".log"))
+  (string-append cache-directory "/logs/" (basename output) ".log"))
 
 (define* (sign-narinfo! narinfo)
   "Edit the given NARINFO file to replace the worker signature by the remote
@@ -359,17 +362,31 @@ build server signature."
 (define (download-log-file cache-directory derivation url)
   (let ((url (string-append url "/log/" (basename derivation)))
         (log-file (log-path cache-directory derivation)))
+    (mkdir-p (dirname log-file))
     (url-fetch* url log-file)))
 
 (define (add-to-store outputs url)
   "Add the OUTPUTS that are available from the substitute server at URL to the
 store."
   (with-store store
+    (set-build-options* store url)
     (for-each (lambda (output)
-                (set-build-options* store url)
+                (log-message "Fetch ~a from ~a." output url)
                 (ensure-path store output))
               (map derivation-output-path outputs))))
 
+(define (trigger-substitutes-baking outputs url)
+  (for-each (lambda (output)
+              (let* ((path (derivation-output-path output))
+                     (store-hash (strip-store-prefix path))
+                     (narinfo-url (publish-narinfo-url url store-hash)))
+                (call-with-temporary-output-file
+                 (lambda (tmp-file port)
+                   (log-message "Triggering substitute baking at ~a."
+                                narinfo-url)
+                   (url-fetch* narinfo-url tmp-file)))))
+            outputs))
+
 (define (need-fetching? message)
   "Return #t if the received MESSAGE implies that some output fetching is
 required and #f otherwise."
@@ -394,29 +411,28 @@ directory.  If %ADD-TO-STORE? is set, add the build 
outputs to the store."
               (read-derivation-from-file drv))))
       (const '())))
 
-  (let ((log-directory (%log-directory)))
-    (match (zmq-read-message message)
-      (('build-succeeded ('drv drv) ('url url) _ ...)
-       (let ((outputs (build-outputs drv))
-             (log-file
-              (and log-directory
-                   (download-log-file log-directory drv url))))
-         (when (%add-to-store?)
-           (add-to-store outputs url))
-         (when (%cache-directory)
-           (download-nar (%cache-directory) outputs url))
-         (log-message "build succeeded: '~a'" drv)
-         (set-build-successful! drv log-file)))
-      (('build-failed ('drv drv) ('url url) _ ...)
-       (let ((log-file
-              (and log-directory
-                   (download-log-file log-directory drv url))))
-         (log-message "build failed: '~a'" drv)
-         (db-update-build-status! drv
-                                  (if log-file
-                                      (build-status failed)
-                                      (build-status failed-dependency))
-                                  #:log-file log-file))))))
+  (match (zmq-read-message message)
+    (('build-succeeded ('drv drv) ('url url) _ ...)
+     (let ((outputs (build-outputs drv))
+           (log-file
+            (download-log-file (%cache-directory) drv url)))
+       (when (%add-to-store?)
+         (add-to-store outputs url))
+       (when (%trigger-substitute-url)
+         (trigger-substitutes-baking outputs (%trigger-substitute-url)))
+       (when (%cache-directory)
+         (download-nar (%cache-directory) outputs url))
+       (log-message "build succeeded: '~a'" drv)
+       (set-build-successful! drv log-file)))
+    (('build-failed ('drv drv) ('url url) _ ...)
+     (let ((log-file
+            (download-log-file (%cache-directory) drv url)))
+       (log-message "build failed: '~a'" drv)
+       (db-update-build-status! drv
+                                (if log-file
+                                    (build-status failed)
+                                    (build-status failed-dependency))
+                                #:log-file log-file)))))
 
 (define (start-fetch-worker name)
   "Start a fetch worker thread with the given NAME.  This worker takes care of
@@ -528,13 +544,6 @@ exiting."
       (leave (G_ "user '~a' not found: ~a~%")
              user (apply format #f message args)))))
 
-(define (init-database)
-  (%db-channel (make-worker-thread-channel
-                (lambda ()
-                  (list (db-open)))
-                #:parallelism 1))
-  (%db-writer-channel (%db-channel)))
-
 (define (remote-server args)
   (signal-handler)
 
@@ -550,7 +559,7 @@ exiting."
            (publish-port (assoc-ref opts 'publish-port))
            (cache (assoc-ref opts 'cache))
            (database (assoc-ref opts 'database))
-           (log-directory (assoc-ref opts 'log-directory))
+           (trigger-substitute-url (assoc-ref opts 'trigger-substitute-url))
            (user (assoc-ref opts 'user))
            (public-key
             (read-file-sexp
@@ -561,7 +570,7 @@ exiting."
 
       (parameterize ((%add-to-store? add-to-store?)
                      (%cache-directory cache)
-                     (%log-directory log-directory)
+                     (%trigger-substitute-url trigger-substitute-url)
                      (%package-database database)
                      (%public-key public-key)
                      (%private-key private-key))
@@ -584,11 +593,11 @@ exiting."
                          (atomic-box-ref %stop-process?))
           #:txt (list (string-append "publish="
                                      (number->string publish-port)))))
-        (init-database)
-        (for-each (lambda (number)
-                    (start-fetch-worker
-                     (string-append "fetch-worker-"
-                                    (number->string number))))
-                  (iota 4))
-
-        (zmq-start-proxy backend-port)))))
+        (with-database
+            (for-each (lambda (number)
+                        (start-fetch-worker
+                         (string-append "fetch-worker-"
+                                        (number->string number))))
+                      (iota 4))
+
+            (zmq-start-proxy backend-port))))))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 4e46434..64c0f0e 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -157,6 +157,7 @@ system whose names start with " (code "guile-") ":" (br)
 
 (define (status-class status)
   (cond
+    ((= (build-status submitted)         status) "oi oi-clock         
text-warning")
     ((= (build-status scheduled)         status) "oi oi-clock         
text-warning")
     ((= (build-status started)           status) "oi oi-reload        
text-warning")
     ((= (build-status succeeded)         status) "oi oi-check         
text-success")
@@ -168,6 +169,7 @@ system whose names start with " (code "guile-") ":" (br)
 
 (define (status-title status)
   (cond
+    ((= (build-status submitted)         status) "Submitted")
     ((= (build-status scheduled)         status) "Scheduled")
     ((= (build-status started)           status) "Started")
     ((= (build-status succeeded)         status) "Succeeded")
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index f32e3a1..892419a 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -23,6 +23,10 @@
   #:use-module (cuirass logging)
   #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
+  #:use-module ((ice-9 suspendable-ports)
+                #:select (current-read-waiter
+                          current-write-waiter))
+  #:use-module (ice-9 ports internal)
   #:use-module (rnrs bytevectors)
   #:use-module (system foreign)
   #:use-module (srfi srfi-1)
@@ -106,58 +110,32 @@ delimited continuations and fibers."
   (make-parameter #f))
 
 (define* (make-worker-thread-channel initializer
-                                     #:key
-                                     (parallelism 1)
-                                     queue-size
-                                     (queue-proc (const #t)))
+                                     #:key (parallelism 1))
   "Return a channel used to offload work to a dedicated thread.  ARGS are the
-arguments of the worker thread procedure.  This procedure supports deferring
-work sent to the worker.  If QUEUE-SIZE is set, each work query will be
-appended to a queue that will be run once it reaches QUEUE-SIZE elements.
-
-When that happens, the QUEUE-PROC procedure is called with %WORKER-THREAD-ARGS
-and a procedure running the queued work as arguments.  The worker thread can
-be passed options.  When #:FORCE? option is set, the worker runs the sent work
-immediately even if QUEUE-SIZE has been set."
+arguments of the worker thread procedure."
   (parameterize (((@@ (fibers internal) current-fiber) #f))
     (let ((channel (make-channel)))
       (for-each
        (lambda _
          (let ((args (initializer)))
            (call-with-new-thread
-            (lambda ()
-              (parameterize ((%worker-thread-args args))
-                (let loop ((queue '()))
-                  (match (get-message channel)
-                    (((? channel? reply) options (? procedure? proc))
-                     (put-message
-                      reply
-                      (catch #t
-                        (lambda ()
-                          (cond
-                           ((or (not queue-size)
-                                (assq-ref options #:force?))
+            (parameterize ((current-read-waiter (lambda (port)
+                                                  (port-poll port "r")))
+                           (current-write-waiter (lambda (port)
+                                                   (port-poll port "w"))))
+              (lambda ()
+                (parameterize ((%worker-thread-args args))
+                  (let loop ()
+                    (match (get-message channel)
+                      (((? channel? reply) . (? procedure? proc))
+                       (put-message
+                        reply
+                        (catch #t
+                          (lambda ()
                             (apply proc args))
-                           (else
-                            (length queue))))
-                        (lambda (key . args)
-                          (cons* 'worker-thread-error key args))))
-                     (let ((new-queue
-                         (cond
-                          ((or (not queue-size)
-                               (assq-ref options #:force?))
-                           '())
-                          ((= (1+ (length queue)) queue-size)
-                           (let ((run-queue
-                                  (lambda ()
-                                    (for-each (lambda (thunk)
-                                                (apply thunk args))
-                                              (append queue (list proc))))))
-                             (apply queue-proc (append args (list run-queue)))
-                             '()))
-                           (else
-                            (append queue (list proc))))))
-                    (loop new-queue))))))))))
+                          (lambda (key . args)
+                            (cons* 'worker-thread-error key args))))))
+                    (loop))))))))
        (iota parallelism))
       channel)))
 
@@ -225,7 +203,6 @@ put-operation until it succeeds."
 
 (define* (call-with-worker-thread channel proc
                                   #:key
-                                  options
                                   send-timeout
                                   send-timeout-proc
                                   receive-timeout
@@ -239,15 +216,12 @@ to a worker thread.
 
 The same goes for RECEIVE-TIMEOUT and RECEIVE-TIMEOUT-PROC, except that the
 timer expires if there is no response from the database worker PROC was sent
-to.
-
-OPTIONS are forwarded to the worker thread.  See MAKE-WORKER-THREAD-CHANNEL
-for a description of the supported options."
+to."
   (let ((args (%worker-thread-args)))
     (if args
         (apply proc args)
         (let* ((reply (make-channel))
-               (message (list reply options proc)))
+               (message (cons reply proc)))
           (if (and send-timeout (current-fiber))
               (put-message-with-timeout channel message
                                         #:seconds send-timeout
diff --git a/src/schema.sql b/src/schema.sql
index 761b48f..bc4d86c 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -1,5 +1,9 @@
 BEGIN TRANSACTION;
 
+CREATE TABLE SchemaVersion (
+    version     INTEGER NOT NULL
+);
+
 CREATE TABLE Specifications (
   name          TEXT NOT NULL PRIMARY KEY,
   load_path_inputs TEXT NOT NULL, -- list of input names whose load path will 
be in Guile's %load-path
@@ -23,41 +27,34 @@ CREATE TABLE Inputs (
   revision      TEXT,
   no_compile_p  INTEGER,
   PRIMARY KEY (specification, name),
-  FOREIGN KEY (specification) REFERENCES Specifications (name)
-);
-
-CREATE TABLE Checkouts (
-  specification TEXT NOT NULL,
-  revision      TEXT NOT NULL,
-  evaluation    INTEGER NOT NULL,
-  input         TEXT NOT NULL,
-  directory     TEXT NOT NULL,
-  timestamp     INTEGER NOT NULL,
-  PRIMARY KEY (specification, revision),
-  FOREIGN KEY (evaluation) REFERENCES Evaluations (id),
-  FOREIGN KEY (specification) REFERENCES Specifications (name),
-  FOREIGN KEY (input) REFERENCES Inputs (name)
+  FOREIGN KEY (specification) REFERENCES Specifications(name)
 );
 
 CREATE TABLE Evaluations (
-  id            INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
+  id            SERIAL PRIMARY KEY,
   specification TEXT NOT NULL,
   status        INTEGER NOT NULL,
   timestamp     INTEGER NOT NULL,
   checkouttime  INTEGER NOT NULL,
   evaltime      INTEGER NOT NULL,
-  FOREIGN KEY (specification) REFERENCES Specifications (name)
+  FOREIGN KEY (specification) REFERENCES Specifications(name)
 );
 
-CREATE TABLE Outputs (
-  derivation TEXT NOT NULL,
-  name TEXT NOT NULL,
-  path TEXT NOT NULL PRIMARY KEY,
-  FOREIGN KEY (derivation) REFERENCES Builds (derivation)
+CREATE TABLE Checkouts (
+  specification TEXT NOT NULL,
+  revision      TEXT NOT NULL,
+  evaluation    INTEGER NOT NULL,
+  input         TEXT NOT NULL,
+  directory     TEXT NOT NULL,
+  timestamp     INTEGER NOT NULL,
+  PRIMARY KEY (specification, revision),
+  FOREIGN KEY (evaluation) REFERENCES Evaluations(id),
+  FOREIGN KEY (specification) REFERENCES Specifications(name),
+  FOREIGN KEY (specification, input) REFERENCES Inputs(specification, name)
 );
 
 CREATE TABLE Builds (
-  id            INTEGER NOT NULL PRIMARY KEY,
+  id            SERIAL PRIMARY KEY,
   derivation    TEXT NOT NULL UNIQUE,
   evaluation    INTEGER NOT NULL,
   job_name      TEXT NOT NULL,
@@ -72,11 +69,19 @@ CREATE TABLE Builds (
   timestamp     INTEGER NOT NULL,
   starttime     INTEGER NOT NULL,
   stoptime      INTEGER NOT NULL,
-  FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
+  FOREIGN KEY (evaluation) REFERENCES Evaluations(id)
+);
+
+CREATE TABLE Outputs (
+  derivation TEXT NOT NULL,
+  name TEXT NOT NULL,
+  path TEXT NOT NULL PRIMARY KEY,
+  FOREIGN KEY (derivation) REFERENCES Builds(derivation) ON DELETE CASCADE
 );
 
 CREATE TABLE Metrics (
-  field         INTEGER NOT NULL,
+  id            SERIAL,
+  field         TEXT NOT NULL,
   type          INTEGER NOT NULL,
   value         DOUBLE PRECISION NOT NULL,
   timestamp     INTEGER NOT NULL,
@@ -84,17 +89,18 @@ CREATE TABLE Metrics (
 );
 
 CREATE TABLE BuildProducts (
+  id            SERIAL,
   build         INTEGER NOT NULL,
   type          TEXT NOT NULL,
   file_size     BIGINT NOT NULL,
   checksum      TEXT NOT NULL,
   path          TEXT NOT NULL,
-  PRIMARY KEY (build, path)
-  FOREIGN KEY (build) REFERENCES Builds (id) ON DELETE CASCADE
+  PRIMARY KEY (build, path),
+  FOREIGN KEY (build) REFERENCES Builds(id) ON DELETE CASCADE
 );
 
 CREATE TABLE Events (
-  id            INTEGER PRIMARY KEY,
+  id            SERIAL PRIMARY KEY,
   type          TEXT NOT NULL,
   timestamp     INTEGER NOT NULL,
   event_json    TEXT NOT NULL
@@ -112,7 +118,7 @@ CREATE TABLE Workers (
 CREATE INDEX Builds_status_index ON Builds (status);
 CREATE INDEX Builds_evaluation_index ON Builds (evaluation, status);
 CREATE INDEX Builds_job_name_timestamp on Builds(job_name, timestamp);
-CREATE INDEX Builds_nix_name ON Builds (nix_name COLLATE NOCASE);
+CREATE INDEX Builds_nix_name ON Builds (nix_name);
 CREATE INDEX Builds_timestamp_stoptime on Builds(timestamp, stoptime);
 CREATE INDEX Builds_stoptime on Builds(stoptime DESC);
 CREATE INDEX Builds_stoptime_id on Builds(stoptime DESC, id DESC);
diff --git a/src/sql/upgrade-1.sql b/src/sql/upgrade-1.sql
index 7874f94..5ec73bf 100644
--- a/src/sql/upgrade-1.sql
+++ b/src/sql/upgrade-1.sql
@@ -1,78 +1,3 @@
 BEGIN TRANSACTION;
 
-DROP INDEX Specifications_index;
-
-ALTER TABLE Specifications RENAME TO tmp_Specifications;
-ALTER TABLE Stamps RENAME TO tmp_Stamps;
-ALTER TABLE Evaluations RENAME TO tmp_Evaluations;
-
-CREATE TABLE Specifications (
-  name          TEXT NOT NULL PRIMARY KEY,
-  load_path_inputs TEXT NOT NULL, -- list of input names whose load path will 
be in Guile's %load-path
-  package_path_inputs TEXT NOT NULL, -- list of input names whose load paths 
will be in GUIX_PACKAGE_PATH
-  proc_input    TEXT NOT NULL, -- name of the input containing the proc that 
does the evaluation
-  proc_file     TEXT NOT NULL, -- file containing the procedure that does the 
evaluation, relative to proc_input
-  proc          TEXT NOT NULL, -- defined in proc_file
-  proc_args     TEXT NOT NULL  -- passed to proc
-);
-
-CREATE TABLE Inputs (
-  specification TEXT NOT NULL,
-  name          TEXT NOT NULL,
-  url           TEXT NOT NULL,
-  load_path     TEXT NOT NULL,
-  -- The following columns are optional.
-  branch        TEXT,
-  tag           TEXT,
-  revision      TEXT,
-  no_compile_p  INTEGER,
-  PRIMARY KEY (specification, name),
-  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 Evaluations (
-  id            INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
-  specification TEXT NOT NULL,
-  commits       TEXT NOT NULL,
-  FOREIGN KEY (specification) REFERENCES Specifications (name)
-);
-
-INSERT INTO Specifications (name, load_path_inputs, package_path_inputs, 
proc_input, proc_file, proc, proc_args)
-SELECT printf('%s-%s', repo_name, branch) AS name,
-       printf('("%s")', repo_name)        AS load_path_inputs,
-       '()'                               AS package_path_inputs,
-       repo_name                          AS proc_input,
-       file                               AS proc_file,
-       proc,
-       arguments                          AS proc_args
-FROM tmp_Specifications;
-
-INSERT INTO Inputs (specification, name, url, load_path, branch, tag, 
revision, no_compile_p)
-SELECT printf('%s-%s', repo_name, branch) AS specification,
-       repo_name                          AS name,
-       url, load_path, branch, tag, revision, no_compile_p
-FROM tmp_Specifications;
-
-INSERT INTO Stamps (specification, stamp)
-SELECT Specifications.name AS specification, stamp
-FROM tmp_Stamps
-LEFT JOIN Specifications ON Specifications.proc_input = 
tmp_Stamps.specification;
-
-INSERT INTO Evaluations (id, specification, commits)
-SELECT id, Specifications.name AS specification, revision
-FROM tmp_Evaluations
-LEFT JOIN Specifications ON Specifications.proc_input = 
tmp_Evaluations.specification;
-
-CREATE INDEX Inputs_index ON Inputs(specification, name, branch);
-
-DROP TABLE tmp_Specifications;
-DROP TABLE tmp_Stamps;
-DROP TABLE tmp_Evaluations;
-
 COMMIT;
diff --git a/src/sql/upgrade-10.sql b/src/sql/upgrade-10.sql
deleted file mode 100644
index 0ad299c..0000000
--- a/src/sql/upgrade-10.sql
+++ /dev/null
@@ -1,12 +0,0 @@
-BEGIN TRANSACTION;
-
-ALTER TABLE Evaluations RENAME COLUMN in_progress TO status;
-
--- Set all pending evaluations to aborted.
-UPDATE Evaluations SET status = 2 WHERE status = 1;
-
--- All evaluations that did not trigger any build are set to failed.
-UPDATE Evaluations SET status = 1 WHERE id NOT IN
-(SELECT evaluation FROM Builds);
-
-COMMIT;
diff --git a/src/sql/upgrade-11.sql b/src/sql/upgrade-11.sql
deleted file mode 100644
index 22f2dac..0000000
--- a/src/sql/upgrade-11.sql
+++ /dev/null
@@ -1,11 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE TABLE Metrics (
-  field         INTEGER NOT NULL,
-  type          INTEGER NOT NULL,
-  value         DOUBLE PRECISION NOT NULL,
-  timestamp     INTEGER NOT NULL,
-  PRIMARY KEY (field, type)
-);
-
-COMMIT;
diff --git a/src/sql/upgrade-12.sql b/src/sql/upgrade-12.sql
deleted file mode 100644
index 06aaffe..0000000
--- a/src/sql/upgrade-12.sql
+++ /dev/null
@@ -1,7 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE INDEX Builds_evaluation_index ON Builds (evaluation, status);
-CREATE INDEX Evaluations_status_index ON Evaluations (id, status);
-CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id 
DESC);
-
-COMMIT;
diff --git a/src/sql/upgrade-13.sql b/src/sql/upgrade-13.sql
deleted file mode 100644
index b7a0cb5..0000000
--- a/src/sql/upgrade-13.sql
+++ /dev/null
@@ -1,5 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE INDEX Builds_nix_name ON Builds (nix_name COLLATE NOCASE);
-
-COMMIT;
diff --git a/src/sql/upgrade-14.sql b/src/sql/upgrade-14.sql
deleted file mode 100644
index 566077c..0000000
--- a/src/sql/upgrade-14.sql
+++ /dev/null
@@ -1,5 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE INDEX Builds_timestamp_stoptime on Builds(timestamp, stoptime);
-
-COMMIT;
diff --git a/src/sql/upgrade-15.sql b/src/sql/upgrade-15.sql
deleted file mode 100644
index 1fc38d6..0000000
--- a/src/sql/upgrade-15.sql
+++ /dev/null
@@ -1,7 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE INDEX Builds_stoptime on Builds(stoptime DESC);
-CREATE INDEX Builds_stoptime_id on Builds(stoptime DESC, id DESC);
-CREATE INDEX Builds_status_ts_id on Builds(status DESC, timestamp DESC, id 
ASC);
-
-COMMIT;
diff --git a/src/sql/upgrade-16.sql b/src/sql/upgrade-16.sql
deleted file mode 100644
index 47d498c..0000000
--- a/src/sql/upgrade-16.sql
+++ /dev/null
@@ -1,5 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE INDEX Builds_job_name_timestamp on Builds(job_name, timestamp);
-
-COMMIT;
diff --git a/src/sql/upgrade-17.sql b/src/sql/upgrade-17.sql
deleted file mode 100644
index 065ca5f..0000000
--- a/src/sql/upgrade-17.sql
+++ /dev/null
@@ -1,5 +0,0 @@
-BEGIN TRANSACTION;
-
-ALTER TABLE Builds ADD worker TEXT DEFAULT NULL;
-
-COMMIT;
diff --git a/src/sql/upgrade-18.sql b/src/sql/upgrade-18.sql
deleted file mode 100644
index 13b9f01..0000000
--- a/src/sql/upgrade-18.sql
+++ /dev/null
@@ -1,10 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE TABLE Workers (
-  name        TEXT NOT NULL PRIMARY KEY,
-  address     TEXT NOT NULL,
-  systems     TEXT NOT NULL,
-  last_seen   INTEGER NOT NULL
-);
-
-COMMIT;
diff --git a/src/sql/upgrade-19.sql b/src/sql/upgrade-19.sql
deleted file mode 100644
index 4213e11..0000000
--- a/src/sql/upgrade-19.sql
+++ /dev/null
@@ -1,11 +0,0 @@
-BEGIN TRANSACTION;
-
-ALTER TABLE Specifications ADD priority INTEGER NOT NULL DEFAULT 0;
-
-ALTER TABLE Builds ADD priority INTEGER NOT NULL DEFAULT 0;
-ALTER TABLE Builds ADD max_silent INTEGER NOT NULL DEFAULT 0;
-ALTER TABLE Builds ADD timeout INTEGER NOT NULL DEFAULT 0;
-
-CREATE INDEX Builds_priority_timestamp on Builds(priority DESC, timestamp ASC);
-
-COMMIT;
diff --git a/src/sql/upgrade-2.sql b/src/sql/upgrade-2.sql
deleted file mode 100644
index dfb919b..0000000
--- a/src/sql/upgrade-2.sql
+++ /dev/null
@@ -1,49 +0,0 @@
-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/src/sql/upgrade-3.sql b/src/sql/upgrade-3.sql
deleted file mode 100644
index 8e4a1bd..0000000
--- a/src/sql/upgrade-3.sql
+++ /dev/null
@@ -1,46 +0,0 @@
-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      TEXT NOT NULL,
-  evaluation    INTEGER 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/src/sql/upgrade-4.sql b/src/sql/upgrade-4.sql
deleted file mode 100644
index e567f03..0000000
--- a/src/sql/upgrade-4.sql
+++ /dev/null
@@ -1,18 +0,0 @@
-BEGIN TRANSACTION;
-
-ALTER TABLE Outputs RENAME TO tmp_Outputs;
-
-CREATE TABLE Outputs (
-  derivation TEXT NOT NULL,
-  name TEXT NOT NULL,
-  path TEXT NOT NULL PRIMARY KEY,
-  FOREIGN KEY (derivation) REFERENCES Builds (derivation)
-);
-
-INSERT OR IGNORE INTO Outputs (derivation, name, path)
-SELECT derivation, name, path
-FROM tmp_Outputs;
-
-DROP TABLE tmp_Outputs;
-
-COMMIT;
diff --git a/src/sql/upgrade-5.sql b/src/sql/upgrade-5.sql
deleted file mode 100644
index 8f30bde..0000000
--- a/src/sql/upgrade-5.sql
+++ /dev/null
@@ -1,15 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE TABLE Events (
-  id            INTEGER PRIMARY KEY,
-  type          TEXT NOT NULL,
-  timestamp     INTEGER NOT NULL,
-  event_json    TEXT NOT NULL
-);
-
-CREATE TABLE EventsOutbox (
-  event_id INTEGER NOT NULL,
-  FOREIGN KEY (event_id) REFERENCES Events (id)
-);
-
-COMMIT;
diff --git a/src/sql/upgrade-6.sql b/src/sql/upgrade-6.sql
deleted file mode 100644
index 0b25aa5..0000000
--- a/src/sql/upgrade-6.sql
+++ /dev/null
@@ -1,47 +0,0 @@
-BEGIN TRANSACTION;
-
-ALTER TABLE Builds RENAME TO OldBuilds;
-
-CREATE TABLE Builds (
-  id            INTEGER NOT NULL PRIMARY KEY,
-  derivation    TEXT NOT NULL UNIQUE,
-  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)
-);
-
-INSERT INTO Builds(
-  id,
-  derivation,
-  evaluation,
-  job_name,
-  system,
-  nix_name,
-  log,
-  status,
-  timestamp,
-  starttime,
-  stoptime
-) SELECT rowid,
-         derivation,
-         evaluation,
-         job_name,
-         system,
-         nix_name,
-         log,
-         status,
-         timestamp,
-         starttime,
-         stoptime
-  FROM OldBuilds;
-
-DROP TABLE OldBuilds;
-
-COMMIT;
diff --git a/src/sql/upgrade-7.sql b/src/sql/upgrade-7.sql
deleted file mode 100644
index b9bd4ff..0000000
--- a/src/sql/upgrade-7.sql
+++ /dev/null
@@ -1,15 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE TABLE BuildProducts (
-  build         INTEGER NOT NULL,
-  type          TEXT NOT NULL,
-  file_size     BIGINT NOT NULL,
-  checksum      TEXT NOT NULL,
-  path          TEXT NOT NULL,
-  PRIMARY KEY (build, path)
-  FOREIGN KEY (build) REFERENCES Builds (id) ON DELETE CASCADE
-);
-
-ALTER TABLE Specifications ADD build_outputs TEXT NOT NULL DEFAULT "()";
-
-COMMIT;
diff --git a/src/sql/upgrade-8.sql b/src/sql/upgrade-8.sql
deleted file mode 100644
index 1be3470..0000000
--- a/src/sql/upgrade-8.sql
+++ /dev/null
@@ -1,7 +0,0 @@
-BEGIN TRANSACTION;
-
-CREATE INDEX Builds_status_index ON Builds (status);
-
-CREATE INDEX Outputs_derivation_index ON Outputs (derivation);
-
-COMMIT;
diff --git a/src/sql/upgrade-9.sql b/src/sql/upgrade-9.sql
deleted file mode 100644
index 4de411a..0000000
--- a/src/sql/upgrade-9.sql
+++ /dev/null
@@ -1,9 +0,0 @@
-BEGIN TRANSACTION;
-
-ALTER TABLE Evaluations ADD timestamp INTEGER NOT NULL DEFAULT 0;
-ALTER TABLE Evaluations ADD checkouttime INTEGER NOT NULL DEFAULT 0;
-ALTER TABLE Evaluations ADD evaltime INTEGER NOT NULL DEFAULT 0;
-
-ALTER TABLE Checkouts ADD timestamp INTEGER NOT NULL DEFAULT 0;
-
-COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index d5fa060..923fbe2 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -21,8 +21,12 @@
 ;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
 
 (use-modules (cuirass database)
-             ((guix utils) #:select (call-with-temporary-output-file))
+             (cuirass remote)
              (cuirass utils)
+             ((guix utils) #:select (call-with-temporary-output-file))
+             (squee)
+             (ice-9 match)
+             (srfi srfi-19)
              (srfi srfi-64))
 
 (define example-spec
@@ -33,15 +37,15 @@
     (#:proc-file . "/tmp/gnu-system.scm")
     (#:proc . hydra-jobs)
     (#:proc-args (subset . "hello"))
-    (#:inputs . (((#:name . "savannah")
-                  (#:url . "git://git.savannah.gnu.org/guix.git")
+    (#:inputs . (((#:name . "maintenance")
+                  (#:url . "git://git.savannah.gnu.org/guix/maintenance.git")
                   (#:load-path . ".")
                   (#:branch . "master")
                   (#:tag . #f)
                   (#:commit . #f)
                   (#:no-compile? . #f))
-                 ((#:name . "maintenance")
-                  (#:url . "git://git.savannah.gnu.org/guix/maintenance.git")
+                 ((#:name . "savannah")
+                  (#:url . "git://git.savannah.gnu.org/guix.git")
                   (#:load-path . ".")
                   (#:branch . "master")
                   (#:tag . #f)
@@ -52,173 +56,340 @@
 
 (define (make-dummy-checkouts fakesha1 fakesha2)
   `(((#:commit . ,fakesha1)
-     (#:input . "guix")
+     (#:input . "savannah")
      (#:directory . "foo"))
     ((#:commit . ,fakesha2)
-     (#:input . "packages")
+     (#:input . "maintenance")
      (#:directory . "bar"))))
 
 (define* (make-dummy-build drv
-                           #:optional (eval-id 42)
+                           #:optional (eval-id 2)
                            #:key (outputs
                                   `(("foo" . ,(format #f "~a.output" drv)))))
   `((#:derivation . ,drv)
     (#:eval-id . ,eval-id)
     (#:job-name . "job")
+    (#:timestamp . ,(time-second (current-time time-utc)))
     (#:system . "x86_64-linux")
     (#:nix-name . "foo")
     (#:log . "log")
     (#:outputs . ,outputs)))
 
-(define-syntax-rule (with-temporary-database body ...)
-  (call-with-temporary-output-file
-   (lambda (file port)
-     (parameterize ((%package-database file))
-       (db-init file)
-       (with-database
-         (parameterize ((%db-writer-channel (%db-channel)))
-           body ...))))))
+(define %dummy-worker
+  (worker
+   (name "worker")
+   (address "address")
+   (systems '("a" "b"))
+   (last-seen "1")))
 
 (define %db
-  ;; Global Slot for a database object.
-  (make-parameter #t))
+  (make-parameter #f))
 
-(define database-name
-  ;; Use an empty and temporary database for the tests.
-  (string-append (getcwd) "/" (number->string (getpid)) "-tmp.db"))
+(define db-name "test_database")
+(%record-events? #t)
 
 (test-group-with-cleanup "database"
   (test-assert "db-init"
     (begin
-      (%db (db-init database-name))
+      (%db (db-open))
       (%db-channel (make-worker-thread-channel
                     (lambda ()
                       (list (%db)))))
-      (%db-writer-channel (%db-channel))
       #t))
 
-  (test-assert "sqlite-exec"
-    (begin
-      (sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, status,
-timestamp, checkouttime, evaltime) VALUES (1, 0, 0, 0, 0);")
-      (sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, status,
-timestamp, checkouttime, evaltime) VALUES (2, 0, 0, 0, 0);")
-      (sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, status,
-timestamp, checkouttime, evaltime) VALUES (3, 0, 0, 0, 0);")
-      (sqlite-exec (%db) "SELECT * FROM Evaluations;")))
-
   (test-equal "db-add-specification"
-    example-spec
+    "guix"
+    (db-add-specification example-spec))
+
+  (test-assert "exec-query"
     (begin
-      (db-add-specification example-spec)
-      (car (db-get-specifications))))
+      (exec-query (%db) "\
+INSERT INTO Evaluations (specification, status,
+timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
+      (exec-query (%db) "SELECT * FROM Evaluations;")))
 
   (test-equal "db-get-specification"
     example-spec
     (db-get-specification "guix"))
 
+  (test-equal "db-add-evaluation"
+    '(2 3)
+    (list
+     (db-add-evaluation "guix"
+                        (make-dummy-checkouts "fakesha1" "fakesha2"))
+     (db-add-evaluation "guix"
+                        (make-dummy-checkouts "fakesha3" "fakesha4"))))
+
+  (test-assert "db-set-evaluation-status"
+    (db-set-evaluation-status 2 (evaluation-status started)))
+
+  (test-assert "db-set-evaluation-time"
+    (db-set-evaluation-time 2))
+
+  (test-assert "db-abort-pending-evaluations"
+    (db-abort-pending-evaluations))
+
   (test-equal "db-add-build"
-    #f
+    "/foo.drv"
     (let ((build (make-dummy-build "/foo.drv")))
-      (db-add-build build)
+      (db-add-build build)))
+
+  (test-assert "db-add-build-product"
+    (db-add-build-product `((#:build . 1)
+                            (#:type . "1")
+                            (#:file-size . 1)
+                            (#:checksum . "sum")
+                            (#:path . "path"))))
+
+  (test-equal "db-get-output"
+    '((#:derivation . "/foo.drv") (#:name . "foo"))
+    (db-get-output "/foo.drv.output"))
+
+  (test-equal "db-get-outputs"
+    '(("foo" (#:path . "/foo.drv.output")))
+    (db-get-outputs "/foo.drv"))
+
+  (test-assert "db-get-time-since-previous-build"
+    (db-get-time-since-previous-build "job" "guix"))
+
+  (test-assert "db-register-builds"
+    (let ((drv "/test.drv"))
+      (db-register-builds `(((#:job-name . "test")
+                             (#:derivation . ,drv)
+                             (#:system . "x86_64-linux")
+                             (#:nix-name . "test")
+                             (#:log . "log")
+                             (#:outputs .
+                              (("foo" . ,(format #f "~a.output" drv))
+                               ("foo2" . ,(format #f "~a.output.2" drv))))))
+                          2 (db-get-specification "guix"))))
+
+  (test-assert "db-update-build-status!"
+    (db-update-build-status! "/test.drv"
+                             (build-status failed)))
+
+  (test-assert "db-update-build-worker!"
+    (db-update-build-worker! "/test.drv" "worker"))
+
+  (test-equal "db-get-builds-by-search"
+    '(2 1 "test")
+    (let ((build
+           (match (db-get-builds-by-search
+                   '((nr . 1)
+                     (query . "status:failed test")))
+             ((build) build))))
+      (list
+       (assoc-ref build #:id)
+       (assoc-ref build #:status)
+       (assoc-ref build #:job-name))))
+
+  (test-assert "db-get-builds"
+    (let* ((build (match (db-get-builds `((order . build-id)
+                                          (status . failed)))
+                    ((build) build)))
+           (outputs (assq-ref build #:outputs)))
+      (equal? outputs
+              '(("foo" (#:path . "/test.drv.output"))
+                ("foo2" (#:path . "/test.drv.output.2"))))))
+
+  (test-equal "db-get-builds job-name"
+    "/foo.drv"
+    (let ((build (match (db-get-builds `((order . build-id)
+                                         (job . "job")))
+                   ((build) build))))
+      (assoc-ref build #:derivation)))
+
+  (test-equal "db-get-build"
+    "/foo.drv"
+    (let ((build (db-get-build 1)))
+      (assoc-ref build #:derivation)))
+
+  (test-equal "db-get-build derivation"
+    1
+    (let ((build (db-get-build "/foo.drv")))
+      (assoc-ref build #:id)))
+
+  (test-equal "db-get-events"
+    'evaluation
+    (let ((event (match (db-get-events '((nr . 1)
+                                         (type . evaluation)))
+                   ((event) event))))
+      (assoc-ref event #:type)))
+
+  (test-equal "db-delete-events-with-ids-<=-to"
+    1
+    (db-delete-events-with-ids-<=-to 1))
+
+  (test-equal "db-get-pending-derivations"
+    '("/foo.drv")
+    (db-get-pending-derivations))
+
+  (test-assert "db-get-checkouts"
+    (equal? (db-get-checkouts 2)
+            (make-dummy-checkouts "fakesha1" "fakesha2")))
+
+  (test-equal "db-get-evaluation"
+    "guix"
+    (let ((evaluation (db-get-evaluation 2)))
+      (assq-ref evaluation #:specification)))
+
+  (test-equal "db-get-evaluations"
+    '("guix" "guix")
+    (map (lambda (eval)
+           (assq-ref eval #:specification))
+         (db-get-evaluations 2)))
+
+  (test-equal "db-get-evaluations-build-summary"
+    '((0 0 0) (0 1 1))
+    (let ((summaries
+           (db-get-evaluations-build-summary "guix" 2 #f #f)))
+      (map (lambda (summary)
+             (list
+              (assq-ref summary #:succeeded)
+              (assq-ref summary #:failed)
+              (assq-ref summary #:scheduled)))
+           summaries)))
+
+  (test-equal "db-get-evaluations-id-min"
+    1
+    (db-get-evaluations-id-min "guix"))
+
+  (test-equal "db-get-evaluations-id-min"
+    #f
+    (db-get-evaluations-id-min "foo"))
+
+  (test-equal "db-get-evaluations-id-max"
+    3
+    (db-get-evaluations-id-max "guix"))
+
+  (test-equal "db-get-evaluations-id-max"
+    #f
+    (db-get-evaluations-id-max "foo"))
+
+  (test-equal "db-get-evaluation-summary"
+    '(2 0 1 1)
+    (let* ((summary (db-get-evaluation-summary 2))
+           (total (assq-ref summary #:total))
+           (succeeded (assq-ref summary #:succeeded))
+           (failed (assq-ref summary #:failed))
+           (scheduled (assq-ref summary #:scheduled)))
+      (list total succeeded failed scheduled)))
+
+  (test-equal "db-get-evaluation-summary empty"
+    '(0 0 0 0)
+    (let* ((summary (db-get-evaluation-summary 3))
+           (total (assq-ref summary #:total))
+           (succeeded (assq-ref summary #:succeeded))
+           (failed (assq-ref summary #:failed))
+           (scheduled (assq-ref summary #:scheduled)))
+      (list total succeeded failed scheduled)))
+
+  (test-equal "db-get-builds-query-min"
+    '(1)
+    (db-get-builds-query-min "spec:guix foo"))
+
+  (test-equal "db-get-builds-query-max"
+    '(2)
+    (db-get-builds-query-min "spec:guix status:failed test"))
+
+  (test-equal "db-get-builds-min"
+    2
+    (match (db-get-builds-min 2 "failed")
+      ((timestamp id)
+       id)))
+
+  (test-equal "db-get-builds-max"
+    1
+    (match (db-get-builds-max 2 "pending")
+      ((timestamp id)
+       id)))
 
-      ;; Should return #f when adding a build whose derivation is already
-      ;; there, see <https://bugs.gnu.org/28094>.
-      (catch-sqlite-error
-       (db-add-build build)
-       (on SQLITE_CONSTRAINT_UNIQUE => #f))))
+  (test-equal "db-get-evaluation-specification"
+    "guix"
+    (db-get-evaluation-specification 2))
+
+  (test-equal "db-get-build-product-path"
+    "path"
+    (db-get-build-product-path 1))
+
+  (test-equal "db-add-worker"
+    1
+    (db-add-worker %dummy-worker))
+
+  (test-equal "db-get-workers"
+    (list %dummy-worker)
+    (db-get-workers))
+
+  (test-equal "db-clear-workers"
+    '()
+    (begin
+      (db-clear-workers)
+      (db-get-workers)))
 
   (test-equal "db-update-build-status!"
     (list (build-status scheduled)
           (build-status started)
           (build-status succeeded)
-          "/foo.drv.log")
-    (with-temporary-database
-      (let* ((derivation (db-add-build
-                          (make-dummy-build "/foo.drv" 1
-                                            #:outputs '(("out" . "/foo")))))
-             (get-status (lambda* (#:optional (key #:status))
-                           (assq-ref (db-get-build derivation) key))))
-        (db-add-evaluation "guix" (make-dummy-checkouts "fakesha1"
-                                                        "fakesha2"))
-        (db-add-specification example-spec)
-
-        (let ((status0 (get-status)))
-          (db-update-build-status! "/foo.drv" (build-status started))
-          (let ((status1 (get-status)))
-            (db-update-build-status! "/foo.drv" (build-status succeeded)
-                                     #:log-file "/foo.drv.log")
-
-            ;; Second call shouldn't make any difference.
-            (db-update-build-status! "/foo.drv" (build-status succeeded)
-                                     #:log-file "/foo.drv.log")
-
-            (let ((status2 (get-status))
-                  (start   (get-status #:starttime))
-                  (end     (get-status #:stoptime))
-                  (log     (get-status #:log)))
-              (and (> start 0) (>= end start)
-                   (list status0 status1 status2 log))))))))
+          "/foo2.drv.log")
+    (let* ((derivation (db-add-build
+                        (make-dummy-build "/foo2.drv" 2
+                                          #:outputs '(("out" . "/foo")))))
+           (get-status (lambda* (#:optional (key #:status))
+                         (assq-ref (db-get-build derivation) key))))
+      (let ((status0 (get-status)))
+        (db-update-build-status! "/foo2.drv" (build-status started))
+        (let ((status1 (get-status)))
+          (db-update-build-status! "/foo2.drv" (build-status succeeded)
+                                   #:log-file "/foo2.drv.log")
+
+          ;; Second call shouldn't make any difference.
+          (db-update-build-status! "/foo2.drv" (build-status succeeded)
+                                   #:log-file "/foo2.drv.log")
+
+          (let ((status2 (get-status))
+                (start   (get-status #:starttime))
+                (end     (get-status #:stoptime))
+                (log     (get-status #:log)))
+            (and (> start 0) (>= end start)
+                 (list status0 status1 status2 log)))))))
 
   (test-equal "db-get-builds"
-    #(((1 "/foo.drv") (2 "/bar.drv") (3 "/baz.drv")) ;ascending order
-      ((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;descending order
-      ((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto
-      ((3 "/baz.drv"))                               ;nr = 1
-      ((2 "/bar.drv") (1 "/foo.drv") (3 "/baz.drv"))) ;status+submission-time
-    (with-temporary-database
-      ;; Populate the 'Builds'', 'Evaluations', and
-      ;; 'Specifications' tables in a consistent way, as expected by the
-      ;; 'db-get-builds' query.
-      (db-add-build (make-dummy-build "/foo.drv" 1
-                                      #:outputs `(("out" . "/foo"))))
+    '(("/baa.drv" "/bar.drv" "/baz.drv") ;ascending order
+      ("/baz.drv" "/bar.drv" "/baa.drv") ;descending order
+      ("/baz.drv" "/bar.drv" "/baa.drv") ;ditto
+      ("/baz.drv")                               ;nr = 1
+      ("/bar.drv" "/baa.drv" "/baz.drv")) ;status+submission-time
+    (begin
+      (exec-query (%db) "DELETE FROM Builds;")
+      (db-add-build (make-dummy-build "/baa.drv" 2
+                                      #:outputs `(("out" . "/baa"))))
       (db-add-build (make-dummy-build "/bar.drv" 2
                                       #:outputs `(("out" . "/bar"))))
-      (db-add-build (make-dummy-build "/baz.drv" 3
+      (db-add-build (make-dummy-build "/baz.drv" 2
                                       #:outputs `(("out" . "/baz"))))
-      (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)
                                #:log-file "/bar.drv.log")
-
       (let ((summarize (lambda (alist)
-                         (list (assq-ref alist #:id)
-                               (assq-ref alist #:derivation)))))
-        (vector (map summarize (db-get-builds '((nr . 3) (order . build-id))))
-                (map summarize (db-get-builds '()))
-                (map summarize (db-get-builds '((jobset . "guix"))))
-                (map summarize (db-get-builds '((nr . 1))))
-                (map summarize
-                     (db-get-builds '((order . status+submission-time))))))))
+                         (assq-ref alist #:derivation))))
+        (list (map summarize (db-get-builds '((nr . 3) (order . build-id))))
+              (map summarize (db-get-builds '()))
+              (map summarize (db-get-builds '((jobset . "guix"))))
+              (map summarize (db-get-builds '((nr . 1))))
+              (map summarize
+                   (db-get-builds '((order . status+submission-time))))))))
 
   (test-equal "db-get-pending-derivations"
     '("/bar.drv" "/foo.drv")
-    (with-temporary-database
-      ;; Populate the 'Builds', 'Evaluations', and 'Specifications' tables.
+    (begin
+      (exec-query (%db) "DELETE FROM Builds;")
       (db-add-build (make-dummy-build "/foo.drv" 1
                                       #:outputs `(("out" . "/foo"))))
       (db-add-build (make-dummy-build "/bar.drv" 2
                                       #:outputs `(("out" . "/bar"))))
-      (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<?)))
 
   (test-assert "db-close"
-    (db-close (%db)))
-
-  (begin
-    (%db-channel #f)
-    (delete-file database-name)))
-
-;;; Local Variables:
-;;; eval: (put 'with-temporary-database 'scheme-indent-function 0)
-;;; End:
+    (begin
+      (exec-query (%db) (format #f "DROP OWNED BY CURRENT_USER;"))
+      (db-close (%db))
+      #t)))
diff --git a/tests/http.scm b/tests/http.scm
index 02f4b08..fb0d858 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -24,6 +24,7 @@
              (cuirass utils)
              (json)
              (fibers)
+             (squee)
              (web uri)
              (web client)
              (web response)
@@ -48,13 +49,8 @@
 (define (test-cuirass-uri route)
   (string-append "http://localhost:6688"; route))
 
-(define database-name
-  ;; Use an empty and temporary database for the tests.
-  (string-append (getcwd) "/" (number->string (getpid)) "-tmp.db"))
-
 (define %db
-  ;; Global Slot for a database object.
-  (make-parameter #t))
+  (make-parameter #f))
 
 (define build-query-result
   '((#:id . 1)
@@ -111,11 +107,10 @@
 
   (test-assert "db-init"
     (begin
-      (%db (db-init database-name))
+      (%db (db-open))
       (%db-channel (make-worker-thread-channel
                     (lambda ()
                       (list (%db)))))
-      (%db-writer-channel (%db-channel))
       #t))
 
   (test-assert "cuirass-run"
@@ -191,13 +186,13 @@
               ((#:commit . "fakesha3")
                (#:input . "packages")
                (#:directory . "dir4")))))
-      (db-add-build build1)
-      (db-add-build build2)
       (db-add-specification specification)
       (db-add-evaluation "guix" checkouts1
                          #:timestamp 1501347493)
       (db-add-evaluation "guix" checkouts2
-                         #:timestamp 1501347493)))
+                         #:timestamp 1501347493)
+      (db-add-build build1)
+      (db-add-build build2)))
 
   (test-assert "/specifications"
     (match (call-with-input-string
@@ -290,8 +285,7 @@
       (http-get-body (test-cuirass-uri "/api/evaluations?nr=1")))))
 
   (test-assert "db-close"
-    (db-close (%db)))
-
-  (begin
-    (%db-channel #f)
-    (delete-file database-name)))
+    (begin
+      (exec-query (%db) (format #f "DROP OWNED BY CURRENT_USER;"))
+      (db-close (%db))
+      #t)))
diff --git a/tests/metrics.scm b/tests/metrics.scm
index b957d88..efa1a8e 100644
--- a/tests/metrics.scm
+++ b/tests/metrics.scm
@@ -21,16 +21,9 @@
              (cuirass metrics)
              (cuirass utils)
              ((guix utils) #:select (call-with-temporary-output-file))
+             (squee)
              (srfi srfi-64))
 
-(define-syntax-rule (with-temporary-database body ...)
-  (call-with-temporary-output-file
-   (lambda (file port)
-     (parameterize ((%package-database file))
-       (db-init file)
-       (with-database
-         body ...)))))
-
 (define today
   (let ((time (current-time)))
     (- time (modulo time 86400))))
@@ -39,50 +32,49 @@
   (- today 86400))
 
 (define %db
-  ;; Global Slot for a database object.
-  (make-parameter #t))
-
-(define database-name
-  ;; Use an empty and temporary database for the tests.
-  (string-append (getcwd) "/" (number->string (getpid)) "-tmp.db"))
+  (make-parameter #f))
 
 (test-group-with-cleanup "database"
   (test-assert "db-init"
     (begin
-      (%db (db-init database-name))
+      (%db (db-open))
       (%db-channel (make-worker-thread-channel
                     (lambda ()
                       (list (%db)))))
-      (%db-writer-channel (%db-channel))
       #t))
 
-  (test-assert "sqlite-exec"
+  (test-assert "exec-query"
     (begin
-      (sqlite-exec (%db) "\
+      (exec-query (%db) "\
+INSERT INTO Specifications (name, load_path_inputs, package_path_inputs,
+proc_input, proc_file, proc, proc_args, build_outputs, priority)
+VALUES ('guix', '()', '()', 'guix',' build-aux/cuirass/gnu-system.scm',
+'cuirass-jobs', '', '', 2);")
+      (exec-query (%db) "\
 INSERT INTO Evaluations (specification, status,
 timestamp, checkouttime, evaltime) VALUES ('guix', -1, 1600174547, 0, 0);")
-      (sqlite-exec (%db) (format #f "\
+      (exec-query (%db) (format #f "\
 INSERT INTO Evaluations (specification, status,
 timestamp, checkouttime, evaltime) VALUES ('guix', 0, ~a, ~a, ~a);\
 " yesterday (+ yesterday 100) (+ yesterday 600)))
-      (sqlite-exec (%db) "\
+      (exec-query (%db) "\
 INSERT INTO Evaluations (specification, status,
 timestamp, checkouttime, evaltime) VALUES ('guix', 1, 1600174547,
 1600174548, 0);")
-      (sqlite-exec (%db) "\
+      (exec-query (%db) "\
 INSERT INTO Evaluations (specification, status,
 timestamp, checkouttime, evaltime) VALUES ('guix', 1, 1600174547,
 1600174548, 1600174647);")
-      (sqlite-exec (%db) (format #f "\
+      (exec-query (%db) (format #f "\
 INSERT INTO Builds (id, derivation, evaluation, job_name, system,
 nix_name, log, status, timestamp, starttime, stoptime) VALUES
 (1, '/gnu/store/1.drv', 2, '', '', '', '', 0, ~a, ~a, ~a);\
 " yesterday (+ yesterday 1600) (+ yesterday 2600)))
-      (sqlite-exec (%db) (format #f "\
+      (exec-query (%db) (format #f "\
 INSERT INTO Builds (id, derivation, evaluation, job_name, system,
 nix_name, log, status, timestamp, starttime, stoptime) VALUES
 (2, '/gnu/store/2.drv', 2, '', '', '', '', -2, 0, 0, 0);"))
-      (sqlite-exec (%db) (format #f "\
+      (exec-query (%db) (format #f "\
 INSERT INTO Builds (id, derivation, evaluation, job_name, system,
 nix_name, log, status, timestamp, starttime, stoptime) VALUES
 (3, '/gnu/store/3.drv', 4, '', '', '', '', 0, 1600174451, 1600174451,
@@ -94,65 +86,60 @@ nix_name, log, status, timestamp, starttime, stoptime) 
VALUES
       (db-update-metric 'average-eval-duration-per-spec "guix")
       (db-get-metrics-with-id 'average-eval-duration-per-spec)))
 
-  (test-equal "builds-per-day"
-    1.0
-    (begin
-      (db-update-metric 'builds-per-day)
-      (db-get-metric 'builds-per-day yesterday)))
-
-  (test-equal "pending-builds"
-    `((,today . 1.0))
-    (begin
-      (db-update-metric 'pending-builds)
-      (db-get-metrics-with-id 'pending-builds)))
-
-  (test-equal "new-derivations-per-day"
-    `((,yesterday . 1.0))
-    (begin
-      (db-update-metric 'new-derivations-per-day)
-      (db-get-metrics-with-id 'new-derivations-per-day)))
-
-  (test-equal "percentage-failed-eval-per-spec"
-    `(("guix" . 50.0))
-    (begin
-      (db-update-metric 'percentage-failed-eval-per-spec "guix")
-      (db-get-metrics-with-id 'percentage-failed-eval-per-spec)))
-
-  (test-equal "db-update-metrics"
-    `((,today . 2.0))
-    (begin
-      (sqlite-exec (%db) (format #f "\
+    (test-equal "builds-per-day"
+      1.0
+      (begin
+        (db-update-metric 'builds-per-day)
+        (db-get-metric 'builds-per-day yesterday)))
+
+    (test-equal "pending-builds"
+      `((,today . 1.0))
+      (begin
+        (db-update-metric 'pending-builds)
+        (db-get-metrics-with-id 'pending-builds)))
+
+    (test-equal "new-derivations-per-day"
+      `((,yesterday . 1.0))
+      (begin
+        (db-update-metric 'new-derivations-per-day)
+        (db-get-metrics-with-id 'new-derivations-per-day)))
+
+    (test-equal "percentage-failed-eval-per-spec"
+      `(("guix" . 50.0))
+      (begin
+        (db-update-metric 'percentage-failed-eval-per-spec "guix")
+        (db-get-metrics-with-id 'percentage-failed-eval-per-spec)))
+
+    (test-equal "db-update-metrics"
+      `((,today . 2.0))
+      (begin
+        (exec-query (%db) (format #f "\
 INSERT INTO Builds (id, derivation, evaluation, job_name, system,
 nix_name, log, status, timestamp, starttime, stoptime) VALUES
 (4, '/gnu/store/4.drv', 1, '', '', '', '', -2, 0, 0, 0);"))
-      (db-update-metrics)
-      (db-get-metrics-with-id 'pending-builds)))
-
-  (test-equal "average-eval-build-start-time"
-    `((2 . 1000.0))
-    (begin
-      (db-update-metric 'average-eval-build-start-time 2)
-      (db-get-metrics-with-id 'average-eval-build-start-time)))
-
-  (test-equal "average-eval-build-complete-time"
-    `((2 . 2000.0))
-    (begin
-      (db-update-metric 'average-eval-build-complete-time 2)
-      (db-get-metrics-with-id 'average-eval-build-complete-time)))
-
-  (test-equal "evaluation-completion-speed"
-    900.0
-    (begin
-      (db-update-metric 'evaluation-completion-speed 4)
-      (db-get-metric 'evaluation-completion-speed 4)))
+        (db-update-metrics)
+        (db-get-metrics-with-id 'pending-builds)))
+
+    (test-equal "average-eval-build-start-time"
+      `((2 . 1000.0))
+      (begin
+        (db-update-metric 'average-eval-build-start-time 2)
+        (db-get-metrics-with-id 'average-eval-build-start-time)))
+
+    (test-equal "average-eval-build-complete-time"
+      `((2 . 2000.0))
+      (begin
+        (db-update-metric 'average-eval-build-complete-time 2)
+        (db-get-metrics-with-id 'average-eval-build-complete-time)))
+
+    (test-equal "evaluation-completion-speed"
+      900.0
+      (begin
+        (db-update-metric 'evaluation-completion-speed 4)
+        (db-get-metric 'evaluation-completion-speed 4)))
 
   (test-assert "db-close"
-    (db-close (%db)))
-
-  (begin
-    (%db-channel #f)
-    (delete-file database-name)))
-
-;;; Local Variables:
-;;; eval: (put 'with-temporary-database 'scheme-indent-function 0)
-;;; End:
+    (begin
+      (exec-query (%db) (format #f "DROP OWNED BY CURRENT_USER;"))
+      (db-close (%db))
+      #t)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]