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" open Grej.Infix let set_application_id = Caqti_type.unit ->. Caqti_type.unit @@ Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id let alter_build = Caqti_type.unit ->. Caqti_type.unit @@ "ALTER TABLE build ADD COLUMN main_binary TEXT" let all_builds = Caqti_type.unit ->* Caqti_type.int64 @@ "SELECT id FROM build" let bin_artifact = Caqti_type.int64 ->* Caqti_type.(tup2 int64 string) @@ "SELECT id, filepath FROM build_artifact WHERE build = ? AND filepath LIKE 'bin/%'" let set_main_binary = Caqti_type.(tup2 int64 (option string)) ->. Caqti_type.unit @@ "UPDATE build SET main_binary = $2 WHERE id = $1" let migrate _datadir (module Db : Caqti_blocking.CONNECTION) = let open Grej.Infix in Grej.check_version ~application_id:0l ~user_version:0L (module Db) >>= fun () -> Db.exec alter_build () >>= fun () -> Db.collect_list all_builds () >>= fun builds -> Grej.list_iter_result (fun build -> Db.collect_list bin_artifact build >>= function | [_id, main_binary] -> Db.exec set_main_binary (build, Some main_binary) | [] -> Logs.debug (fun m -> m "No binaries for build id %Ld" build); Ok () | binaries -> Logs.warn (fun m -> m "More than one binary for build id %Ld" build); Logs.debug (fun m -> m "binaries: [%a]" Fmt.(list ~sep:(any ";") string) (List.map snd binaries)); Ok ()) builds >>= fun () -> Db.exec Builder_db.set_application_id () >>= fun () -> Db.exec (Grej.set_version new_version) () let rename_build = Caqti_type.unit ->. Caqti_type.unit @@ "ALTER TABLE build RENAME TO __tmp_build" let create_build = Caqti_type.unit ->. Caqti_type.unit @@ {| CREATE TABLE build ( id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, uuid VARCHAR(36) NOT NULL UNIQUE, start_d INTEGER NOT NULL, start_ps INTEGER NOT NULL, finish_d INTEGER NOT NULL, finish_ps INTEGER NOT NULL, result_kind TINYINT NOT NULL, result_code INTEGER, result_msg TEXT, console BLOB NOT NULL, script TEXT NOT NULL, job INTEGER NOT NULL, FOREIGN KEY(job) REFERENCES job(id) ) |} let rollback_data = Caqti_type.unit ->. Caqti_type.unit @@ {| INSERT INTO build SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg, console, script, job FROM __tmp_build |} let rollback _datadir (module Db : Caqti_blocking.CONNECTION) = let open Grej.Infix in 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 old_version) ()