From 8d211dc831c7c849aea4846f8cda8ebbadba9cea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= <reynir@reynir.dk>
Date: Tue, 16 Feb 2021 18:33:04 +0100
Subject: [PATCH] Check database version

Exit if the application id and user version are not as expected.
---
 bin/builder_web_app.ml | 10 ++++++++--
 lib/builder_web.ml     | 32 +++++++++++++++++++++++++-------
 2 files changed, 33 insertions(+), 9 deletions(-)

diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml
index 4bbc0e4..a2e843d 100644
--- a/bin/builder_web_app.ml
+++ b/bin/builder_web_app.ml
@@ -9,5 +9,11 @@ let app t =
 let () =
   let () = Mirage_crypto_rng_unix.initialize () in
   let datadir = Fpath.v "/var/db/builder-web/" in
-  let t = Result.get_ok (Builder_web.init "/var/db/builder-web/builder.sqlite3" datadir) in
-  App.run_command (app t)
+  match Builder_web.init "/var/db/builder-web/builder.sqlite3" datadir with
+  | Error (#Caqti_error.load as e) ->
+    Format.eprintf "Error: %a\n" Caqti_error.pp e;
+  | Error (#Builder_web.db_error | `Wrong_version _ as e) ->
+    Format.eprintf "Error: %a\n" Builder_web.pp_error e;
+    exit 1
+  | Ok t ->
+    App.run_command (app t)
diff --git a/lib/builder_web.ml b/lib/builder_web.ml
index 7247924..67b15c8 100644
--- a/lib/builder_web.ml
+++ b/lib/builder_web.ml
@@ -10,6 +10,10 @@ type db_error = [ Caqti_error.connect | Model.error ]
 let pp_error ppf = function
   | #Caqti_error.connect as e -> Caqti_error.pp ppf e
   | #Model.error as e -> Model.pp_error ppf e
+  | `Wrong_version (application_id, version) ->
+    if application_id = Builder_db.application_id
+    then Format.fprintf ppf "Wrong database version: %Ld" version
+    else Format.fprintf ppf "Wrong database application id: %ld" application_id
 
 type 'a t = {
   pool : (Caqti_lwt.connection, [> db_error ] as 'a) Caqti_lwt.Pool.t;
@@ -19,13 +23,27 @@ type 'a t = {
 let realm = "builder-web"
 
 let init ?(pool_size = 10) dbpath datadir =
-  Caqti_lwt.connect_pool
-    ~max_size:pool_size
-    (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
-  |> Result.map (fun pool -> {
-        pool = (pool :> (Caqti_lwt.connection, [> db_error ]) Caqti_lwt.Pool.t);
-        datadir;
-      })
+  match Caqti_lwt.connect_pool
+          ~max_size:pool_size
+          (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
+  with
+  | Error e ->
+    Error e
+  | Ok pool ->
+    Lwt_main.run (Caqti_lwt.Pool.use (fun (module Db : Caqti_lwt.CONNECTION) ->
+        Db.find Builder_db.get_application_id () >>= fun application_id ->
+        Db.find Builder_db.get_version () >>= fun version ->
+        Lwt_result.return (application_id, version))
+      pool)
+    |> (function
+        | Error e -> Error (e :> [> db_error | `Wrong_version of int32 * int64 ])
+        | Ok (application_id, version) ->
+          if application_id = Builder_db.application_id && version = Builder_db.current_version
+          then Ok {
+              pool = (pool :> (Caqti_lwt.connection, [> db_error ]) Caqti_lwt.Pool.t);
+              datadir;
+            }
+          else Error (`Wrong_version (application_id, version)))
 
 let pp_exec ppf (job, uuid, _, _, _, _, _) =
   Format.fprintf ppf "%s(%a)" job.Builder.name Uuidm.pp uuid