diff --git a/db/builder_db.ml b/db/builder_db.ml index 7ebdcda..def2a8b 100644 --- a/db/builder_db.ml +++ b/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 |} diff --git a/db/builder_db.mli b/db/builder_db.mli index f07d714..6745394 100644 --- a/db/builder_db.mli +++ b/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 diff --git a/db/representation.ml b/db/representation.ml index d1809ff..482339f 100644 --- a/db/representation.ml +++ b/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) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 1037c1f..ed74ad2 100644 --- a/lib/builder_web.ml +++ b/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 = diff --git a/lib/model.ml b/lib/model.ml index c19545b..5a1becf 100644 --- a/lib/model.ml +++ b/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 () >|= diff --git a/lib/model.mli b/lib/model.mli index f9e0aa1..f8b01a4 100644 --- a/lib/model.mli +++ b/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 diff --git a/lib/views.ml b/lib/views.ml index 95d816a..00340b1 100644 --- a/lib/views.ml +++ b/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); ]