diff --git a/db/builder_db.ml b/db/builder_db.ml index c6203d7..3b89207 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -382,6 +382,17 @@ module Build = struct 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 = Caqti_request.find_opt id diff --git a/db/builder_db.mli b/db/builder_db.mli index 309e2c4..2e1428f 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -146,6 +146,9 @@ sig val get_latest : (id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t + val get_latest_uuid : + (id, id * Uuidm.t, [< `Many | `One | `Zero > `One `Zero ]) + Caqti_request.t val get_previous : (id, id * Meta.t, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 02957a4..7528dcd 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -157,18 +157,20 @@ let routes t = "Bad request.\n" |> Lwt.return | 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_artifacts build_id) t.pool >|= fun artifacts -> - (build, artifacts) + Caqti_lwt.Pool.use (Model.build_artifacts build_id) t.pool >>= fun 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 - match build_and_artifacts with + match data with | Error e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e); Response.of_plain_text ~status:`Internal_server_error "Error getting job build" - | Ok (build, artifacts) -> - Views.job_build job_name build artifacts |> Response.of_html + | Ok (build, artifacts, latest_uuid, previous_build) -> + Views.job_build job_name build artifacts latest_uuid previous_build |> Response.of_html in let job_build_file req = diff --git a/lib/model.ml b/lib/model.ml index 03b4b88..29492d7 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -58,6 +58,15 @@ let build_exists uuid (module Db : CONN) = Db.find_opt Builder_db.Build.get_by_uuid uuid >|= 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) = match main_binary with | None -> Lwt_result.return None diff --git a/lib/model.mli b/lib/model.mli index e15c7e3..c64b3c0 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -25,6 +25,12 @@ val build_hash : Cstruct.t -> Caqti_lwt.connection -> val build_exists : Uuidm.t -> Caqti_lwt.connection -> (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 -> (Builder_db.file option, [> error ]) result Lwt.t diff --git a/lib/views.ml b/lib/views.ml index fc33b76..e610c23 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -168,14 +168,30 @@ let job name builds = let job_build 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 + latest_uuid + previous_build = let delta = Ptime.diff finish start 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 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"]; dl (List.concat_map (fun { Builder_db.filepath; localpath=_; sha256; size } -> diff --git a/test/builder_db.ml b/test/builder_db.ml index 18d3333..b703567 100644 --- a/test/builder_db.ml +++ b/test/builder_db.ml @@ -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 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) = add_second_build (module Db) >>= fun () -> 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 (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 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 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);