diff --git a/bin/migrations/builder_migrations.ml b/bin/migrations/builder_migrations.ml index a5b9293..88e53fe 100644 --- a/bin/migrations/builder_migrations.ml +++ b/bin/migrations/builder_migrations.ml @@ -85,6 +85,11 @@ let r20210216 = Cmdliner.Term.(const do_database_action $ const M20210216.rollback $ setup_log $ dbpath), 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 $ dbpath), + Cmdliner.Term.info ~doc "migrate-2021-02-18" + let help_cmd = let topic = let doc = "Migration to get help on" in @@ -106,5 +111,6 @@ let () = m20210126; r20210126; m20210202; r20210202; m20210216; r20210216; + m20210218; ] |> Cmdliner.Term.exit diff --git a/bin/migrations/m20210218.ml b/bin/migrations/m20210218.ml new file mode 100644 index 0000000..de1a201 --- /dev/null +++ b/bin/migrations/m20210218.ml @@ -0,0 +1,62 @@ +let old_user_version = 2L +let new_user_version = 3L + +let set_version version = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + (Printf.sprintf "PRAGMA user_version = %Ld" version) + +let alter_build_artifact = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + "ALTER TABLE build_artifact ADD COLUMN size INTEGER NOT NULL" + +let alter_build_file = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + "ALTER TABLE build_file ADD COLUMN size INTEGER NOT NULL" + +let collect_build_artifact_localpath = + Caqti_request.collect ~oneshot:true + Caqti_type.unit + Caqti_type.(tup2 int64 string) + "SELECT id, localpath FROM build_artifact" + +let collect_build_file_localpath = + Caqti_request.collect ~oneshot:true + Caqti_type.unit + Caqti_type.(tup2 int64 string) + "SELECT id, localpath FROM build_file" + +let set_build_artifact_size = + Caqti_request.exec ~oneshot:true + Caqti_type.(tup2 int64 int64) + "UPDATE build_artifact SET size = ?2 WHERE id = ?1" + +let set_build_file_size = + Caqti_request.exec ~oneshot:true + Caqti_type.(tup2 int64 int64) + "UPDATE build_file SET size = ?2 WHERE id = ?1" + +let migrate (module Db : Caqti_blocking.CONNECTION) = + let open Rresult.R.Infix in + Db.find Builder_db.get_application_id () >>= fun application_id -> + Db.find Builder_db.get_version () >>= fun user_version -> + if application_id <> Builder_db.application_id || user_version <> old_user_version + then Error (`Wrong_version (application_id, user_version)) + else + Db.exec alter_build_artifact () >>= fun () -> + Db.iter_s collect_build_artifact_localpath + (fun (id, localpath) -> + let stats = Unix.stat localpath in + Db.exec set_build_artifact_size (id, Int64.of_int stats.st_size)) + () + >>= fun () -> + Db.exec alter_build_file () >>= fun () -> + Db.iter_s collect_build_file_localpath + (fun (id, localpath) -> + let stats = Unix.stat localpath in + Db.exec set_build_file_size (id, Int64.of_int stats.st_size)) + () + +(* FIXME: rollback. Requires copying data and creating new table without size column. *) diff --git a/db/builder_db.ml b/db/builder_db.ml index 255f473..ae5702e 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 = 2L +let current_version = 3L type id = Rep.id @@ -12,6 +12,7 @@ type file = Rep.file = { filepath : Fpath.t; localpath : Fpath.t; sha256 : Cstruct.t; + size : int64; } let last_insert_rowid = @@ -96,6 +97,7 @@ module Build_artifact = struct filepath TEXT NOT NULL, -- the path as in the build localpath TEXT NOT NULL, -- local path to the file on disk sha256 BLOB NOT NULL, + size INTEGER NOT NULL, build INTEGER NOT NULL, FOREIGN KEY(build) REFERENCES build(id), @@ -112,7 +114,7 @@ module Build_artifact = struct Caqti_request.find (Caqti_type.tup2 id fpath) (Caqti_type.tup2 id file) - {| SELECT id, filepath, localpath, sha256 + {| SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ? AND filepath = ? |} @@ -122,7 +124,7 @@ module Build_artifact = struct (Caqti_type.tup2 uuid fpath) (Caqti_type.tup2 id file) {| SELECT build_artifact.id, build_artifact.filepath, - build_artifact.localpath, build_artifact.sha256 + build_artifact.localpath, build_artifact.sha256, build_artifact.size FROM build_artifact INNER JOIN build ON build.id = build_artifact.build WHERE build.uuid = ? AND build_artifact.filepath = ? @@ -134,12 +136,12 @@ module Build_artifact = struct Caqti_type.(tup2 id file) - "SELECT id, filepath, localpath, sha256 FROM build_artifact WHERE build = ?" + "SELECT id, filepath, localpath, sha256, size FROM build_artifact WHERE build = ?" let add = Caqti_request.exec Caqti_type.(tup2 file id) - "INSERT INTO build_artifact (filepath, localpath, sha256, build) + "INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?)" let remove_by_build = @@ -157,6 +159,7 @@ module Build_file = struct filepath TEXT NOT NULL, -- the path as in the build localpath TEXT NOT NULL, -- local path to the file on disk sha256 BLOB NOT NULL, + size INTEGER NOT NULL, build INTEGER NOT NULL, FOREIGN KEY(build) REFERENCES build(id), @@ -172,8 +175,9 @@ module Build_file = struct let get_by_build_uuid = Caqti_request.find_opt (Caqti_type.tup2 uuid fpath) - (Caqti_type.tup2 fpath cstruct) - {| SELECT build_file.localpath, build_file.sha256 + (Caqti_type.tup2 id file) + {| SELECT build_file.id, build_file.localpath, + build_file.localpath, build_file.sha256, build_file.size FROM build_file INNER JOIN build ON build.id = build_file.build WHERE build.uuid = ? AND build_file.filepath = ? @@ -185,12 +189,12 @@ module Build_file = struct Caqti_type.(tup2 id file) - "SELECT id, filepath, localpath, sha256 FROM build_file WHERE build = ?" + "SELECT id, filepath, localpath, sha256, size FROM build_file WHERE build = ?" let add = Caqti_request.exec Caqti_type.(tup2 file id) - "INSERT INTO build_file (filepath, localpath, sha256, build) + "INSERT INTO build_file (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?)" let remove_by_build = @@ -350,7 +354,7 @@ module Build = struct build.start_d, build.start_ps, build.finish_d, build.finish_ps, build.result_kind, build.result_code, build.result_msg, build.main_binary, build.job, - build_artifact.filepath, build_artifact.localpath, build_artifact.sha256 + 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 @@ -369,7 +373,7 @@ module Build = struct b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_kind, b.result_code, b.result_msg, b.main_binary, b.job, - a.filepath, a.localpath, a.sha256 + 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 diff --git a/db/builder_db.mli b/db/builder_db.mli index b669a87..73506d0 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -4,6 +4,7 @@ type file = { filepath : Fpath.t; localpath : Fpath.t; sha256 : Cstruct.t; + size : int64; } val application_id : int32 @@ -73,7 +74,7 @@ module Build_file : sig (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_by_build_uuid : - (Uuidm.t * Fpath.t, Fpath.t * Cstruct.t, + (Uuidm.t * Fpath.t, id * file, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_all_by_build : diff --git a/db/representation.ml b/db/representation.ml index 6ac5ba1..0f22beb 100644 --- a/db/representation.ml +++ b/db/representation.ml @@ -27,6 +27,7 @@ type file = { filepath : Fpath.t; localpath : Fpath.t; sha256 : Cstruct.t; + size : int64; } let uuid = @@ -57,24 +58,24 @@ let cstruct = Caqti_type.custom ~encode ~decode Caqti_type.octets let file = - let encode { filepath; localpath; sha256 } = - Ok (filepath, localpath, sha256) in - let decode (filepath, localpath, sha256) = - Ok { filepath; localpath; sha256 } in - Caqti_type.custom ~encode ~decode Caqti_type.(tup3 fpath fpath cstruct) + let encode { filepath; localpath; sha256; size } = + Ok (filepath, localpath, sha256, size) in + let decode (filepath, localpath, sha256, size) = + Ok { filepath; localpath; sha256; size } in + Caqti_type.custom ~encode ~decode Caqti_type.(tup4 fpath fpath cstruct int64) let file_opt = - let rep = Caqti_type.(tup3 (option fpath) (option fpath) (option cstruct)) in + let rep = Caqti_type.(tup4 (option fpath) (option fpath) (option cstruct) (option int64)) in let encode = function - | Some { filepath; localpath; sha256 } -> - Ok (Some filepath, Some localpath, Some sha256) + | Some { filepath; localpath; sha256; size } -> + Ok (Some filepath, Some localpath, Some sha256, Some size) | None -> - Ok (None, None, None) + Ok (None, None, None, None) in let decode = function - | (Some filepath, Some localpath, Some sha256) -> - Ok (Some { filepath; localpath; sha256 }) - | (None, None, None) -> + | (Some filepath, Some localpath, Some sha256, Some size) -> + Ok (Some { filepath; localpath; sha256; size }) + | (None, None, None, None) -> Ok None | _ -> (* This should not happen if the database is well-formed *) diff --git a/lib/model.ml b/lib/model.ml index bbc479a..0f080f0 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -92,11 +92,12 @@ let save_exec build_dir exec = save Fpath.(build_dir / "full") (Cstruct.to_string cs) let save_file dir (filepath, data) = + let size = String.length data |> Int64.of_int in let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in let localpath = Fpath.append dir filepath in Lwt_result.lift (Bos.OS.Dir.create (Fpath.parent localpath)) >>= fun _ -> save localpath data >|= fun () -> - { Builder_db.filepath; localpath; sha256 } + { Builder_db.filepath; localpath; sha256; size } let save_files dir files = List.fold_left diff --git a/lib/views.ml b/lib/views.ml index 08951be..8416a2f 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -178,7 +178,7 @@ let job_build p [txtf "Execution result: %a." Builder.pp_execution_result result]; h3 [txt "Digests of build artifacts"]; dl (List.concat_map - (fun { Builder_db.filepath; localpath=_; sha256; } -> + (fun { Builder_db.filepath; localpath=_; sha256; size=_ } -> let (`Hex sha256_hex) = Hex.of_cstruct sha256 in [ dt [a