Show latest build info in jobs view

This does N+1 queries where N is the number of jobs.
This commit is contained in:
Reynir Björnsson 2021-01-29 14:34:56 +01:00
parent 1dce5eeda3
commit 3a106342f5
6 changed files with 81 additions and 12 deletions

View file

@ -358,6 +358,25 @@ module Build = struct
ORDER BY start_d DESC, start_ps DESC 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 = let add =
Caqti_request.exec Caqti_request.exec

View file

@ -124,6 +124,9 @@ sig
(id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t (id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_meta_by_name : val get_all_meta_by_name :
(string, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t (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 val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
end end

View file

@ -73,15 +73,34 @@ let authorized t handler = fun req ->
let routes t = let routes t =
let builder _req = 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 match jobs with
| Error e -> | Error e ->
Log.warn (fun m -> m "Error getting jobs: %a" pp_error e); Log.warn (fun m -> m "Error getting jobs: %a" pp_error e);
Response.of_plain_text ~status:`Internal_server_error Response.of_plain_text ~status:`Internal_server_error
"Error getting jobs" "Error getting jobs"
|> Lwt.return
| Ok jobs -> | Ok jobs ->
List.sort String.compare jobs let+ jobs =
|> Views.builder |> Response.of_html 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 in
let job req = let job req =

View file

@ -45,6 +45,10 @@ let build uuid (module Db : CONN) =
Db.find_opt Builder_db.Build.get_by_uuid uuid >>= Db.find_opt Builder_db.Build.get_by_uuid uuid >>=
not_found 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) = let build_exists uuid (module Db : CONN) =
Db.find_opt Builder_db.Build.get_by_uuid uuid >|= Db.find_opt Builder_db.Build.get_by_uuid uuid >|=
Option.is_some Option.is_some
@ -61,8 +65,7 @@ let job job (module Db : CONN) =
List.map (fun (_id, meta, main_binary) -> (meta, main_binary)) List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
let jobs (module Db : CONN) = let jobs (module Db : CONN) =
Db.collect_list Builder_db.Job.get_all () >|= Db.collect_list Builder_db.Job.get_all ()
List.map snd
let user username (module Db : CONN) = let user username (module Db : CONN) =
Db.find_opt Builder_db.User.get_user username >|= Db.find_opt Builder_db.User.get_user username >|=

View file

@ -11,6 +11,9 @@ val build_artifacts : Builder_db.id -> Caqti_lwt.connection ->
val build : Uuidm.t -> Caqti_lwt.connection -> val build : Uuidm.t -> Caqti_lwt.connection ->
(Builder_db.id * Builder_db.Build.t, [> error ]) result Lwt.t (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 -> val build_exists : Uuidm.t -> Caqti_lwt.connection ->
(bool, [> error ]) result Lwt.t (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 ((Builder_db.Build.Meta.t * Builder_db.file option) list, [> error ]) result Lwt.t
val jobs : Caqti_lwt.connection -> 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 -> val user : string -> Caqti_lwt.connection ->
(Builder_web_auth.user_info option, [> error ]) result Lwt.t (Builder_web_auth.user_info option, [> error ]) result Lwt.t

View file

@ -86,12 +86,34 @@ let builder jobs =
txtf "We have currently %d jobs." txtf "We have currently %d jobs."
(List.length jobs); (List.length jobs);
]; ];
ul (List.map (fun job -> ul (List.map (fun (job_name, latest_build, latest_artifact) ->
li [ li ([
a ~a:[a_href ("job/" ^ job ^ "/")] a ~a:[a_href ("job/" ^ job_name ^ "/")]
[txt job]; [txt job_name];
]) txt " ";
jobs); 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 = let job name builds =