Merge pull request 'Schema versioning and main binary' (#22) from schema-versioning into main

Reviewed-on: https://git.robur.io/robur/builder-web/pulls/22

bin/migrations/builder_migrations.ml

@@ -0,0 +1,87 @@
+open Rresult.R.Infix
+
+let pp_error ppf = function
+  | #Caqti_error.load_or_connect | #Caqti_error.call_or_retrieve as e ->
+    Caqti_error.pp ppf e
+  | `Wrong_version (application_id, user_version) ->
+    Format.fprintf ppf "wrong version { application_id: %ld, user_version: %Ld }"
+      application_id user_version
+
+let or_die exit_code = function
+  | Ok r -> r
+  | Error e ->
+    Format.eprintf "Database error: %a" pp_error e;
+    exit exit_code
+
+let do_database_action action () dbpath =
+  Logs.debug (fun m -> m "Connecting to database...");
+  let ((module Db : Caqti_blocking.CONNECTION) as conn) =
+    Caqti_blocking.connect
+      (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
+    |> or_die 1
+  in
+  Logs.debug (fun m -> m "Connected!");
+  let r =
+    Db.start () >>= fun () ->
+    Logs.debug (fun m -> m "Started database transaction");
+    match action conn with
+    | Ok () ->
+      Logs.debug (fun m -> m "Committing database transaction");
+      Db.commit ()
+    | Error _ as e ->
+      Logs.debug (fun m -> m "Rolling back database transaction");
+      Db.rollback () >>= fun () ->
+      e
+  in
+  or_die 2 r
+
+let help man_format migrations = function
+  | None -> `Help (man_format, None)
+  | Some migration ->
+    if List.mem migration migrations
+    then `Help (man_format, Some migration)
+    else `Error (true, "Unknown migration: " ^ migration)
+
+let dbpath =
+  let doc = "sqlite3 database path" in
+  Cmdliner.Arg.(value &
+                opt non_dir_file "/var/db/builder-web/builder.sqlite3" &
+                info ~doc ["dbpath"])
+
+let setup_log =
+  let setup_log level =
+    Logs.set_level level;
+    Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ());
+  in
+  Cmdliner.Term.(const setup_log $ Logs_cli.level ())
+
+let m20210126 =
+  let doc = "Adds a column 'main_binary' in 'build' (2021-01-26)" in
+  Cmdliner.Term.(const do_database_action $ const M20210126.migrate $ setup_log $ dbpath),
+  Cmdliner.Term.info ~doc "migrate-2021-01-26"
+
+let r20210126 =
+  let doc = "Rollback 'main_binary' in 'build' (2021-01-26)" in
+  Cmdliner.Term.(const do_database_action $ const M20210126.rollback $ setup_log $ dbpath),
+  Cmdliner.Term.info ~doc "rollback-2021-01-26"
+
+let help_cmd =
+  let topic =
+    let doc = "Migration to get help on" in
+    Cmdliner.Arg.(value & pos 0 (some string) None & info ~doc ~docv:"MIGRATION" [])
+  in
+  let doc = "Builder migration help" in
+  Cmdliner.Term.(ret (const help $ man_format $ choice_names $ topic)),
+  Cmdliner.Term.info ~doc "help"
+
+let default_cmd =
+  let doc = "Builder migration command" in
+  Cmdliner.Term.(ret (const help $ man_format $ choice_names $ const None)),
+  Cmdliner.Term.info ~doc "builder-migrations"
+
+let () =
+  Cmdliner.Term.eval_choice
+    default_cmd
+    [help_cmd;
+     m20210126; r20210126]
+  |> Cmdliner.Term.exit

bin/migrations/dune

@@ -0,0 +1,4 @@
+(executable
+ (public_name builder-migrations)
+ (name builder_migrations)
+ (libraries builder_db caqti caqti-driver-sqlite3 caqti.blocking cmdliner logs logs.cli logs.fmt ))

bin/migrations/m20210126.ml

