From 3a106342f563fff8bdd0a6b31be9cf68965b3685 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 29 Jan 2021 14:34:56 +0100 Subject: [PATCH] Show latest build info in jobs view This does N+1 queries where N is the number of jobs. --- db/builder_db.ml | 19 +++++++++++++++++++ db/builder_db.mli | 3 +++ lib/builder_web.ml | 25 ++++++++++++++++++++++--- lib/model.ml | 7 +++++-- lib/model.mli | 5 ++++- lib/views.ml | 34 ++++++++++++++++++++++++++++------ 6 files changed, 81 insertions(+), 12 deletions(-) diff --git a/db/builder_db.ml b/db/builder_db.ml index 5187e45..dd98074 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -358,6 +358,25 @@ module Build = struct ORDER BY start_d DESC, start_ps DESC |} + let get_latest = + Caqti_request.find_opt + id + Caqti_type.(tup3 + id + Meta.t + file_opt) + {| SELECT b.id, + 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 + FROM build b + LEFT JOIN build_artifact a ON + a.build = b.id AND b.main_binary = a.filepath + WHERE b.job = ? + ORDER BY start_d DESC, start_ps DESC + LIMIT 1 + |} let add = Caqti_request.exec diff --git a/db/builder_db.mli b/db/builder_db.mli index 6745394..68d1a3a 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -124,6 +124,9 @@ sig (id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t val get_all_meta_by_name : (string, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t + val get_latest : + (id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ]) + Caqti_request.t val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t end diff --git a/lib/builder_web.ml b/lib/builder_web.ml index ed74ad2..e971a37 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -73,15 +73,34 @@ let authorized t handler = fun req -> let routes t = let builder _req = - let+ jobs = Caqti_lwt.Pool.use Model.jobs t.pool in + let* jobs = Caqti_lwt.Pool.use Model.jobs t.pool in match jobs with | Error e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e); Response.of_plain_text ~status:`Internal_server_error "Error getting jobs" + |> Lwt.return | Ok jobs -> - List.sort String.compare jobs - |> Views.builder |> Response.of_html + let+ jobs = + List.fold_right + (fun (job_id, job_name) r -> + r >>= fun acc -> + Caqti_lwt.Pool.use (Model.build_meta job_id) t.pool >>= function + | Some (latest_build, latest_artifact) -> + Lwt_result.return ((job_name, latest_build, latest_artifact) :: acc) + | None -> + Log.warn (fun m -> m "Job without builds: %s" job_name); + Lwt_result.return acc) + jobs + (Lwt_result.return []) + in + match jobs with + | Error e -> + Log.warn (fun m -> m "Error getting jobs: %a" pp_error e); + Response.of_plain_text ~status:`Internal_server_error + "Error getting jobs" + | Ok jobs -> + Views.builder jobs |> Response.of_html in let job req = diff --git a/lib/model.ml b/lib/model.ml index 80db6d0..2a58045 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -45,6 +45,10 @@ let build uuid (module Db : CONN) = Db.find_opt Builder_db.Build.get_by_uuid uuid >>= not_found +let build_meta job (module Db : CONN) = + Db.find_opt Builder_db.Build.get_latest job >|= + Option.map (fun (_id, meta, file) -> (meta, file)) + let build_exists uuid (module Db : CONN) = Db.find_opt Builder_db.Build.get_by_uuid uuid >|= Option.is_some @@ -61,8 +65,7 @@ let job job (module Db : CONN) = List.map (fun (_id, meta, main_binary) -> (meta, main_binary)) let jobs (module Db : CONN) = - Db.collect_list Builder_db.Job.get_all () >|= - List.map snd + Db.collect_list Builder_db.Job.get_all () let user username (module Db : CONN) = Db.find_opt Builder_db.User.get_user username >|= diff --git a/lib/model.mli b/lib/model.mli index f8b01a4..d7408c1 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -11,6 +11,9 @@ val build_artifacts : Builder_db.id -> Caqti_lwt.connection -> val build : Uuidm.t -> Caqti_lwt.connection -> (Builder_db.id * Builder_db.Build.t, [> error ]) result Lwt.t +val build_meta : Builder_db.id -> Caqti_lwt.connection -> + ((Builder_db.Build.Meta.t * Builder_db.file option) option, [> error ]) result Lwt.t + val build_exists : Uuidm.t -> Caqti_lwt.connection -> (bool, [> error ]) result Lwt.t @@ -21,7 +24,7 @@ val job : string -> Caqti_lwt.connection -> ((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 + ((Builder_db.id * string) list, [> error ]) result Lwt.t val user : string -> Caqti_lwt.connection -> (Builder_web_auth.user_info option, [> error ]) result Lwt.t diff --git a/lib/views.ml b/lib/views.ml index 00340b1..bd5dde8 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -86,12 +86,34 @@ let builder jobs = txtf "We have currently %d jobs." (List.length jobs); ]; - ul (List.map (fun job -> - li [ - a ~a:[a_href ("job/" ^ job ^ "/")] - [txt job]; - ]) - jobs); + ul (List.map (fun (job_name, latest_build, latest_artifact) -> + li ([ + a ~a:[a_href ("job/" ^ job_name ^ "/")] + [txt job_name]; + txt " "; + check_icon latest_build.Builder_db.Build.Meta.result; + br (); + a ~a:[a_href (Fmt.strf "job/%s/build/%a/" job_name Uuidm.pp + latest_build.Builder_db.Build.Meta.uuid)] + [txtf "%a" (Ptime.pp_human ()) latest_build.Builder_db.Build.Meta.start]; + txt " "; + ] @ match latest_artifact with + | Some main_binary -> + [ + a ~a:[a_href (Fmt.strf + "job/%s/build/%a/f/%a" + job_name + Uuidm.pp latest_build.Builder_db.Build.Meta.uuid + Fpath.pp 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"; + ])) + jobs); ] let job name builds =