diff --git a/bin/migrations/builder_migrations.ml b/bin/migrations/builder_migrations.ml index 3f06869..04c3fd8 100644 --- a/bin/migrations/builder_migrations.ml +++ b/bin/migrations/builder_migrations.ml @@ -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 diff --git a/bin/migrations/grej.ml b/bin/migrations/grej.ml index 614599e..dbc79fc 100644 --- a/bin/migrations/grej.ml +++ b/bin/migrations/grej.ml @@ -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) diff --git a/bin/migrations/m20210126.ml b/bin/migrations/m20210126.ml index fc16622..13735a2 100644 --- a/bin/migrations/m20210126.ml +++ b/bin/migrations/m20210126.ml @@ -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) () diff --git a/bin/migrations/m20210202.ml b/bin/migrations/m20210202.ml index 6923809..6702ed8 100644 --- a/bin/migrations/m20210202.ml +++ b/bin/migrations/m20210202.ml @@ -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) = diff --git a/bin/migrations/m20210216.ml b/bin/migrations/m20210216.ml index e7bdaf8..7cd0c68 100644 --- a/bin/migrations/m20210216.ml +++ b/bin/migrations/m20210216.ml @@ -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) () diff --git a/bin/migrations/m20210218.ml b/bin/migrations/m20210218.ml index d5843e5..ffca0f4 100644 --- a/bin/migrations/m20210218.ml +++ b/bin/migrations/m20210218.ml @@ -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) () diff --git a/bin/migrations/m20210427.ml b/bin/migrations/m20210427.ml index 143fdda..57db5af 100644 --- a/bin/migrations/m20210427.ml +++ b/bin/migrations/m20210427.ml @@ -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 () diff --git a/bin/migrations/m20210531.ml b/bin/migrations/m20210531.ml index c59c250..da5255c 100644 --- a/bin/migrations/m20210531.ml +++ b/bin/migrations/m20210531.ml @@ -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 diff --git a/bin/migrations/m20210602.ml b/bin/migrations/m20210602.ml index afc4722..f5689e6 100644 --- a/bin/migrations/m20210602.ml +++ b/bin/migrations/m20210602.ml @@ -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 diff --git a/bin/migrations/m20210608.ml b/bin/migrations/m20210608.ml index 5b66686..afcf576 100644 --- a/bin/migrations/m20210608.ml +++ b/bin/migrations/m20210608.ml @@ -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 () -> diff --git a/bin/migrations/m20210609.ml b/bin/migrations/m20210609.ml index 0137c62..594231b 100644 --- a/bin/migrations/m20210609.ml +++ b/bin/migrations/m20210609.ml @@ -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