@@ -0,0 +1,110 @@
+let new_user_version =
+  1L
+
+let set_application_id =
+  Caqti_request.exec
+    Caqti_type.unit
+    (Printf.sprintf "PRAGMA application_id = %ld" Builder_db.application_id)
+
+let set_version version =
+  Caqti_request.exec ~oneshot:true
+    Caqti_type.unit
+    (Printf.sprintf "PRAGMA user_version = %Ld" version)
+
+let alter_build =
+  Caqti_request.exec ~oneshot:true
+    Caqti_type.unit
+    "ALTER TABLE build ADD COLUMN main_binary TEXT"
+
+let all_builds =
+  Caqti_request.collect ~oneshot:true
+    Caqti_type.unit
+    Caqti_type.int64
+    "SELECT id FROM build"
+
+let bin_artifact =
+  Caqti_request.collect ~oneshot:true
+    Caqti_type.int64
+    Caqti_type.(tup2 int64 string)
+    "SELECT id, filepath FROM build_artifact WHERE build = ? AND filepath LIKE 'bin/%'"
+
+let set_main_binary =
+  Caqti_request.exec ~oneshot:true
+    Caqti_type.(tup2 int64 (option string))
+    "UPDATE build SET main_binary = ?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 <> 0l || user_version <> 0L
+  then
+    Error (`Wrong_version (application_id, user_version))
+  else
+    Db.exec alter_build () >>= fun () ->
+    Db.collect_list all_builds () >>= fun builds ->
+    List.fold_left (fun r build ->
+        r >>= fun () ->
+        Db.collect_list bin_artifact build >>= function
+        | [_id, main_binary] ->
+          Db.exec set_main_binary (build, Some main_binary)
+        | [] ->
+          Logs.debug (fun m -> m "No binaries for build id %Ld" build);
+          Ok ()
+        | binaries ->
+          Logs.warn (fun m -> m "More than one binary for build id %Ld" build);
+          Logs.debug (fun m -> m "binaries: [%a]" Fmt.(list ~sep:(any ";") string)
+                         (List.map snd binaries));
+          Ok ())
+      (Ok ())
+      builds >>= fun () ->
+    Db.exec Builder_db.set_application_id () >>= fun () ->
+    Db.exec (set_version new_user_version) ()
+
+let rename_build =
+  Caqti_request.exec
+    Caqti_type.unit
+    "ALTER TABLE build RENAME TO __tmp_build"
+
+let create_build =
+  Caqti_request.exec
+    Caqti_type.unit
+    {| CREATE TABLE 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,
+         job INTEGER NOT NULL,
+
+         FOREIGN KEY(job) REFERENCES job(id)
+       )
+       |}
+
+let rollback_data =
+  Caqti_request.exec
+    Caqti_type.unit
+    {| INSERT INTO build
+       SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
+         result_kind, result_code, result_msg, console, script, job
+       FROM __tmp_build
+    |}
+
+let rollback (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 <> new_user_version
+  then
+    Error (`Wrong_version (application_id, user_version))
+  else
+    Db.exec rename_build () >>= fun () ->
+    Db.exec create_build () >>= fun () ->
+    Db.exec rollback_data () >>= fun () ->
+    Db.exec (set_version 0L) ()

db/builder_db.ml

@@ -1,27 +1,48 @@
 module Rep = Representation
 open Rep
 
+let application_id = 1234839235l
+
+(* Please update this when making changes! *)
+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
     id
     "SELECT last_insert_rowid()"
 
+
+let get_application_id =
+  Caqti_request.find
+    Caqti_type.unit
+    Caqti_type.int32
+    "PRAGMA application_id"
+
+let get_version =
+  Caqti_request.find
+    Caqti_type.unit
+    Caqti_type.int64
+    "PRAGMA user_version"
+
+let set_application_id =
+  Caqti_request.exec
+    Caqti_type.unit
+    (Printf.sprintf "PRAGMA application_id = %ld" application_id)
+
+let set_current_version =
+  Caqti_request.exec
+    Caqti_type.unit
+    (Printf.sprintf "PRAGMA user_version = %Ld" current_version)
+
 module Job = struct
   let migrate =
     Caqti_request.exec
@@ -87,11 +108,21 @@ module Build_artifact = struct
       Caqti_type.unit
       "DROP TABLE IF EXISTS build_artifact"
 
+  let get_by_build =
+    Caqti_request.find
+      (Caqti_type.tup2 id fpath)
+      (Caqti_type.tup2 id file)
+      {| SELECT id, filepath, localpath, sha256
+         FROM build_artifact
+         WHERE build = ? AND filepath = ?
+      |}
+
   let get_by_build_uuid =
     Caqti_request.find_opt
       (Caqti_type.tup2 uuid fpath)
