Show build main binary and hash in job view

db/builder_db.ml

@@ -8,19 +8,12 @@ let current_version = 1L
 
 type id = Rep.id
 
-type file = {
+type file = Rep.file = {
   filepath : Fpath.t;
   localpath : Fpath.t;
   sha256 : Cstruct.t;
 }
 
-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 last_insert_rowid =
   Caqti_request.find
     Caqti_type.unit
@@ -349,13 +342,18 @@ module Build = struct
   let get_all_meta_by_name =
     Caqti_request.collect
       Caqti_type.string
-      (Caqti_type.tup2
-         id Meta.t)
+      (Caqti_type.tup3
+         id
+         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.main_binary, build.job
+                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
            FROM build, job
+           LEFT JOIN build_artifact ON
+             build_artifact.build = build.id AND build.main_binary = build_artifact.filepath
            WHERE job.name = ? AND build.job = job.id
            ORDER BY start_d DESC, start_ps DESC
         |}

db/builder_db.mli

@@ -5,7 +5,6 @@ type file = {
   localpath : Fpath.t;
   sha256 : Cstruct.t;
 }
-val file : file Caqti_type.t
 
 val application_id : int32
 
@@ -124,7 +123,7 @@ sig
   val get_all_meta :
     (id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
   val get_all_meta_by_name :
-    (string, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
+    (string, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t
   val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
 end
 

db/representation.ml

@@ -23,6 +23,12 @@ end
 type id = int64
 let id = Caqti_type.int64
 
+type file = {
+  filepath : Fpath.t;
+  localpath : Fpath.t;
+  sha256 : Cstruct.t;
+}
+
 let uuid =
   let encode uuid = Ok (Uuidm.to_bytes uuid) in
   let decode s =
@@ -50,6 +56,32 @@ let cstruct =
   let decode s = Ok (Cstruct.of_string s) in
   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 file_opt =
+  let rep = Caqti_type.(tup3 (option fpath) (option fpath) (option cstruct)) in
+  let encode = function
+    | Some { filepath; localpath; sha256 } ->
+      Ok (Some filepath, Some localpath, Some sha256)
+    | None ->
+      Ok (None, None, None)
+  in
+  let decode = function
+    | (Some filepath, Some localpath, Some sha256) ->
+      Ok (Some { filepath; localpath; sha256 })
+    | (None, None, None) ->
+      Ok None
+    | _ ->
+      (* This should not happen if the database is well-formed *)
+      Error "Some but not all fields NULL"
+  in
+  Caqti_type.custom ~encode ~decode rep
+
 let execution_result =
   let encode = function
     | Builder.Exited v -> Ok (0, Some v, None)

lib/builder_web.ml

@@ -86,14 +86,16 @@ let routes t =
 
   let job req =
     let job_name = Router.param req "job" in
-    let+ job = Caqti_lwt.Pool.use (Model.job job_name) t.pool in
+    let+ job =
+      Caqti_lwt.Pool.use (Model.job job_name) t.pool
+    in
     match job with
     | Error e ->
       Log.warn (fun m -> m "Error getting job: %a" pp_error e);
       Response.of_plain_text ~status:`Internal_server_error
         "Error getting job"
     | Ok builds ->
-      Views.job job_name (List.map snd builds) |> Response.of_html
+      Views.job job_name builds |> Response.of_html
   in
 
   let job_build req =

lib/model.ml

@@ -49,7 +49,7 @@ let build_exists uuid (module Db : CONN) =
   Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
   Option.is_some
 
-let main_binary id { Builder_db.Build.main_binary; _ } (module Db : CONN) =
+let main_binary id main_binary (module Db : CONN) =
   match main_binary with
   | None -> Lwt_result.return None
   | Some main_binary ->
@@ -57,7 +57,8 @@ let main_binary id { Builder_db.Build.main_binary; _ } (module Db : CONN) =
     Some file
 
 let job job (module Db : CONN) =
-  Db.collect_list Builder_db.Build.get_all_meta_by_name job
+  Db.collect_list Builder_db.Build.get_all_meta_by_name job >|=
+  List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
 
 let jobs (module Db : CONN) =
   Db.collect_list Builder_db.Job.get_all () >|=

lib/model.mli

@@ -14,11 +14,11 @@ val build : Uuidm.t -> Caqti_lwt.connection ->
 val build_exists : Uuidm.t -> Caqti_lwt.connection ->
   (bool, [> error ]) result Lwt.t
 
-val main_binary : Builder_db.id -> Builder_db.Build.t -> Caqti_lwt.connection ->
+val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
   (Builder_db.file option, [> error ]) result Lwt.t
 
 val job : string -> Caqti_lwt.connection ->
-  ((Builder_db.id * Builder_db.Build.Meta.t) list, [> error ]) result Lwt.t
+  ((Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
 
 val jobs : Caqti_lwt.connection ->
   (string list, [> error ]) result Lwt.t

lib/views.ml

@@ -101,15 +101,28 @@ let job name builds =
         txtf "Currently %d builds."
           (List.length builds)
       ];
-      ul (List.map (fun build ->
-          li [
-            a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid) ^ "/")]
+      ul (List.map (fun (build, main_binary) ->
+          li ([
+              a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid / ""))]
+                [
+                  txtf "%a" (Ptime.pp_human ()) build.Builder_db.Build.Meta.start;
+                ];
+              txt " ";
+              check_icon build.result;
+              br ();
+            ] @ match main_binary with
+            | Some main_binary ->
               [
-                txtf "%a" (Ptime.pp_human ()) build.Builder_db.Build.Meta.start;
-              ];
-            txt " ";
-            check_icon build.result;
-          ])
+                a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid
+                                               / "f" // main_binary.Builder_db.filepath))]
+                  [txtf "%s" (Fpath.basename main_binary.Builder_db.filepath)];
+                txt " ";
+                code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct main_binary.Builder_db.sha256)];
+              ]
+            | None ->
+              [
+                txtf "Build failed";
+              ]))
           builds);
 
     ]