From 8fb99041ba3796e6d124ec8e54a6943873c3d45e Mon Sep 17 00:00:00 2001 From: PizieDust Date: Fri, 20 Dec 2024 07:01:40 +0100 Subject: [PATCH] return json for comparison of two builds when header has accept json --- lib/builder_web.ml | 74 ++++++++++++++++++++++++++++++++++++------- lib/utils.ml | 21 ++++++++++++ opamdiff/opamdiff.ml | 52 ++++++++++++++++++++++++++++++ opamdiff/opamdiff.mli | 5 ++- 4 files changed, 139 insertions(+), 13 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index eb7a5b6..8a7436d 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -546,7 +546,20 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = |> Lwt_result.ok in - let compare_builds req = + + let resolve_artifact id_opt conn = + let default_file : Builder_db.file = { + filepath = Fpath.v "null"; + sha256 = "0"; + size = -1; + } in + match id_opt with + | None -> Lwt.return_ok default_file + | Some id -> Model.build_artifact_by_id id conn + + in + + let process_comparison req = let build_left = Dream.param req "build_left" in let build_right = Dream.param req "build_right" in get_uuid build_left >>= fun build_left -> @@ -566,14 +579,16 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = Model.build_artifact_data datadir >>= fun build_env_right -> Model.build_artifact build_right.Builder_db.Build.uuid (Fpath.v "system-packages") conn >>= Model.build_artifact_data datadir >>= fun system_packages_right -> + resolve_artifact build_left.Builder_db.Build.main_binary conn >>= fun build_left_file -> + resolve_artifact build_right.Builder_db.Build.main_binary conn >>= fun build_right_file -> Model.job_name build_left.job_id conn >>= fun job_left -> Model.job_name build_right.job_id conn >|= fun job_right -> - (job_left, job_right, build_left, build_right, - switch_left, build_env_left, system_packages_left, + (job_left, job_right, build_left, build_right, build_left_file, + build_right_file, switch_left, build_env_left, system_packages_left, switch_right, build_env_right, system_packages_right)) |> if_error "Internal server error" - >>= fun (job_left, job_right, build_left, build_right, - switch_left, build_env_left, system_packages_left, + >>= fun (job_left, job_right, build_left, build_right, build_left_file, + build_right_file, switch_left, build_env_left, system_packages_left, switch_right, build_env_right, system_packages_right) -> let env_diff = Utils.compare_env build_env_left build_env_right and pkg_diff = Utils.compare_pkgs system_packages_left system_packages_right @@ -581,15 +596,50 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = let switch_left = OpamFile.SwitchExport.read_from_string switch_left and switch_right = OpamFile.SwitchExport.read_from_string switch_right in let opam_diff = Opamdiff.compare switch_left switch_right in - Views.compare_builds - ~job_left ~job_right - ~build_left ~build_right - ~env_diff - ~pkg_diff - ~opam_diff - |> string_of_html |> Dream.html |> Lwt_result.ok + (job_left, job_right, build_left, build_right, build_left_file, build_right_file, env_diff, pkg_diff, opam_diff) + |> Lwt.return_ok + in + let compare_builds req = + process_comparison req >>= fun + (job_left, job_right, build_left, build_right, build_left_file, build_right_file, env_diff, pkg_diff, opam_diff) -> + match Dream.header req "Accept" with + | Some accept when String.starts_with ~prefix:"application/json" accept -> + let json_response = + `Assoc [ + "left", `Assoc [ + "job", `String job_left; + "build", `String (Uuidm.to_string build_left.uuid); + "platform", `String build_left.platform; + "build_start_time", `String (Ptime.to_rfc3339 build_left.start); + "build_finish_time", `String (Ptime.to_rfc3339 build_left.finish); + "build_size", `Int (build_left_file.size) + ]; + "right", `Assoc [ + "job", `String job_right; + "build", `String (Uuidm.to_string build_right.uuid); + "platform", `String build_right.platform; + "build_start_time", `String (Ptime.to_rfc3339 build_right.start); + "build_finish_time", `String (Ptime.to_rfc3339 build_right.finish); + "build_size", `Int (build_right_file.size) + ]; + "env_diff", Utils.diff_map_to_json env_diff; + "package_diff", Utils.diff_map_to_json pkg_diff; + "opam_diff", Opamdiff.compare_to_json opam_diff + ] |> Yojson.Basic.to_string + in + Dream.json ~status:`OK json_response |> Lwt_result.ok + | _ -> + Views.compare_builds + ~job_left ~job_right + ~build_left ~build_right + ~env_diff + ~pkg_diff + ~opam_diff + |> string_of_html |> Dream.html |> Lwt_result.ok + in + let upload_binary req = let job = Dream.param req "job" in let platform = Dream.param req "platform" in diff --git a/lib/utils.ml b/lib/utils.ml index 9802ec9..76f7031 100644 --- a/lib/utils.ml +++ b/lib/utils.ml @@ -6,6 +6,27 @@ module String_map = struct update key (function None -> Some [ v ] | Some xs -> Some (v :: xs)) t end +let diff_map_to_json (left, right, different_versions) = + let convert_list lst = + `List (List.map (fun (name, version) -> + `Assoc [("name", `String name); ("version", `String version)] + ) lst) + in + let convert_diff_versions lst = + `List (List.map (fun (name, version1, version2) -> + `Assoc [ + ("name", `String name); + ("version_in_left", `String version1); + ("version_in_right", `String version2) + ] + ) lst) + in + `Assoc [ + ("left_packages", convert_list left); + ("right_packages", convert_list right); + ("different_versions", convert_diff_versions different_versions) + ] + let diff_map a b = let diff a b = String_map.fold (fun k v acc -> diff --git a/opamdiff/opamdiff.ml b/opamdiff/opamdiff.ml index c0f953d..059af95 100644 --- a/opamdiff/opamdiff.ml +++ b/opamdiff/opamdiff.ml @@ -275,3 +275,55 @@ let compare left right = | Error _ as e, _ | _, (Error _ as e) -> e in (opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_ret) + + let compare_to_json + (opam_diff, version_diff, left_pkgs, right_pkgs, duniverse_diff) : Yojson.Basic.t = + let version_diff_to_json lst = + `List (List.map (fun { name; version_left; version_right } -> + `Assoc [ + ("name", `String (OpamPackage.Name.to_string name)); + ("version_left", `String (OpamPackage.Version.to_string version_left)); + ("version_right", `String (OpamPackage.Version.to_string version_right)) + ] + ) lst) + in + let package_set_to_json set = + `List (Set.fold (fun p acc -> + let json = `Assoc [ + ("name", `String (OpamPackage.Name.to_string p.OpamPackage.name)); + ("version", `String (OpamPackage.Version.to_string p.OpamPackage.version)) + ] in + json :: acc + ) set []) + in + let opam_diff_to_json opam_diff = + `List (List.map (fun (diff : opam_diff) -> + `Assoc [ + + ("package_version", `String (OpamPackage.to_string diff.pkg)); + ("otherwise_equal", `Bool diff.otherwise_equal) + ] + + ) opam_diff) + in + let duniverse_to_json = function + | Ok (left, right, detailed_diff) -> + `Assoc [ + ("left", `List (List.map (fun (k, v) -> `Assoc [("name", `String k); ("value", `String v)]) left)); + ("right", `List (List.map (fun (k, v) -> `Assoc [("name", `String k); ("value", `String v)]) right)); + ("detailed_diff",`List (List.map (fun (diff : duniverse_diff) -> + `Assoc [ + ("name", `String diff.name); + ]) detailed_diff)) + ] + + | Error (`Msg msg) -> + `String msg + in + `Assoc [ + ("opam_diff", opam_diff_to_json opam_diff); + ("version_diff", version_diff_to_json version_diff); + ("only_in_left", package_set_to_json left_pkgs); + ("only_in_right", package_set_to_json right_pkgs); + ("duniverse_diff", duniverse_to_json duniverse_diff) + ] diff --git a/opamdiff/opamdiff.mli b/opamdiff/opamdiff.mli index 352ede2..fa1bf3d 100644 --- a/opamdiff/opamdiff.mli +++ b/opamdiff/opamdiff.mli @@ -33,7 +33,10 @@ val commands_to_strings : OpamTypes.command list * OpamTypes.command list -> str val opt_url_to_string : OpamFile.URL.t option * OpamFile.URL.t option -> string * string -val compare: OpamFile.SwitchExport.t -> +val compare : OpamFile.SwitchExport.t -> OpamFile.SwitchExport.t -> opam_diff list * version_diff list * OpamPackage.Set.t * OpamPackage.Set.t * ((string * string) list * (string * string) list * duniverse_diff list, [> `Msg of string ]) result + +val compare_to_json : opam_diff list * version_diff list * OpamPackage.Set.t * OpamPackage.Set.t * +((string * string) list * (string * string) list * duniverse_diff list, [< `Msg of string ]) result -> Yojson.Basic.t