builder-web/bin/migrations/m20210602.ml
Reynir Björnsson 4461a91f87 Update to caqti>=2.1.1
The tuple type constructors are renamed from tupN to tN. Also, except
for migrations, use the wider tuple types (up to 12 since caqti.2.1.0).
2024-08-13 13:16:31 +02:00

148 lines
5.9 KiB
OCaml

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"
open Grej.Infix
let idx_build_job_start =
Caqti_type.unit ->. Caqti_type.unit @@
"CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"
let new_build =
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_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,
main_binary INTEGER,
job INTEGER NOT NULL,
FOREIGN KEY(main_binary) REFERENCES build_artifact(id),
FOREIGN KEY(job) REFERENCES job(id)
)
|}
let old_build =
Caqti_type.unit ->. Caqti_type.unit @@
{| CREATE TABLE new_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,
main_binary TEXT,
job INTEGER NOT NULL,
FOREIGN KEY(job) REFERENCES job(id)
)
|}
let collect_old_build =
Caqti_type.unit ->*
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 octets string (option string)))
Builder_db.Rep.untyped_id) @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job
FROM build |}
let insert_new_build =
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 octets string (option Builder_db.Rep.untyped_id)))
Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
let drop_build =
Caqti_type.unit ->. Caqti_type.unit @@
"DROP TABLE build"
let rename_build =
Caqti_type.unit ->. Caqti_type.unit @@
"ALTER TABLE new_build RENAME TO build"
let find_main_artifact_id =
Caqti_type.(t2 Builder_db.Rep.untyped_id string) ->! Builder_db.Rep.untyped_id @@
"SELECT id FROM build_artifact WHERE build = $1 AND filepath = $2"
let find_main_artifact_filepath =
Builder_db.Rep.untyped_id ->! Caqti_type.string @@
"SELECT filepath FROM build_artifact WHERE id = ?"
let collect_new_build =
Caqti_type.unit ->*
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 octets string (option Builder_db.Rep.untyped_id)))
Builder_db.Rep.untyped_id) @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind, result_code, result_msg,
console, script, main_binary, job
FROM build |}
let insert_old_build =
Caqti_type.(t3 Builder_db.Rep.untyped_id
(t3 (t4 string int64 int64 int64)
(t4 int64 int (option int) (option string))
(t3 octets string (option string)))
Builder_db.Rep.untyped_id) ->. Caqti_type.unit @@
{| INSERT INTO new_build (id, uuid, start_d, start_ps, finish_d, finish_ps, result_kind,
result_code, result_msg, console, script, main_binary, job)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |}
let migrate _ (module Db : Caqti_blocking.CONNECTION) =
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
Db.exec new_build () >>= fun () ->
Db.rev_collect_list collect_old_build () >>= fun builds ->
Grej.list_iter_result
(fun (id, ((uuid, start_d, start_ps, finish_d), (finish_ps, result_kind, result_code, result_msg), (console, script, main_binary)), job) ->
(match main_binary with
| None -> Ok None
| Some path -> Db.find find_main_artifact_id (id, path) >>| fun id -> Some id)
>>= fun main_binary_id ->
Db.exec insert_new_build
(id, ((uuid, start_d, start_ps, finish_d), (finish_ps, result_kind, result_code, result_msg), (console, script, main_binary_id)), job))
builds >>= fun () ->
Db.exec drop_build () >>= fun () ->
Db.exec rename_build () >>= fun () ->
Db.exec idx_build_job_start () >>= fun () ->
Db.exec (Grej.set_version new_version) ()
let rollback _ (module Db : Caqti_blocking.CONNECTION) =
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
Db.exec old_build () >>= fun () ->
Db.rev_collect_list collect_new_build () >>= fun builds ->
Grej.list_iter_result
(fun (id, ((uuid, start_d, start_ps, finish_d), (finish_ps, result_kind, result_code, result_msg), (console, script, main_binary)), job) ->
(match main_binary with
| None -> Ok None
| Some main_binary_id -> Db.find find_main_artifact_filepath main_binary_id >>| fun filepath -> Some filepath)
>>= fun filepath ->
Db.exec insert_old_build
(id, ((uuid, start_d, start_ps, finish_d), (finish_ps, result_kind, result_code, result_msg), (console, script, filepath)), job))
builds >>= fun () ->
Db.exec drop_build () >>= fun () ->
Db.exec rename_build () >>= fun () ->
Db.exec idx_build_job_start () >>= fun () ->
Db.exec (Grej.set_version old_version) ()