diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 41dacbb..02957a4 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -263,22 +263,27 @@ let routes t = Response.of_plain_text "Bad request" ~status:`Bad_request |> Lwt.return | Some build_left, Some build_right -> - let+ switch_left = + let+ r = Caqti_lwt.Pool.use (Model.build_artifact build_left (Fpath.v "opam-switch")) - t.pool - and+ switch_right = + t.pool >>= fun switch_left -> Caqti_lwt.Pool.use (Model.build_artifact build_right (Fpath.v "opam-switch")) - t.pool + t.pool >>= fun switch_right -> + Caqti_lwt.Pool.use (Model.build build_left) t.pool >>= fun (_id, build_left) -> + Caqti_lwt.Pool.use (Model.build build_right) t.pool >>= fun (_id, build_right) -> + Caqti_lwt.Pool.use (Model.job_name build_left.job_id) t.pool >>= fun job_left -> + Caqti_lwt.Pool.use (Model.job_name build_right.job_id) t.pool >>= fun job_right -> + Lwt_result.return (job_left, job_right, build_left, build_right, switch_left, switch_right) in - match switch_left, switch_right with - | Error e, _ | _, Error e -> - Log.warn (fun m -> m "Database error: %a" pp_error e); - Response.of_plain_text "Internal server error\n" ~status:`Internal_server_error - | Ok (switch_left, _sha256_left), Ok (switch_right, _sha256_right) -> + match r with + | Error e -> + Log.warn (fun m -> m "Database error: %a" pp_error e); + Response.of_plain_text "Internal server error\n" ~status:`Internal_server_error + | Ok (job_left, job_right, build_left, build_right, + (switch_left, _sha256_left), (switch_right, _sha256_right)) -> let switch_left = OpamFile.SwitchExport.read_from_string switch_left and switch_right = OpamFile.SwitchExport.read_from_string switch_right in Opamdiff.compare switch_left switch_right - |> Views.compare_opam build_left build_right + |> Views.compare_opam job_left job_right build_left build_right |> Response.of_html in diff --git a/lib/model.ml b/lib/model.ml index 5aaddaf..03b4b88 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -72,6 +72,9 @@ let job job (module Db : CONN) = let jobs (module Db : CONN) = Db.collect_list Builder_db.Job.get_all () +let job_name id (module Db : CONN) = + Db.find Builder_db.Job.get id + let user username (module Db : CONN) = Db.find_opt Builder_db.User.get_user username >|= Option.map snd diff --git a/lib/model.mli b/lib/model.mli index 6397519..e15c7e3 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -34,6 +34,9 @@ val job : string -> Caqti_lwt.connection -> val jobs : Caqti_lwt.connection -> ((Builder_db.id * string) list, [> error ]) result Lwt.t +val job_name : Builder_db.id -> Caqti_lwt.connection -> + (string, [> error ]) result Lwt.t + val user : string -> Caqti_lwt.connection -> (Builder_web_auth.scrypt Builder_web_auth.user_info option, [> error ]) result Lwt.t diff --git a/lib/views.ml b/lib/views.ml index 49226be..e443b20 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -226,14 +226,26 @@ let package_diffs diffs = ]) diffs -let compare_opam build_left build_right (same, opam_diff, version_diff, left, right) = +let compare_opam job_left job_right + (build_left : Builder_db.Build.t) (build_right : Builder_db.Build.t) + (same, opam_diff, version_diff, left, right) = layout ~title:(Fmt.strf "Comparing opam switches between builds %a and %a" - Uuidm.pp build_left Uuidm.pp build_right) + Uuidm.pp build_left.uuid Uuidm.pp build_right.uuid) [ h1 [txt "Comparing opam switches"]; h2 [ - txtf "Builds %a and %a" - Uuidm.pp build_left Uuidm.pp build_right + txt "Builds "; + a ~a:[a_href + (Fmt.strf "/job/%s/build/%a/" + job_left + Uuidm.pp build_left.uuid)] + [txtf "%a" Uuidm.pp build_left.uuid]; + txt " and "; + a ~a:[a_href + (Fmt.strf "/job/%s/build/%a/" + job_right + Uuidm.pp build_right.uuid)] + [txtf "%a" Uuidm.pp build_right.uuid]; ]; ul [ li [