Link to opam diff
Compare with latest build as well as previous build.
This commit is contained in:
parent
b965b3ca7c
commit
4f17b8b8a6
7 changed files with 63 additions and 7 deletions
|
@ -382,6 +382,17 @@ module Build = struct
|
||||||
LIMIT 1
|
LIMIT 1
|
||||||
|}
|
|}
|
||||||
|
|
||||||
|
let get_latest_uuid =
|
||||||
|
Caqti_request.find_opt
|
||||||
|
id
|
||||||
|
Caqti_type.(tup2 id Rep.uuid)
|
||||||
|
{| SELECT b.id, b.uuid
|
||||||
|
FROM build b
|
||||||
|
WHERE b.job = ?
|
||||||
|
ORDER BY start_d DESC, start_ps DESC
|
||||||
|
LIMIT 1
|
||||||
|
|}
|
||||||
|
|
||||||
let get_previous =
|
let get_previous =
|
||||||
Caqti_request.find_opt
|
Caqti_request.find_opt
|
||||||
id
|
id
|
||||||
|
|
|
@ -146,6 +146,9 @@ sig
|
||||||
val get_latest :
|
val get_latest :
|
||||||
(id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ])
|
(id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ])
|
||||||
Caqti_request.t
|
Caqti_request.t
|
||||||
|
val get_latest_uuid :
|
||||||
|
(id, id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ])
|
||||||
|
Caqti_request.t
|
||||||
val get_previous :
|
val get_previous :
|
||||||
(id, id * Meta.t, [< `Many | `One | `Zero > `One `Zero ])
|
(id, id * Meta.t, [< `Many | `One | `Zero > `One `Zero ])
|
||||||
Caqti_request.t
|
Caqti_request.t
|
||||||
|
|
|
@ -157,18 +157,20 @@ let routes t =
|
||||||
"Bad request.\n"
|
"Bad request.\n"
|
||||||
|> Lwt.return
|
|> Lwt.return
|
||||||
| Some uuid ->
|
| Some uuid ->
|
||||||
let+ build_and_artifacts =
|
let+ data =
|
||||||
Caqti_lwt.Pool.use (Model.build uuid) t.pool >>= fun (build_id, build) ->
|
Caqti_lwt.Pool.use (Model.build uuid) t.pool >>= fun (build_id, build) ->
|
||||||
Caqti_lwt.Pool.use (Model.build_artifacts build_id) t.pool >|= fun artifacts ->
|
Caqti_lwt.Pool.use (Model.build_artifacts build_id) t.pool >>= fun artifacts ->
|
||||||
(build, artifacts)
|
Caqti_lwt.Pool.use (Model.latest_build_uuid build.job_id) t.pool >>= fun latest_uuid ->
|
||||||
|
Caqti_lwt.Pool.use (Model.build_previous build_id) t.pool >|= fun previous_build ->
|
||||||
|
(build, artifacts, latest_uuid, previous_build)
|
||||||
in
|
in
|
||||||
match build_and_artifacts with
|
match data with
|
||||||
| Error e ->
|
| Error e ->
|
||||||
Log.warn (fun m -> m "Error getting job build: %a" pp_error e);
|
Log.warn (fun m -> m "Error getting job build: %a" pp_error e);
|
||||||
Response.of_plain_text ~status:`Internal_server_error
|
Response.of_plain_text ~status:`Internal_server_error
|
||||||
"Error getting job build"
|
"Error getting job build"
|
||||||
| Ok (build, artifacts) ->
|
| Ok (build, artifacts, latest_uuid, previous_build) ->
|
||||||
Views.job_build job_name build artifacts |> Response.of_html
|
Views.job_build job_name build artifacts latest_uuid previous_build |> Response.of_html
|
||||||
in
|
in
|
||||||
|
|
||||||
let job_build_file req =
|
let job_build_file req =
|
||||||
|
|
|
@ -58,6 +58,15 @@ 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
|
||||||
|
|
||||||
|
let latest_build_uuid job_id (module Db : CONN) =
|
||||||
|
Db.find_opt Builder_db.Build.get_latest_uuid job_id >>=
|
||||||
|
(* We know there's at least one job when this is called, probably. *)
|
||||||
|
not_found >|= snd
|
||||||
|
|
||||||
|
let build_previous id (module Db : CONN) =
|
||||||
|
Db.find_opt Builder_db.Build.get_previous id >|=
|
||||||
|
Option.map (fun (_id, meta) -> meta)
|
||||||
|
|
||||||
let main_binary id main_binary (module Db : CONN) =
|
let main_binary id main_binary (module Db : CONN) =
|
||||||
match main_binary with
|
match main_binary with
|
||||||
| None -> Lwt_result.return None
|
| None -> Lwt_result.return None
|
||||||
|
|
|
@ -25,6 +25,12 @@ val build_hash : Cstruct.t -> Caqti_lwt.connection ->
|
||||||
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
|
||||||
|
|
||||||
|
val latest_build_uuid : Builder_db.id -> Caqti_lwt.connection ->
|
||||||
|
(Uuidm.t, [> error ]) result Lwt.t
|
||||||
|
|
||||||
|
val build_previous : Builder_db.id -> Caqti_lwt.connection ->
|
||||||
|
(Builder_db.Build.Meta.t option, [> error ]) result Lwt.t
|
||||||
|
|
||||||
val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
|
val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
|
||||||
(Builder_db.file option, [> error ]) result Lwt.t
|
(Builder_db.file option, [> error ]) result Lwt.t
|
||||||
|
|
||||||
|
|
18
lib/views.ml
18
lib/views.ml
|
@ -168,14 +168,30 @@ let job name builds =
|
||||||
|
|
||||||
let job_build
|
let job_build
|
||||||
name
|
name
|
||||||
{ Builder_db.Build.uuid = _; start; finish; result; console; script; main_binary = _; job_id = _ }
|
{ Builder_db.Build.uuid; start; finish; result; console; script; main_binary = _; job_id = _ }
|
||||||
artifacts
|
artifacts
|
||||||
|
latest_uuid
|
||||||
|
previous_build
|
||||||
=
|
=
|
||||||
let delta = Ptime.diff finish start in
|
let delta = Ptime.diff finish start in
|
||||||
layout ~title:(Fmt.strf "Job build %s %a" name pp_ptime start)
|
layout ~title:(Fmt.strf "Job build %s %a" name pp_ptime start)
|
||||||
[ h1 [txtf "Job build %s %a" name pp_ptime start];
|
[ h1 [txtf "Job build %s %a" name pp_ptime start];
|
||||||
p [txtf "Build took %a." Ptime.Span.pp delta ];
|
p [txtf "Build took %a." Ptime.Span.pp delta ];
|
||||||
p [txtf "Execution result: %a." Builder.pp_execution_result result];
|
p [txtf "Execution result: %a." Builder.pp_execution_result result];
|
||||||
|
p [
|
||||||
|
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||||
|
Uuidm.pp uuid Uuidm.pp latest_uuid]
|
||||||
|
[txt "Compare opam-switch with latest build"];
|
||||||
|
];
|
||||||
|
(match previous_build with
|
||||||
|
| Some previous_build ->
|
||||||
|
p [
|
||||||
|
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
|
||||||
|
Uuidm.pp uuid Uuidm.pp previous_build.Builder_db.Build.Meta.uuid]
|
||||||
|
[txt "Compare opam-switch with previous build"];
|
||||||
|
]
|
||||||
|
| None ->
|
||||||
|
txt "");
|
||||||
h3 [txt "Digests of build artifacts"];
|
h3 [txt "Digests of build artifacts"];
|
||||||
dl (List.concat_map
|
dl (List.concat_map
|
||||||
(fun { Builder_db.filepath; localpath=_; sha256; size } ->
|
(fun { Builder_db.filepath; localpath=_; sha256; size } ->
|
||||||
|
|
|
@ -233,6 +233,14 @@ let test_build_get_latest (module Db : CONN) =
|
||||||
Alcotest.(check (option Testable.file)) "same main binary" main_binary' (Some main_binary);
|
Alcotest.(check (option Testable.file)) "same main binary" main_binary' (Some main_binary);
|
||||||
Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid'
|
Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid'
|
||||||
|
|
||||||
|
let test_build_get_latest_uuid (module Db : CONN) =
|
||||||
|
add_second_build (module Db) >>= fun () ->
|
||||||
|
(* Test *)
|
||||||
|
Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id ->
|
||||||
|
Db.find_opt Builder_db.Build.get_latest_uuid job_id
|
||||||
|
>>| get_opt "no latest build" >>| fun (_id, latest_uuid) ->
|
||||||
|
Alcotest.(check Testable.uuid) "same uuid" latest_uuid uuid'
|
||||||
|
|
||||||
let test_build_get_previous (module Db : CONN) =
|
let test_build_get_previous (module Db : CONN) =
|
||||||
add_second_build (module Db) >>= fun () ->
|
add_second_build (module Db) >>= fun () ->
|
||||||
Db.find_opt Builder_db.Build.get_by_uuid uuid'
|
Db.find_opt Builder_db.Build.get_by_uuid uuid'
|
||||||
|
@ -308,6 +316,7 @@ let () =
|
||||||
test_case "One build" `Quick (with_build_db test_build_get_all);
|
test_case "One build" `Quick (with_build_db test_build_get_all);
|
||||||
test_case "One build (meta data)" `Quick (with_build_db test_build_get_all_meta);
|
test_case "One build (meta data)" `Quick (with_build_db test_build_get_all_meta);
|
||||||
test_case "Get latest build" `Quick (with_build_db test_build_get_latest);
|
test_case "Get latest build" `Quick (with_build_db test_build_get_latest);
|
||||||
|
test_case "Get latest build uuid" `Quick (with_build_db test_build_get_latest_uuid);
|
||||||
test_case "Get build by hash" `Quick (with_build_db test_build_get_by_hash);
|
test_case "Get build by hash" `Quick (with_build_db test_build_get_by_hash);
|
||||||
test_case "Get previous build" `Quick (with_build_db test_build_get_previous);
|
test_case "Get previous build" `Quick (with_build_db test_build_get_previous);
|
||||||
test_case "Get previous build when first" `Quick (with_build_db test_build_get_previous_none);
|
test_case "Get previous build when first" `Quick (with_build_db test_build_get_previous_none);
|
||||||
|
|
Loading…
Reference in a new issue