Refactor migrations and don't enable foreign keys

Each migration is, for the most part, a module that exposes expected
database version numbers, command identifier and documentation. This
results in all information about the migration and rollback are
found in the module itself, and builder_migrations.ml only has to
reference the module.

Some migrations require foreign keys constraints are disabled. It is not
possible to enable or disable foreign key constraints inside a
transaction.
This commit is contained in:
Reynir Björnsson 2021-06-10 12:08:14 +02:00
parent d088597c01
commit bde3baec46
11 changed files with 94 additions and 128 deletions

View file

@ -1,5 +1,18 @@
open Rresult.R.Infix
type action = Fpath.t -> Caqti_blocking.connection ->
(unit, [ Caqti_error.call_or_retrieve | `Wrong_version of int32 * int64 | `Msg of string ]) result
module type MIGRATION = sig
val new_version : int64
val old_version : int64
val identifier : string
val migrate_doc : string
val rollback_doc : string
val migrate : action
val rollback : action
end
let pp_error ppf = function
| #Caqti_error.load_or_connect | #Caqti_error.call_or_retrieve as e ->
Caqti_error.pp ppf e
@ -15,11 +28,6 @@ let or_die exit_code = function
Format.eprintf "Database error: %a" pp_error e;
exit exit_code
let foreign_keys =
Caqti_request.exec
Caqti_type.unit
"PRAGMA foreign_keys = ON"
let do_database_action action () datadir =
let datadir = Fpath.v datadir in
let dbpath = Fpath.(datadir / "builder.sqlite3") in
@ -31,7 +39,6 @@ let do_database_action action () datadir =
in
Logs.debug (fun m -> m "Connected!");
let r =
Db.exec foreign_keys () >>= fun () ->
Db.start () >>= fun () ->
Logs.debug (fun m -> m "Started database transaction");
match action datadir conn with
@ -65,45 +72,17 @@ let setup_log =
in
Cmdliner.Term.(const setup_log $ Logs_cli.level ())
let m20210126 =
let doc = "Adds a column 'main_binary' in 'build' (2021-01-26)" in
Cmdliner.Term.(const do_database_action $ const M20210126.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-01-26"
let r20210126 =
let doc = "Rollback 'main_binary' in 'build' (2021-01-26)" in
Cmdliner.Term.(const do_database_action $ const M20210126.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-01-26"
let m20210202 =
let doc = "Adds an index 'job_build_idx' on 'build' (2021-02-02)" in
Cmdliner.Term.(const do_database_action $ const M20210202.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-02-02"
let r20210202 =
let doc = "Rollback index 'job_build_idx' on 'build' (2021-02-02)" in
Cmdliner.Term.(const do_database_action $ const M20210202.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-02-02"
let m20210216 =
let doc = "Changes 'user' for scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in
Cmdliner.Term.(const do_database_action $ const M20210216.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-02-16"
let r20210216 =
let doc = "Rollback scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in
Cmdliner.Term.(const do_database_action $ const M20210216.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-02-16"
let m20210218 =
let doc = "Adds column 'size' to 'build_file' and 'build_artifact' (2021-02-18)" in
Cmdliner.Term.(const do_database_action $ const M20210218.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-02-18"
let r20210218 =
let doc = "Roll back column 'size' in 'build_file' and 'build_artifact' (2021-02-18)" in
Cmdliner.Term.(const do_database_action $ const M20210218.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-02-18"
let actions (module M : MIGRATION) =
let c s = s ^ "-" ^ M.identifier in
let v doc from_ver to_ver = Printf.sprintf "%s (DB version %Ld -> %Ld)" doc from_ver to_ver in
[
(Cmdliner.Term.(const do_database_action $ const M.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc:(v M.migrate_doc M.old_version M.new_version)
(c "migrate"));
(Cmdliner.Term.(const do_database_action $ const M.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc:(v M.rollback_doc M.new_version M.old_version)
(c "rollback"));
]
let f20210308 =
let doc = "Remove broken builds as fixed in commit a57798f4c02eb4d528b90932ec26fb0b718f1a13. \
@ -111,56 +90,6 @@ let f20210308 =
Cmdliner.Term.(const do_database_action $ const M20210308.fixup $ setup_log $ datadir),
Cmdliner.Term.info ~doc "fixup-2021-03-08"
let m20210427 =
let doc = "Adds an index 'idx_build_job_start' on 'build' (2021-04-27)" in
Cmdliner.Term.(const do_database_action $ const M20210427.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-04-27"
let r20210427 =
let doc = "Rollback index 'idx_build_job_start'' on 'build' (2021-04-27)" in
Cmdliner.Term.(const do_database_action $ const M20210427.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-04-27"
let m20210531 =
let doc = "Remove datadir from build_artifact.localpath" in
Cmdliner.Term.(const do_database_action $ const M20210531.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-05-31"
let r20210531 =
let doc = "Add datadir to build_artifact.localpath" in
Cmdliner.Term.(const do_database_action $ const M20210531.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-05-31"
let m20210602 =
let doc = "build.main_binary foreign key" in
Cmdliner.Term.(const do_database_action $ const M20210602.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-06-02"
let r20210602 =
let doc = "build.main_binary filepath" in
Cmdliner.Term.(const do_database_action $ const M20210602.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-06-02"
let m20210608 =
let doc = "add access list" in
Cmdliner.Term.(const do_database_action $ const M20210608.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-06-08"
let r20210608 =
let doc = "remove access list" in
Cmdliner.Term.(const do_database_action $ const M20210608.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-06-08"
let m20210609 =
let doc = "add user column to build" in
Cmdliner.Term.(const do_database_action $ const M20210609.migrate $ setup_log $ datadir),
Cmdliner.Term.info ~doc "migrate-2021-06-09"
let r20210609 =
let doc = "remove user column to build" in
Cmdliner.Term.(const do_database_action $ const M20210609.rollback $ setup_log $ datadir),
Cmdliner.Term.info ~doc "rollback-2021-06-09"
let help_cmd =
let topic =
let doc = "Migration to get help on" in
@ -178,16 +107,17 @@ let default_cmd =
let () =
Cmdliner.Term.eval_choice
default_cmd
[ help_cmd;
m20210126; r20210126;
m20210202; r20210202;
m20210216; r20210216;
m20210218; r20210218;
f20210308;
m20210427; r20210427;
m20210531; r20210531;
m20210602; r20210602;
m20210608; r20210608;
m20210609; r20210609;
]
(List.concat [
[ help_cmd ];
actions (module M20210126);
actions (module M20210202);
actions (module M20210216);
actions (module M20210218);
[ f20210308 ];
actions (module M20210427);
actions (module M20210531);
actions (module M20210602);
actions (module M20210608);
actions (module M20210609);
])
|> Cmdliner.Term.exit

View file

@ -21,3 +21,9 @@ let list_iter_result f xs =
(fun r x -> r >>= fun () -> f x)
(Ok ())
xs
let foreign_keys on =
let on = if on then "ON" else "OFF" in
Caqti_request.exec
Caqti_type.unit
(Printf.sprintf "PRAGMA foreign_keys = %s" on)

View file

@ -1,5 +1,7 @@
let new_user_version =
1L
let new_version = 1L and old_version = 0L
let identifier = "2021-01-26"
let migrate_doc = "add column main_binary to build"
let rollback_doc = "remove column main_binary from build"
let set_application_id =
Caqti_request.exec
@ -47,7 +49,7 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Ok ())
builds >>= fun () ->
Db.exec Builder_db.set_application_id () >>= fun () ->
Db.exec (Grej.set_version new_user_version) ()
Db.exec (Grej.set_version new_version) ()
let rename_build =
Caqti_request.exec
@ -86,8 +88,8 @@ let rollback_data =
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in
Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec rename_build () >>= fun () ->
Db.exec create_build () >>= fun () ->
Db.exec rollback_data () >>= fun () ->
Db.exec (Grej.set_version 0L) ()
Db.exec (Grej.set_version old_version) ()

View file

@ -1,3 +1,8 @@
let old_version = 1L and new_version = 1L
let identifier = "2021-02-02"
let migrate_doc = "add index job_build_idx on build"
let rollback_doc = "rollback index job_build_idx on build"
open Rresult.R.Infix
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =

View file

@ -1,5 +1,8 @@
let old_user_version = 1L
let new_user_version = 2L
let old_version = 1L
let new_version = 2L
let identifier = "2021-02-16"
let migrate_doc = "change to scrypt hashed passwords (NB: destructive!!)"
let rollback_doc = "rollback scrypt hashed passwords (NB: destructive!!)"
let drop_user =
Caqti_request.exec ~oneshot:true
@ -34,14 +37,14 @@ let old_user =
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in
Grej.check_version ~user_version:old_user_version (module Db) >>= fun () ->
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec drop_user () >>= fun () ->
Db.exec new_user () >>= fun () ->
Db.exec (Grej.set_version new_user_version) ()
Db.exec (Grej.set_version new_version) ()
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in
Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec drop_user () >>= fun () ->
Db.exec old_user () >>= fun () ->
Db.exec (Grej.set_version old_user_version) ()
Db.exec (Grej.set_version old_version) ()

View file

@ -1,5 +1,8 @@
let old_user_version = 2L
let new_user_version = 3L
let old_version = 2L
let new_version = 3L
let identifier = "2021-02-18"
let migrate_doc = "add column size to build_file and build_artifact"
let rollback_doc = "remove column size to build_file and build_artifact"
let new_build_artifact =
Caqti_request.exec ~oneshot:true
@ -81,7 +84,7 @@ let rename_build_file =
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in
Grej.check_version ~user_version:old_user_version (module Db) >>= fun () ->
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec new_build_artifact () >>= fun () ->
Db.rev_collect_list collect_build_artifact () >>= fun build_artifacts ->
Grej.list_iter_result
@ -104,7 +107,7 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Db.exec drop_build_file () >>= fun () ->
Db.exec rename_build_file () >>= fun () ->
Db.exec (Grej.set_version new_user_version) ()
Db.exec (Grej.set_version new_version) ()
let old_build_artifact =
Caqti_request.exec ~oneshot:true
@ -148,7 +151,7 @@ let copy_build_file =
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
let open Rresult.R.Infix in
Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec old_build_artifact () >>= fun () ->
Db.exec copy_build_artifact () >>= fun () ->
Db.exec drop_build_artifact () >>= fun () ->
@ -159,4 +162,4 @@ let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
Db.exec drop_build_file () >>= fun () ->
Db.exec rename_build_file () >>= fun () ->
Db.exec (Grej.set_version old_user_version) ()
Db.exec (Grej.set_version old_version) ()

View file

@ -1,3 +1,8 @@
let old_version = 3L and new_version = 3L
let identifier = "2021-04-27"
let migrate_doc = "add index idx_build_job_start on build"
let rollback_doc = "rollback index idx_build_job_start on build"
open Rresult.R.Infix
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
@ -11,7 +16,7 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Caqti_type.unit
"DROP INDEX IF EXISTS job_build_idx"
in
Grej.check_version ~user_version:3L (module Db) >>= fun () ->
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec rm_job_build_idx () >>= fun () ->
Db.exec idx_build_job_start ()
@ -26,6 +31,6 @@ let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
Caqti_type.unit
"DROP INDEX IF EXISTS idx_build_job_start"
in
Grej.check_version ~user_version:3L (module Db) >>= fun () ->
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec rm_idx_build_job_start () >>= fun () ->
Db.exec job_build_idx ()

View file

@ -1,5 +1,8 @@
let old_version = 3L
let new_version = 4L
let identifier = "2021-05-31"
let migrate_doc = "remove datadir prefix from build_artifact.localpath"
let rollback_doc = "add datadir prefix to build_artifact.localpath"
let build_artifacts =
Caqti_request.collect ~oneshot:true

View file

@ -1,4 +1,7 @@
let old_version = 4L and new_version = 5L
let identifier = "2021-06-02"
let migrate_doc = "build.main_binary foreign key"
let rollback_doc = "build.main_binary filepath"
let idx_build_job_start =
Caqti_request.exec Caqti_type.unit

View file

@ -1,6 +1,7 @@
open Rresult.R.Infix
let new_version = 6L and old_version = 5L
let identifier = "2021-06-08"
let migrate_doc = "add access list"
let rollback_doc = "remove access list"
let new_user =
Caqti_request.exec
@ -82,6 +83,8 @@ let rollback_access_list =
Caqti_type.unit
"DROP TABLE IF EXISTS access_list"
open Rresult.R.Infix
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec new_user () >>= fun () ->

View file

@ -1,4 +1,7 @@
let new_version = 7L and old_version = 6L
let identifier = "2021-06-09"
let migrate_doc = "add user column to build"
let rollback_doc = "remove user column from build"
let idx_build_job_start =
Caqti_request.exec Caqti_type.unit