From 4fec5ed38c8ec11a318667b4288917998272a80e Mon Sep 17 00:00:00 2001 From: Robur Date: Wed, 2 Jun 2021 10:29:08 +0000 Subject: [PATCH] Builder_db: use foreign key for build.main_binary --- bin/migrations/builder_migrations.ml | 11 +++ bin/migrations/m20210602.ml | 143 +++++++++++++++++++++++++++ db/builder_db.ml | 22 +++-- db/builder_db.mli | 5 +- lib/model.ml | 30 +++--- test/builder_db.ml | 8 +- 6 files changed, 189 insertions(+), 30 deletions(-) create mode 100644 bin/migrations/m20210602.ml diff --git a/bin/migrations/builder_migrations.ml b/bin/migrations/builder_migrations.ml index 78aee3c..9ad011f 100644 --- a/bin/migrations/builder_migrations.ml +++ b/bin/migrations/builder_migrations.ml @@ -125,6 +125,16 @@ let r20210531 = 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 help_cmd = let topic = let doc = "Migration to get help on" in @@ -150,5 +160,6 @@ let () = f20210308; m20210427; r20210427; m20210531; r20210531; + m20210602; r20210602; ] |> Cmdliner.Term.exit diff --git a/bin/migrations/m20210602.ml b/bin/migrations/m20210602.ml new file mode 100644 index 0000000..8db709d --- /dev/null +++ b/bin/migrations/m20210602.ml @@ -0,0 +1,143 @@ +let old_version = 4L and new_version = 5L + +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_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_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 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_request.collect ~oneshot:true + Caqti_type.unit + Caqti_type.(tup3 Builder_db.Rep.id + (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string))) + Builder_db.Rep.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_request.exec ~oneshot:true + Caqti_type.(tup3 Builder_db.Rep.id + (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.id))) + Builder_db.Rep.id) + {| 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_request.exec ~oneshot:true + Caqti_type.unit + "DROP TABLE build" + +let rename_build = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + "ALTER TABLE new_build RENAME TO build" + +let find_main_artifact_id = + Caqti_request.find ~oneshot:true + Caqti_type.(tup2 Builder_db.Rep.id string) + Builder_db.Rep.id + "SELECT id FROM build_artifact WHERE build = ?1 AND filepath = ?2" + +let find_main_artifact_filepath = + Caqti_request.find ~oneshot:true + Builder_db.Rep.id + Caqti_type.string + "SELECT filepath FROM build_artifact WHERE id = ?" + +let collect_new_build = + Caqti_request.collect ~oneshot:true + Caqti_type.unit + Caqti_type.(tup3 Builder_db.Rep.id + (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option Builder_db.Rep.id))) + Builder_db.Rep.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_request.exec ~oneshot:true + Caqti_type.(tup3 Builder_db.Rep.id + (tup3 (tup4 string int64 int64 int64) (tup4 int64 int (option int) (option string)) (tup3 octets string (option string))) + Builder_db.Rep.id) + {| 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) = + let open Rresult.R.Infix in + 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 (Grej.set_version new_version) () + + +let rollback _ (module Db : Caqti_blocking.CONNECTION) = + let open Rresult.R.Infix in + 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 (Grej.set_version old_version) () diff --git a/db/builder_db.ml b/db/builder_db.ml index 7311ddc..b8c8022 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 = 4L +let current_version = 5L type id = Rep.id @@ -211,7 +211,7 @@ module Build = struct result : Builder.execution_result; console : (int * string) list; script : string; - main_binary : Fpath.t option; + main_binary : id option; job_id : id; } @@ -228,7 +228,7 @@ module Build = struct console) (tup2 string - (option Rep.fpath))) + (option Rep.id))) id) in let encode { uuid; start; finish; result; console; script; main_binary; job_id } = @@ -245,7 +245,7 @@ module Build = struct start : Ptime.t; finish : Ptime.t; result : Builder.execution_result; - main_binary : Fpath.t option; + main_binary : id option; job_id : id; } @@ -258,7 +258,7 @@ module Build = struct Rep.ptime Rep.ptime) execution_result - (option Rep.fpath)) + (option Rep.id)) id) in let encode { uuid; start; finish; result; main_binary; job_id } = @@ -285,9 +285,10 @@ module Build = struct result_msg TEXT, console BLOB NOT NULL, script TEXT NOT NULL, - main_binary TEXT, + main_binary INTEGER, job INTEGER NOT NULL, + FOREIGN KEY(main_binary) REFERENCES build_artifact(id), FOREIGN KEY(job) REFERENCES job(id) ) |} @@ -357,7 +358,7 @@ module Build = struct build_artifact.filepath, build_artifact.localpath, build_artifact.sha256, build_artifact.size FROM build, job LEFT JOIN build_artifact ON - build_artifact.build = build.id AND build.main_binary = build_artifact.filepath + build.main_binary = build_artifact.id WHERE job.name = ? AND build.job = job.id ORDER BY start_d DESC, start_ps DESC |} @@ -376,7 +377,7 @@ module Build = struct a.filepath, a.localpath, a.sha256, a.size FROM build b LEFT JOIN build_artifact a ON - a.build = b.id AND b.main_binary = a.filepath + b.main_binary = a.id WHERE b.job = ? ORDER BY start_d DESC, start_ps DESC LIMIT 1 @@ -436,6 +437,11 @@ module Build = struct LIMIT 1 |} + let set_main_binary = + Caqti_request.exec + (Caqti_type.tup2 id id) + "UPDATE build SET main_binary = ?2 WHERE id = ?1" + let remove = Caqti_request.exec id diff --git a/db/builder_db.mli b/db/builder_db.mli index 2e1428f..273cb39 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -112,7 +112,7 @@ sig result : Builder.execution_result; console : (int * string) list; script : string; - main_binary : Fpath.t option; + main_binary : id option; job_id : id; } module Meta : @@ -122,7 +122,7 @@ sig start : Ptime.t; finish : Ptime.t; result : Builder.execution_result; - main_binary : Fpath.t option; + main_binary : id option; job_id : id; } end @@ -155,6 +155,7 @@ sig val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_by_hash : (Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t + val set_main_binary : (id * id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove : (id, unit, [< `Many | `One | `Zero > `Zero]) Caqti_request.t end diff --git a/lib/model.ml b/lib/model.ml index b278638..c6a6f5d 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -196,30 +196,13 @@ let add_build x in or_cleanup (save_all staging_dir exec) >>= fun (artifacts, input_files) -> - let main_binary = - match List.find_all - (fun file -> - Fpath.is_prefix - (Fpath.v "bin/") - file.Builder_db.filepath) - artifacts with - | [ main_binary ] -> Some main_binary.filepath - | [] -> - Log.debug (fun m -> m "Zero binaries for build %a" Uuidm.pp uuid); - None - | binaries -> - Log.debug (fun m -> m "Multiple binaries for build %a: %a" Uuidm.pp uuid - Fmt.(list ~sep:(any ",") Fpath.pp) - (List.map (fun f -> f.filepath) binaries)); - None - in let r = Db.start () >>= fun () -> Db.exec Job.try_add job_name >>= fun () -> Db.find Job.get_id_by_name job_name >>= fun job_id -> Db.exec Build.add { Build.uuid; start; finish; result; console; script = job.Builder.script; - main_binary; job_id } >>= fun () -> + main_binary = None; job_id } >>= fun () -> Db.find last_insert_rowid () >>= fun id -> List.fold_left (fun r file -> @@ -233,6 +216,17 @@ let add_build Db.exec Build_file.add (file, id)) (Lwt_result.return ()) input_files >>= fun () -> + Db.collect_list Build_artifact.get_all_by_build id >>= fun artifacts -> + (match List.filter (fun (_, p) -> Fpath.(is_prefix (v "bin/") p.filepath)) artifacts with + | [ (build_artifact_id, _) ] -> Db.exec Build.set_main_binary (id, build_artifact_id) + | [] -> + Log.debug (fun m -> m "Zero binaries for build %a" Uuidm.pp uuid); + Lwt_result.return () + | xs -> + Log.warn (fun m -> m "Multiple binaries for build %a: %a" Uuidm.pp uuid + Fmt.(list ~sep:(any ",") Fpath.pp) + (List.map (fun (_, a) -> a.filepath) xs)); + Lwt_result.return ()) >>= fun () -> Db.commit () >>= fun () -> commit_files datadir staging_dir job_name uuid in diff --git a/test/builder_db.ml b/test/builder_db.ml index b703567..dde876e 100644 --- a/test/builder_db.ml +++ b/test/builder_db.ml @@ -153,10 +153,12 @@ let add_test_build (module Db : CONN) = Db.exec Job.try_add job_name >>= fun () -> Db.find Job.get_id_by_name job_name >>= fun job_id -> Db.exec Build.add { Build.uuid; start; finish; result; console; script; - main_binary = Some main_binary.filepath; + main_binary = None; job_id } >>= fun () -> Db.find last_insert_rowid () >>= fun id -> Db.exec Build_artifact.add (main_binary, id) >>= fun () -> + Db.find last_insert_rowid () >>= fun main_binary_id -> + Db.exec Build.set_main_binary (id, main_binary_id) >>= fun () -> Db.commit () in Rresult.R.kignore_error @@ -218,10 +220,12 @@ let add_second_build (module Db : CONN) = Db.start () >>= fun () -> Db.find Job.get_id_by_name job_name >>= fun job_id -> Db.exec Build.add { Build.uuid; start; finish; result; console; script; - main_binary = Some main_binary.filepath; job_id; + main_binary = None; job_id; } >>= fun () -> Db.find last_insert_rowid () >>= fun id -> Db.exec Build_artifact.add (main_binary, id) >>= fun () -> + Db.find last_insert_rowid () >>= fun main_binary_id -> + Db.exec Build.set_main_binary (id, main_binary_id) >>= fun () -> Db.commit () let test_build_get_latest (module Db : CONN) =