diff --git a/bin/migrations/builder_migrations.ml b/bin/migrations/builder_migrations.ml index 5298b9d..befee26 100644 --- a/bin/migrations/builder_migrations.ml +++ b/bin/migrations/builder_migrations.ml @@ -148,5 +148,6 @@ let () = [ f20210707b ]; [ f20210707c ]; [ f20210707d ]; + actions (module M20210712); ]) |> Cmdliner.Term.exit diff --git a/bin/migrations/m20210712.ml b/bin/migrations/m20210712.ml new file mode 100644 index 0000000..0420008 --- /dev/null +++ b/bin/migrations/m20210712.ml @@ -0,0 +1,172 @@ +let new_version = 13L and old_version = 12L +and identifier = "2021-07-12" +and migrate_doc = "remove result_kind from build, add indexes idx_build_failed and idx_build_artifact_sha256" +and rollback_doc = "add result_kind to build, remove indexes idx_build_failed and idx_build_artifact_sha256" + +let new_build = + Caqti_request.exec + 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_code INTEGER NOT NULL, + result_msg TEXT, + console BLOB NOT NULL, + script TEXT NOT NULL, + main_binary INTEGER, + user INTEGER NOT NULL, + job INTEGER NOT NULL, + input_id BLOB, -- sha256 (sha256 || sha256 || sha256) + + FOREIGN KEY(main_binary) REFERENCES build_artifact(id) DEFERRABLE INITIALLY DEFERRED, + FOREIGN KEY(user) REFERENCES user(id), + FOREIGN KEY(job) REFERENCES job(id) + ) + |} + +let copy_old_build = + Caqti_request.exec + Caqti_type.unit + {| INSERT INTO new_build(id, uuid, start_d, start_ps, finish_d, finish_ps, + result_code, result_msg, console, script, main_binary, user, job, input_id) + SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, 0, result_msg, + console, script, main_binary, user, job, input_id + FROM build + |} + +let old_build_execution_result = + Caqti_request.collect + Caqti_type.unit + Caqti_type.(tup3 (Builder_db.Rep.id (`build : [ `build ])) int (option int)) + "SELECT id, result_kind, result_code FROM build" + +let update_new_build_execution_result = + Caqti_request.exec + Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) int) + "UPDATE new_build SET result_code = ?2 WHERE id = ?1" + +let old_build = + Caqti_request.exec + 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 INTEGER NOT NULL, + result_code INTEGER, + result_msg TEXT, + console BLOB NOT NULL, + script TEXT NOT NULL, + main_binary INTEGER, + user INTEGER NOT NULL, + job INTEGER NOT NULL, + input_id BLOB, -- sha256 (sha256 || sha256 || sha256) + + FOREIGN KEY(main_binary) REFERENCES build_artifact(id) DEFERRABLE INITIALLY DEFERRED, + FOREIGN KEY(user) REFERENCES user(id), + FOREIGN KEY(job) REFERENCES job(id) + ) + |} + +let copy_new_build = + Caqti_request.exec + Caqti_type.unit + {| INSERT INTO new_build(id, uuid, start_d, start_ps, finish_d, finish_ps, + result_kind, result_msg, console, script, main_binary, user, job, input_id) + SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, 0, result_msg, + console, script, main_binary, user, job, input_id + FROM build + |} + +let new_build_execution_result = + Caqti_request.collect + Caqti_type.unit + Caqti_type.(tup2 (Builder_db.Rep.id (`build : [ `build ])) int) + "SELECT id, result_code FROM build" + +let update_old_build_execution_result = + Caqti_request.exec + Caqti_type.(tup3 (Builder_db.Rep.id (`build : [ `build ])) int (option int)) + "UPDATE new_build SET result_kind = ?2, result_code = ?3 WHERE id = ?1" + +let drop_build = + Caqti_request.exec + Caqti_type.unit + "DROP TABLE build" + +let rename_build = + Caqti_request.exec + Caqti_type.unit + "ALTER TABLE new_build RENAME TO build" + +let execution_new_of_old kind code = + match kind, code with + | 0, Some v -> Ok v + | 1, Some v -> Ok (v lsl 8) + | 2, Some v -> Ok (v lsl 16) + | 3, None -> Ok 65536 + | _ -> Error (`Msg "bad encoding") + +let execution_old_of_new code = + if code <= 0xFF + then Ok (0, Some code) + else if code <= 0xFFFF + then Ok (1, Some (code lsr 8)) + else if code <= 0xFFFFFF + then Ok (2, Some (code lsr 16)) + else if code = 65536 + then Ok (3, None) + else Error (`Msg "bad encoding") + +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_build () >>= fun () -> + Db.exec copy_old_build () >>= fun () -> + Db.collect_list old_build_execution_result () >>= fun results -> + Grej.list_iter_result (fun (id, kind, code) -> + execution_new_of_old kind code >>= fun code' -> + Db.exec update_new_build_execution_result (id, code')) + results >>= fun () -> + Db.exec drop_build () >>= fun () -> + Db.exec rename_build () >>= fun () -> + Db.exec (Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)") + () >>= fun () -> + Db.exec (Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_failed ON build(job, start_d DESC, start_ps DESC) WHERE result_code <> 0") + () >>= fun () -> + Db.exec (Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_input_id ON build(input_id)") + () >>= fun () -> + Db.exec (Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_main_binary ON build(main_binary)") + () >>= fun () -> + Db.exec (Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_artifact_sha256 ON build_artifact(sha256)") + () >>= fun () -> + Db.exec (Grej.set_version new_version) () + +let rollback _datadir (module Db : Caqti_blocking.CONNECTION) = + Grej.check_version ~user_version:new_version (module Db) >>= fun () -> + Db.exec old_build () >>= fun () -> + Db.exec copy_new_build () >>= fun () -> + Db.collect_list new_build_execution_result () >>= fun results -> + Grej.list_iter_result (fun (id, code) -> + execution_old_of_new code >>= fun (kind, code') -> + Db.exec update_old_build_execution_result (id, kind, code')) + results >>= fun () -> + Db.exec drop_build () >>= fun () -> + Db.exec rename_build () >>= fun () -> + Db.exec (Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)") + () >>= fun () -> + Db.exec (Grej.set_version old_version) () diff --git a/db/builder_db.ml b/db/builder_db.ml index fcc1aa2..cf87f4f 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -4,7 +4,7 @@ open Rep let application_id = 1234839235l (* Please update this when making changes! *) -let current_version = 12L +let current_version = 13L type 'a id = 'a Rep.id @@ -319,8 +319,7 @@ module Build = struct start_ps INTEGER NOT NULL, finish_d INTEGER NOT NULL, finish_ps INTEGER NOT NULL, - result_kind TINYINT NOT NULL, - result_code INTEGER, + result_code INTEGER NOT NULL, result_msg TEXT, console BLOB NOT NULL, script TEXT NOT NULL, @@ -345,7 +344,7 @@ module Build = struct (id `build) t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, - result_kind, result_code, result_msg, + result_code, result_msg, console, script, main_binary, input_id, user, job FROM build WHERE id = ? @@ -356,7 +355,7 @@ module Build = struct Rep.uuid (Caqti_type.tup2 (id `build) t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, - result_kind, result_code, result_msg, + result_code, result_msg, console, script, main_binary, input_id, user, job FROM build WHERE uuid = ? @@ -367,7 +366,7 @@ module Build = struct (id `job) (Caqti_type.tup2 (id `build) t) {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps, - result_kind, result_code, result_msg, console, + result_code, result_msg, console, script, main_binary, input_id, user, job FROM build WHERE job = ? @@ -381,7 +380,7 @@ module Build = struct (id `build) Meta.t file_opt) {| SELECT build.id, build.uuid, build.start_d, build.start_ps, build.finish_d, build.finish_ps, - build.result_kind, build.result_code, build.result_msg, + build.result_code, build.result_msg, build.main_binary, build.input_id, build.user, build.job, build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size FROM build, job @@ -406,10 +405,10 @@ module Build = struct (id `job) Meta.t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, - result_kind, result_code, result_msg, + result_code, result_msg, main_binary, input_id, user, job FROM build - WHERE job = ? AND result_kind <> 0 OR result_code <> 0 + WHERE job = ? AND result_code <> 0 ORDER BY start_d DESC, start_ps DESC LIMIT 1 |} @@ -423,7 +422,7 @@ module Build = struct file_opt) {| SELECT b.id, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, - b.result_kind, b.result_code, b.result_msg, + b.result_code, b.result_msg, b.main_binary, b.input_id, b.user, b.job, a.filepath, a.localpath, a.sha256, a.size FROM build b @@ -451,7 +450,7 @@ module Build = struct Rep.uuid {| SELECT b.uuid FROM build b - WHERE b.job = ? AND b.result_kind = 0 AND b.result_code = 0 + WHERE b.job = ? AND b.result_code = 0 ORDER BY b.start_d DESC, b.start_ps DESC LIMIT 1 |} @@ -462,11 +461,11 @@ module Build = struct Caqti_type.(tup2 (id `build) Meta.t) {| SELECT b.id, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, - b.result_kind, b.result_code, b.result_msg, + b.result_code, b.result_msg, b.main_binary, b.input_id, b.user, b.job FROM build b, build b0 WHERE b0.id = ? AND b0.job = b.job AND - b.result_kind = 0 AND b.result_code = 0 AND + b.result_code = 0 AND (b0.start_d > b.start_d OR b0.start_d = b.start_d AND b0.start_ps > b.start_ps) ORDER BY b.start_d DESC, b.start_ps DESC LIMIT 1 @@ -477,7 +476,7 @@ module Build = struct (id `build) Meta.t {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, - b.result_kind, b.result_code, b.result_msg, + b.result_code, b.result_msg, b.main_binary, b.input_id, b.user, b.job FROM build b0, build_artifact a0, build b, build_artifact a WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256 @@ -511,7 +510,7 @@ module Build = struct Rep.cstruct Meta.t {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, - result_kind, result_code, result_msg, + result_code, result_msg, main_binary, input_id, user, job FROM build WHERE input_id = ? @@ -524,9 +523,9 @@ module Build = struct t {| INSERT INTO build (uuid, start_d, start_ps, finish_d, finish_ps, - result_kind, result_code, result_msg, console, script, main_binary, input_id, user, job) + result_code, result_msg, console, script, main_binary, input_id, user, job) VALUES - (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) + (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |} let get_meta_by_hash = @@ -535,7 +534,7 @@ module Build = struct Meta.t {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, - b.result_kind, b.result_code, b.result_msg, + b.result_code, b.result_msg, b.main_binary, b.input_id, b.user, b.job FROM build_artifact a INNER JOIN build b ON b.id = a.build @@ -549,7 +548,7 @@ module Build = struct Rep.cstruct (Caqti_type.tup2 Meta.t file_opt) {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, - b.result_kind, b.result_code, b.result_msg, + b.result_code, b.result_msg, b.main_binary, b.input_id, b.user, b.job, a.filepath, a.localpath, a.sha256, a.size FROM build_artifact a @@ -567,7 +566,7 @@ module Build = struct t) {| SELECT job.name, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, - b.result_kind, b.result_code, b.result_msg, + b.result_code, b.result_msg, b.console, b.script, b.main_binary, b.input_id, b.user, b.job FROM build_artifact a INNER JOIN build b ON b.id = a.build @@ -710,6 +709,14 @@ let migrate = [ Job_tag.migrate; Caqti_request.exec Caqti_type.unit "CREATE INDEX idx_build_job_start ON build(job, start_d DESC, start_ps DESC)"; + Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_failed ON build(job, start_d DESC, start_ps DESC) WHERE result_code <> 0"; + Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_input_id ON build(input_id)"; + Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_main_binary ON build(main_binary)"; + Caqti_request.exec Caqti_type.unit + "CREATE INDEX idx_build_artifact_sha256 ON build_artifact(sha256)"; set_current_version; set_application_id; ] @@ -722,6 +729,14 @@ let rollback = [ Build_artifact.rollback; Build.rollback; Job.rollback; + Caqti_request.exec Caqti_type.unit + "DROP INDEX IF EXISTS idx_build_artifact_sha256"; + Caqti_request.exec Caqti_type.unit + "DROP INDEX IF EXISTS idx_build_failed"; + Caqti_request.exec Caqti_type.unit + "DROP INDEX IF EXISTS idx_build_input_id"; + Caqti_request.exec Caqti_type.unit + "DROP INDEX IF EXISTS idx_build_main_binary"; Caqti_request.exec Caqti_type.unit "DROP INDEX IF EXISTS idx_build_job_start"; Caqti_request.exec Caqti_type.unit diff --git a/db/representation.ml b/db/representation.ml index 39cdd6f..1fa626b 100644 --- a/db/representation.ml +++ b/db/representation.ml @@ -88,20 +88,26 @@ let file_opt = let execution_result = let encode = function - | Builder.Exited v -> Ok (0, Some v, None) - | Builder.Signalled v -> Ok (1, Some v, None) - | Builder.Stopped v -> Ok (2, Some v, None) - | Builder.Msg msg -> Ok (3, None, Some msg) + | Builder.Exited v -> Ok (v, None) + | Builder.Signalled v -> Ok (v lsl 8, None) + | Builder.Stopped v -> Ok (v lsl 16, None) + | Builder.Msg msg -> Ok (65536, Some msg) in - let decode (kind, code, msg) = - match kind, code, msg with - | 0, Some v, None -> Ok (Builder.Exited v) - | 1, Some v, None -> Ok (Builder.Signalled v) - | 2, Some v, None -> Ok (Builder.Stopped v) - | 3, None, Some msg -> Ok (Builder.Msg msg) - | _ -> Error "bad encoding" + let decode (code, msg) = + if code <= 0xFF then + Ok (Builder.Exited code) + else if code <= 0xFFFF then + Ok (Builder.Signalled (code lsr 8)) + else if code <= 0xFFFFFF then + Ok (Builder.Stopped (code lsr 16)) + else if code = 65536 then + match msg with + | None -> Error "bad encoding" + | Some m -> Ok (Builder.Msg m) + else + Error "bad encoding (unknown number)" in - let rep = Caqti_type.(tup3 int (option int) (option string)) in + let rep = Caqti_type.(tup2 int (option string)) in Caqti_type.custom ~encode ~decode rep let console =