Add file sizes

pull/33/head
Reynir Björnsson 2 years ago
parent 7b81d78554
commit 535d2ac0b9
  1. 6
      bin/migrations/builder_migrations.ml
  2. 62
      bin/migrations/m20210218.ml
  3. 26
      db/builder_db.ml
  4. 3
      db/builder_db.mli
  5. 25
      db/representation.ml
  6. 3
      lib/model.ml
  7. 2
      lib/views.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

@ -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. *)

@ -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

@ -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 :

@ -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 *)

@ -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

@ -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

Loading…
Cancel
Save