From be26e56fd4fb82b9dfb769a15d3fecf75b0af33b Mon Sep 17 00:00:00 2001 From: Robur Date: Tue, 6 Jul 2021 10:23:29 +0000 Subject: [PATCH] Output links to comparisons of other builds with the identical main binary in /job/:job/build/:build --- db/builder_db.ml | 12 ++++++++++++ db/builder_db.mli | 2 ++ lib/builder_web.ml | 9 +++++---- lib/model.ml | 8 ++------ lib/model.mli | 4 ++-- lib/views.ml | 36 ++++++++++++++++++++---------------- 6 files changed, 43 insertions(+), 28 deletions(-) diff --git a/db/builder_db.ml b/db/builder_db.ml index 257e165..f78426f 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -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 diff --git a/db/builder_db.mli b/db/builder_db.mli index d893d48..3ee9c6e 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -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 diff --git a/lib/builder_web.ml b/lib/builder_web.ml index b9806a9..6df7f41 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -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 = diff --git a/lib/model.ml b/lib/model.ml index f108465..b7cceca 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -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 diff --git a/lib/model.mli b/lib/model.mli index 13d8adc..1a45432 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -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 diff --git a/lib/views.ml b/lib/views.ml index 51c36e3..71cffb9 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -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 } ->