From a45a5848314862379d37352ece1d38b80889bb43 Mon Sep 17 00:00:00 2001 From: Robur Date: Wed, 2 Jun 2021 13:05:10 +0000 Subject: [PATCH] Generate opam compare links only for successful builds --- db/builder_db.ml | 5 +++-- db/builder_db.mli | 4 ++-- lib/builder_web.ml | 10 +++++++--- lib/model.ml | 12 +++++++----- lib/model.mli | 11 ++++++++--- lib/views.ml | 19 +++++++++++-------- test/builder_db.ml | 4 ++-- 7 files changed, 40 insertions(+), 25 deletions(-) diff --git a/db/builder_db.ml b/db/builder_db.ml index 34b54e5..146e4a0 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -395,7 +395,7 @@ module Build = struct |} let get_latest_successful_uuid = - Caqti_request.find + Caqti_request.find_opt id Rep.uuid {| SELECT b.uuid @@ -405,7 +405,7 @@ module Build = struct LIMIT 1 |} - let get_previous = + let get_previous_successful = Caqti_request.find_opt id Caqti_type.(tup2 id Meta.t) @@ -415,6 +415,7 @@ module Build = struct b.main_binary, b.job FROM build b, build b0 WHERE b0.id = ? AND b0.job = b.job AND + b.result_kind = 0 AND b.result_code = 0 AND (b0.start_d > b.start_d OR b0.start_d = b.start_d AND b0.start_ps > b.start_ps) ORDER BY b.start_d DESC, b.start_ps DESC LIMIT 1 diff --git a/db/builder_db.mli b/db/builder_db.mli index 892d3c4..d59a6b2 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -150,9 +150,9 @@ sig (id, id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_latest_successful_uuid : - (id, Uuidm.t, [< `Many | `One | `Zero > `One ]) + (id, Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t - val get_previous : + val get_previous_successful : (id, id * Meta.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val add : (t, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 9a6d2ab..9486102 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -142,7 +142,11 @@ let add_routes datadir = let redirect_latest req = let job_name = Dream.param "job" req in let path = Dream.path req |> String.concat "/" in - let* build = Dream.sql req (Model.latest_successful_build_uuid job_name) in + let* build = + Dream.sql req (Model.job_id job_name) >>= fun job_id -> + Dream.sql req (Model.latest_successful_build_uuid job_id) + >>= Model.not_found + in match build with | Error e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e); @@ -162,8 +166,8 @@ let add_routes datadir = let* data = Dream.sql req (Model.build uuid) >>= fun (build_id, build) -> Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts -> - Dream.sql req (Model.latest_build_uuid build.job_id) >>= fun latest_uuid -> - Dream.sql req (Model.build_previous build_id) >|= fun previous_build -> + 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 -> (build, artifacts, latest_uuid, previous_build) in match data with diff --git a/lib/model.ml b/lib/model.ml index 32de2dc..16329bb 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -64,12 +64,11 @@ let latest_build_uuid job_id (module Db : CONN) = (* We know there's at least one job when this is called, probably. *) not_found >|= snd -let latest_successful_build_uuid job_name (module Db : CONN) = - Db.find Builder_db.Job.get_id_by_name job_name >>= fun job_id -> - Db.find Builder_db.Build.get_latest_successful_uuid job_id +let latest_successful_build_uuid job_id (module Db : CONN) = + Db.find_opt Builder_db.Build.get_latest_successful_uuid job_id -let build_previous id (module Db : CONN) = - Db.find_opt Builder_db.Build.get_previous id >|= +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) = @@ -83,6 +82,9 @@ let job job (module Db : CONN) = Db.collect_list Builder_db.Build.get_all_meta_by_name job >|= List.map (fun (_id, meta, main_binary) -> (meta, main_binary)) +let job_id job_name (module Db : CONN) = + Db.find Builder_db.Job.get_id_by_name job_name + let jobs (module Db : CONN) = Db.collect_list Builder_db.Job.get_all () diff --git a/lib/model.mli b/lib/model.mli index c67bcf5..29d7e0b 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -2,6 +2,8 @@ type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath. val pp_error : Format.formatter -> error -> unit +val not_found : 'a option -> ('a, [> error ]) result Lwt.t + val staging : Fpath.t -> Fpath.t val cleanup_staging : Fpath.t -> Caqti_lwt.connection -> @@ -28,10 +30,10 @@ val build_exists : Uuidm.t -> Caqti_lwt.connection -> val latest_build_uuid : Builder_db.id -> Caqti_lwt.connection -> (Uuidm.t, [> error ]) result Lwt.t -val latest_successful_build_uuid : string -> Caqti_lwt.connection -> - (Uuidm.t, [> Caqti_error.call_or_retrieve ]) result Lwt.t +val latest_successful_build_uuid : Builder_db.id -> Caqti_lwt.connection -> + (Uuidm.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t -val build_previous : Builder_db.id -> Caqti_lwt.connection -> +val previous_successful_build : Builder_db.id -> Caqti_lwt.connection -> (Builder_db.Build.Meta.t option, [> Caqti_error.call_or_retrieve ]) result Lwt.t val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection -> @@ -40,6 +42,9 @@ val main_binary : Builder_db.id -> Fpath.t option -> Caqti_lwt.connection -> val job : string -> Caqti_lwt.connection -> ((Builder_db.Build.Meta.t * Builder_db.file option) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t +val job_id : string -> Caqti_lwt.connection -> + (Builder_db.id, [> Caqti_error.call_or_retrieve ]) result Lwt.t + val jobs : Caqti_lwt.connection -> ((Builder_db.id * string) list, [> Caqti_error.call_or_retrieve ]) result Lwt.t diff --git a/lib/views.ml b/lib/views.ml index e610c23..7fa8e73 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -174,24 +174,27 @@ let job_build previous_build = let delta = Ptime.diff finish start in + let successful_build = match result with Builder.Exited 0 -> true | _ -> false in layout ~title:(Fmt.strf "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 "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 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 -> + | Some previous_build when successful_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 ""); + | _ -> txt ""); h3 [txt "Digests of build artifacts"]; dl (List.concat_map (fun { Builder_db.filepath; localpath=_; sha256; size } -> diff --git a/test/builder_db.ml b/test/builder_db.ml index dde876e..892afe2 100644 --- a/test/builder_db.ml +++ b/test/builder_db.ml @@ -249,14 +249,14 @@ let test_build_get_previous (module Db : CONN) = add_second_build (module Db) >>= fun () -> Db.find_opt Builder_db.Build.get_by_uuid uuid' >>| get_opt "no build" >>= fun (id, _build) -> - Db.find_opt Builder_db.Build.get_previous id + Db.find_opt Builder_db.Build.get_previous_successful id >>| get_opt "no previous build" >>| fun (_id, meta) -> Alcotest.(check Testable.uuid) "same uuid" meta.uuid uuid let test_build_get_previous_none (module Db : CONN) = Db.find_opt Builder_db.Build.get_by_uuid uuid >>| get_opt "no build" >>= fun (id, _build) -> - Db.find_opt Builder_db.Build.get_previous id >>| function + Db.find_opt Builder_db.Build.get_previous_successful id >>| function | None -> () | Some (_id, meta) -> Alcotest.failf "Got unexpected result %a" Uuidm.pp meta.uuid