-      (Caqti_type.tup2 fpath cstruct)
+      (Caqti_type.tup2 id file)
-      {| SELECT build_artifact.localpath, build_artifact.sha256
+      {| SELECT build_artifact.id, build_artifact.filepath,
+           build_artifact.localpath, build_artifact.sha256
          FROM build_artifact
          INNER JOIN build ON build.id = build_artifact.build
          WHERE build.uuid = ? AND build_artifact.filepath = ?
@@ -176,6 +207,7 @@ module Build = struct
     result : Builder.execution_result;
     console : (int * string) list;
     script : string;
+    main_binary : Fpath.t option;
     job_id : id;
   }
 
@@ -190,14 +222,16 @@ module Build = struct
                        (tup2
                           execution_result
                           console)
-                       string)
+                       (tup2
+                          string
+                          (option Rep.fpath)))
                     id)
     in
-    let encode { uuid; start; finish; result; console; script; job_id } =
+    let encode { uuid; start; finish; result; console; script; main_binary; job_id } =
-      Ok ((uuid, (start, finish), (result, console), script), job_id)
+      Ok ((uuid, (start, finish), (result, console), (script, main_binary)), job_id)
     in
-    let decode ((uuid, (start, finish), (result, console), script), job_id) =
+    let decode ((uuid, (start, finish), (result, console), (script, main_binary)), job_id) =
-      Ok { uuid; start; finish; result; console; script; job_id }
+      Ok { uuid; start; finish; result; console; script; main_binary; job_id }
     in
     Caqti_type.custom ~encode ~decode rep
 
@@ -207,6 +241,7 @@ module Build = struct
       start : Ptime.t;
       finish : Ptime.t;
       result : Builder.execution_result;
+      main_binary : Fpath.t option;
       job_id : id;
     }
 
@@ -215,16 +250,18 @@ module Build = struct
         Caqti_type.(tup2
                      (tup4
                        uuid
-                       Rep.ptime
+                       (tup2
-                       Rep.ptime
+                          Rep.ptime
-                       execution_result)
+                          Rep.ptime)
+                       execution_result
+                       (option Rep.fpath))
                      id)
       in
-      let encode { uuid; start; finish; result; job_id } =
+      let encode { uuid; start; finish; result; main_binary; job_id } =
-        Ok ((uuid, start, finish, result), job_id)
+        Ok ((uuid, (start, finish), result, main_binary), job_id)
       in
-      let decode ((uuid, start, finish, result), job_id) =
+      let decode ((uuid, (start, finish), result, main_binary), job_id) =
-        Ok { uuid; start; finish; result; job_id }
+        Ok { uuid; start; finish; result; main_binary; job_id }
       in
       Caqti_type.custom ~encode ~decode rep
   end
@@ -244,6 +281,7 @@ module Build = struct
            result_msg TEXT,
            console BLOB NOT NULL,
            script TEXT NOT NULL,
+           main_binary TEXT,
            job INTEGER NOT NULL,
 
            FOREIGN KEY(job) REFERENCES job(id)
@@ -261,7 +299,7 @@ module Build = struct
       t
       {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
                 result_kind, result_code, result_msg,
-                console, script, job
+                console, script, main_binary, job
            FROM build
            WHERE id = ?
         |}
@@ -272,7 +310,7 @@ module Build = struct
       (Caqti_type.tup2 id t)
       {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
                   result_kind, result_code, result_msg,
-                  console, script, job
+                  console, script, main_binary, job
            FROM build
            WHERE uuid = ?
         |}
