robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Check database version

Browse source 
Exit if the application id and user version are not as expected.
This commit is contained in:
Reynir Björnsson 2021-02-16 18:33:04 +01:00
parent 1c5de383ea
commit 8d211dc831
2 changed files with 33 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
bin/builder_web_app.ml
View file

@ -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
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)

24
lib/builder_web.ml
View file

@ -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
match Caqti_lwt.connect_pool
~max_size:pool_size
(Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
|> Result.map (fun pool -> {
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