Add file sizes

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

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

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

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 :

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

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

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