[bug#32121] [PATCH 3/5] database: Add support for database upgrades.

["Clément Lassieur" <clement@lassieur.org>]

* Makefile.am: Copy SQL files into their data directory.
* doc/cuirass.texi (Database schema): Document the change.
* src/cuirass/database.scm (%package-sql-dir): New parameter.
(db-load, db-get-version, db-set-version, get-target-version,
get-upgrade-file, db-upgrade): New procedures.
(db-init): Set version corresponding to the existing upgrade-n.sql files.
(db-open): If database exists, upgrade it.
* src/schema.sql: New file.
* src/sql/upgrade-1.sql: New file.
---
 Makefile.am              |  3 +++
 doc/cuirass.texi         | 16 ++++++++++---
 src/cuirass/database.scm | 50 +++++++++++++++++++++++++++++++++++++---
 src/schema.sql           |  5 ++++
 src/sql/upgrade-1.sql    |  7 ++++++
 5 files changed, 75 insertions(+), 6 deletions(-)
 create mode 100644 src/sql/upgrade-1.sql

diff --git a/Makefile.am b/Makefile.am
index d372b9e..00954b8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -3,6 +3,7 @@
 # Copyright © 1995-2016 Free Software Foundation, Inc.
 # Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
 # Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 #
 # This file is part of Cuirass.
 #
@@ -32,6 +33,7 @@ pkgmoduledir = $(guilesitedir)/$(PACKAGE)
 pkgobjectdir = $(guileobjectdir)/$(PACKAGE)
 webmoduledir = $(guilesitedir)/web/server
 webobjectdir = $(guileobjectdir)/web/server
+sqldir = $(pkgdatadir)/sql
 
 dist_pkgmodule_DATA =				\
   src/cuirass/base.scm				\
@@ -55,6 +57,7 @@ nodist_webobject_DATA =				\
   $(dist_webmodule_DATA:.scm=.go)
 
 dist_pkgdata_DATA = src/schema.sql
+dist_sql_DATA = src/sql/upgrade-*.sql
 
 TEST_EXTENSIONS = .scm .sh
 AM_TESTS_ENVIRONMENT = \
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index b5b27e8..38eb0b0 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -12,7 +12,8 @@ server.
 
 Copyright @copyright{} 2016, 2017 Mathieu Lirzin@*
 Copyright @copyright{} 2017 Mathieu Othacehe@*
-Copyright @copyright{} 2018 Ludovic Courtès
+Copyright @copyright{} 2018 Ludovic Courtès@*
+Copyright @copyright{} 2018 Clément Lassieur
 
 @quotation
 Permission is granted to copy, distribute and/or modify this document
@@ -228,8 +229,8 @@ Cuirass uses a SQLite database to store information about jobs and past
 build results, but also to coordinate the execution of jobs.
 
 The database contains the following tables: @code{Specifications},
-@code{Stamps}, @code{Evaluations}, @code{Derivations}, and
-@code{Builds}.  The purpose of each of these tables is explained below.
+@code{Stamps}, @code{Evaluations}, @code{Derivations}, @code{Builds} and
+@code{SchemaVersion}.  The purpose of each of these tables is explained below.
 
 @section Specifications
 @cindex specifications, database
@@ -412,6 +413,15 @@ This text field holds the path of the output.
 
 @end table
 
+@section SchemaVersion
+@cindex version, database
+
+This table keeps track of the schema version.  During the initialization, the
+version @code{v} is compared to the highest @code{n} of the
+@code{sql/upgrade-n.sql} files, so that if that @code{n} is higher than the
+schema version, files @code{sql/upgrade-(v+1).sql} to @code{sql/upgrade-n.sql}
+are loaded and the version is updated.
+
 @c *********************************************************************
 @node Web API
 @chapter Web API
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index a1398bc..188b9a8 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -23,10 +24,13 @@
   #:use-module (cuirass utils)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-42)
   #:use-module (sqlite3)
   #:export (;; Procedures.
             db-init
@@ -126,6 +130,12 @@ question marks matches the number of arguments to bind."
                                      (string-append %datadir "/" %package))
                                  "/schema.sql")))
 
