Link to opam diff

Compare with latest build as well as previous build.
This commit is contained in:
Reynir Björnsson 2021-04-23 15:00:12 +02:00
parent b965b3ca7c
commit 4f17b8b8a6
7 changed files with 63 additions and 7 deletions

View file

@ -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

View file

@ -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

View file

@ -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 =

View file

@ -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

View file

@ -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

View file

@ -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 } ->

View file

@ -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);