@@ -283,7 +321,7 @@ module Build = struct
       (Caqti_type.tup2 id t)
       {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
                   result_kind, result_code, result_msg, console,
-                  script, job
+                  script, main_binary, job
            FROM build
            WHERE job = ?
            ORDER BY start_d DESC, start_ps DESC
@@ -295,7 +333,7 @@ module Build = struct
       (Caqti_type.tup2
          id Meta.t)
       {| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
-                  result_kind, result_code, result_msg, job
+                  result_kind, result_code, result_msg, main_binary, job
            FROM build
            WHERE job = ?
            ORDER BY start_d DESC, start_ps DESC
@@ -304,12 +342,18 @@ module Build = struct
   let get_all_meta_by_name =
     Caqti_request.collect
       Caqti_type.string
-      (Caqti_type.tup2
+      (Caqti_type.tup3
-         id Meta.t)
+         id
+         Meta.t
+         file_opt)
       {| SELECT build.id, build.uuid,
-                  build.start_d, build.start_ps, build.finish_d, build.finish_ps,
+                build.start_d, build.start_ps, build.finish_d, build.finish_ps,
-                  build.result_kind, build.result_code, build.result_msg, build.job
+                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
         |}
@@ -320,9 +364,9 @@ module Build = struct
       t
       {| INSERT INTO build
            (uuid, start_d, start_ps, finish_d, finish_ps,
-           result_kind, result_code, result_msg, console, script, job)
+           result_kind, result_code, result_msg, console, script, main_binary, job)
            VALUES
-           (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
+           (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
         |}
 
 end
@@ -394,6 +438,8 @@ let migrate = [
   Build_artifact.migrate;
   Build_file.migrate;
   User.migrate;
+  set_current_version;
+  set_application_id;
 ]
 
 let rollback = [
@@ -402,4 +448,8 @@ let rollback = [
   Build_artifact.rollback;
   Build.rollback;
   Job.rollback;
+  Caqti_request.exec Caqti_type.unit
+    "PRAGMA user_version = 0";
+  Caqti_request.exec Caqti_type.unit
+    "PRAGMA application_id = 0";
 ]

db/builder_db.mli

@@ -5,7 +5,22 @@ type file = {
   localpath : Fpath.t;
   sha256 : Cstruct.t;
 }
-val file : file Caqti_type.t
+
+val application_id : int32
+
+val current_version : int64
+
+val get_application_id :
+  (unit, int32, [< `Many | `One | `Zero > `One ]) Caqti_request.t
+
+val set_application_id :
+  (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
+
+val get_version :
+  (unit, int64, [< `Many | `One | `Zero > `One ]) Caqti_request.t
+
+val set_current_version :
+  (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
 
 val last_insert_rowid :
   (unit, id, [< `Many | `One | `Zero > `One ]) Caqti_request.t
@@ -35,8 +50,12 @@ module Build_artifact : sig
   val rollback :
     (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
 
+  val get_by_build :
+    (id * Fpath.t, id * file,
+     [< `Many | `One | `Zero > `One ]) 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 :
@@ -74,6 +93,7 @@ sig
     result : Builder.execution_result;
     console : (int * string) list;
     script : string;
+    main_binary : Fpath.t option;
     job_id : id;
   }
   module Meta :
@@ -83,6 +103,7 @@ sig
       start : Ptime.t;
       finish : Ptime.t;
       result : Builder.execution_result;
+      main_binary : Fpath.t option;
       job_id : id;
     }
   end
@@ -102,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

@@ -32,8 +32,8 @@ let read_file filepath =
 let build_artifact build filepath (module Db : CONN) =
   Db.find_opt Builder_db.Build_artifact.get_by_build_uuid (build, filepath)
   >>= function
-  | Some (localpath, sha256) ->
+  | Some (_id, file) ->
-    read_file localpath >|= fun data -> data, sha256
+    read_file file.Builder_db.localpath >|= fun data -> data, file.Builder_db.sha256
   | None ->
     Lwt.return_error `Not_found
 
@@ -49,8 +49,16 @@ let build_exists uuid (module Db : CONN) =
   Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
   Option.is_some
 
+let main_binary id main_binary (module Db : CONN) =
+  match main_binary with
+  | None -> Lwt_result.return None
+  | Some main_binary ->
+    Db.find Builder_db.Build_artifact.get_by_build (id, main_binary) >|= fun (_id, file) ->
+    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 () >|=
@@ -115,10 +123,28 @@ let add_build
   let open Builder_db in
   let job_name = job.Builder.name in
   save_all basedir 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
   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; job_id } >>= fun () ->
+                      console; script = job.Builder.script;
+                      main_binary; job_id } >>= fun () ->
   Db.find last_insert_rowid () >>= fun id ->
   List.fold_left
     (fun r file ->

lib/model.mli

@@ -14,8 +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 -> 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,22 +101,35 @@ let job name builds =
         txtf "Currently %d builds."
           (List.length builds)
       ];
-      ul (List.map (fun build ->
+      ul (List.map (fun (build, main_binary) ->
-          li [
+          li ([
-            a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid) ^ "/")]
+              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;
+                a ~a:[a_href Fpath.(to_string (v "build" / Uuidm.to_string build.Builder_db.Build.Meta.uuid
-              ];
+                                               / "f" // main_binary.Builder_db.filepath))]
-            txt " ";
+                  [txtf "%s" (Fpath.basename main_binary.Builder_db.filepath)];
-            check_icon build.result;
+                txt " ";
-          ])
+                code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct main_binary.Builder_db.sha256)];
+              ]
+            | None ->
+              [
+                txtf "Build failed";
+              ]))
           builds);
 
     ]
 
 let job_build
   name
-  { Builder_db.Build.uuid = _; start; finish; result; console; script; job_id = _ }
+  { Builder_db.Build.uuid = _; start; finish; result; console; script; main_binary = _; job_id = _ }
   artifacts
   =
   let ptime_pp = Ptime.pp_human () in