+(define %package-sql-dir
+  ;; Define to the directory containing the SQL files.
+  (make-parameter (string-append (or (getenv "CUIRASS_DATADIR")
+                                     (string-append %datadir "/" %package))
+                                 "/sql")))
+
 (define (read-sql-file file-name)
   "Return a list of string containing SQL instructions from FILE-NAME."
   (call-with-input-file file-name
@@ -153,6 +163,30 @@ question marks matches the number of arguments to bind."
 
   db)
 
+(define (db-load db schema)
+  (for-each (cut sqlite-exec db <>)
+            (read-sql-file schema)))
+
+(define (db-get-version db)
+  (if (pair? (sqlite-exec db "SELECT name FROM sqlite_master WHERE \
+type='table' AND name='SchemaVersion';"))
+      (vector-ref
+       (car (sqlite-exec db "SELECT MAX(version) FROM SchemaVersion;")) 0)
+      0))
+
+(define (db-set-version db version)
+  (sqlite-exec db "INSERT INTO SchemaVersion (version) VALUES (" version
+               ");"))
+
+(define (get-target-version)
+  (apply max
+         (map string->number
+              (map (cut match:substring <> 1)
+                   (filter regexp-match?
+                           (map (cut string-match
+                                  "^upgrade-([0-9]+)\\.sql$" <>)
+                                (scandir (%package-sql-dir))))))))
+
 (define* (db-init #:optional (db-name (%package-database))
                   #:key (schema (%package-schema-file)))
   "Open the database to store and read jobs and builds informations.  Return a
@@ -162,10 +196,20 @@ database object."
     (delete-file db-name))
   (let ((db (sqlite-open db-name (logior SQLITE_OPEN_CREATE
                                          SQLITE_OPEN_READWRITE))))
-    (for-each (lambda (sql) (sqlite-exec db sql))
-              (read-sql-file schema))
+    (db-load db schema)
+    (db-set-version db (get-target-version))
     db))
 
+(define (get-upgrade-file version)
+  (in-vicinity (%package-sql-dir) (format #f "upgrade-~a.sql" version)))
+
+(define (db-upgrade db)
+  (do-ec (:range version (db-get-version db) (get-target-version))
+         (let ((intermediate-version (1+ version)))
+           (db-load db (get-upgrade-file intermediate-version))
+           (db-set-version db intermediate-version)))
+  db)
+
 (define* (db-open #:optional (db (%package-database)))
   "Open database to store or read jobs and builds informations.  Return a
 database object."
@@ -173,7 +217,7 @@ database object."
   ;; avoid SQLITE_LOCKED errors when we have several readers:
   ;; <https://www.sqlite.org/wal.html>.
   (set-db-options (if (file-exists? db)
-                      (sqlite-open db SQLITE_OPEN_READWRITE)
+                      (db-upgrade (sqlite-open db SQLITE_OPEN_READWRITE))
                       (db-init db))))
 
 (define (db-close db)
diff --git a/src/schema.sql b/src/schema.sql
index 65aebbd..a3f14eb 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -1,5 +1,10 @@
 BEGIN TRANSACTION;
 
+-- Singleton table to keep track of the schema version.
+CREATE TABLE SchemaVersion (
+  version       integer not null
+);
+
 CREATE TABLE Specifications (
   repo_name     TEXT NOT NULL PRIMARY KEY,
   url           TEXT NOT NULL,
diff --git a/src/sql/upgrade-1.sql b/src/sql/upgrade-1.sql
new file mode 100644
index 0000000..8f561da
--- /dev/null
+++ b/src/sql/upgrade-1.sql
@@ -0,0 +1,7 @@
+BEGIN TRANSACTION;
+
+CREATE TABLE SchemaVersion (
+  version       integer not null
+);
+
+COMMIT;
-- 
2.18.0