Output links to comparisons of other builds with the identical main binary

in /job/:job/build/:build
This commit is contained in:
Robur 2021-07-06 10:23:29 +00:00
parent 9c326679ba
commit be26e56fd4
6 changed files with 43 additions and 28 deletions

View file

@ -443,6 +443,18 @@ module Build = struct
LIMIT 1
|}
let get_other_builds_with_same_output =
Caqti_request.collect
(id `build)
Meta.t
{| SELECT 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.user, b.job
FROM build b0, build_artifact a0, build b, build_artifact a
WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256 AND b.main_binary = a.id AND b.id <> b0.id
ORDER BY b.start_d DESC, b.start_ps DESC
|}
let add =
Caqti_request.exec
t

View file

@ -169,6 +169,8 @@ sig
val get_previous_successful :
([`build] id, [`build] id * Meta.t, [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t
val get_other_builds_with_same_output :
([`build] id, Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t
val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_by_hash :
(Cstruct.t, string * t, [< `Many | `One | `Zero > `One `Zero]) Caqti_request.t

View file

@ -137,14 +137,15 @@ let add_routes datadir =
(Dream.sql req (Model.readme job_name) >>= fun readme ->
Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts ->
Dream.sql req (Model.builds_with_same_main_binary build_id) >>= fun other_builds ->
Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid ->
Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build ->
(readme, build, artifacts, latest_uuid, previous_build))
(readme, build, artifacts, other_builds, latest_uuid, previous_build))
|> if_error "Error getting job build"
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
>>= fun (readme, build, artifacts, latest_uuid, previous_build) ->
Views.job_build job_name readme build artifacts latest_uuid previous_build |> string_of_html |> Dream.html
|> Lwt_result.ok
>>= fun (readme, build, artifacts, other_builds, latest_uuid, previous_build) ->
Views.job_build job_name readme build artifacts other_builds latest_uuid previous_build
|> string_of_html |> Dream.html |> Lwt_result.ok
in
let job_build_file req =

View file

@ -70,12 +70,8 @@ let previous_successful_build id (module Db : CONN) =
Db.find_opt Builder_db.Build.get_previous_successful id >|=
Option.map (fun (_id, meta) -> meta)
let main_binary id main_binary (module Db : CONN) =
match main_binary with
| None -> Lwt_result.return None
| Some main_binary ->
Db.find Builder_db.Build_artifact.get_by_build (id, main_binary) >|= fun (_id, file) ->
Some file
let builds_with_same_main_binary id (module Db : CONN) =
Db.collect_list Builder_db.Build.get_other_builds_with_same_output id
let job_id job_name (module Db : CONN) =
Db.find_opt Builder_db.Job.get_id_by_name job_name

View file

@ -39,8 +39,8 @@ val latest_successful_build_uuid : [`job] Builder_db.id -> Caqti_lwt.connection
val previous_successful_build : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.Meta.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val main_binary : [`build] Builder_db.id -> Fpath.t option -> Caqti_lwt.connection ->
(Builder_db.file option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val builds_with_same_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.Meta.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val readme : string -> Caqti_lwt.connection ->
(string option, [> error ]) result Lwt.t

View file

@ -194,6 +194,7 @@ let job_build
readme
{ Builder_db.Build.uuid; start; finish; result; console; script; _ }
artifacts
other_builds
latest_uuid
previous_build
=
@ -214,22 +215,25 @@ let job_build
a ~a:[a_href "#readme"] [txt "Back to readme"];
p [txtf "Build took %a." Ptime.Span.pp delta ];
p [txtf "Execution result: %a." Builder.pp_execution_result result];
(match latest_uuid with
| Some latest_uuid when successful_build && not (Uuidm.equal latest_uuid uuid) ->
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"];
]
| _ -> txt "");
(match previous_build with
| Some previous_build when successful_build ->
p [
a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
Uuidm.pp previous_build.Builder_db.Build.Meta.uuid Uuidm.pp uuid]
[txt "Compare opam-switch with previous build"];
]
| _ -> txt "");
h3 [txt "Compare with other builds"];
p
((match latest_uuid with
| Some latest_uuid when successful_build && not (Uuidm.equal latest_uuid uuid) ->
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
Uuidm.pp uuid Uuidm.pp latest_uuid]
[txt "With latest build"] ; br () ]
| _ -> []) @
(match previous_build with
| Some previous_build when successful_build ->
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
Uuidm.pp previous_build.Builder_db.Build.Meta.uuid Uuidm.pp uuid]
[txt "With previous build"] ; br () ]
| _ -> []) @
List.concat_map (fun { Builder_db.Build.Meta.start ; uuid = other_uuid ; _ } ->
[ a ~a:[Fmt.kstr a_href "/compare/%a/%a/opam-switch"
Uuidm.pp other_uuid Uuidm.pp uuid]
[txtf "With build %a (output is identical binary)" pp_ptime start] ; br () ])
other_builds);
h3 [txt "Digests of build artifacts"];
dl (List.concat_map
(fun { Builder_db.filepath; localpath=_; sha256; size } ->