From 55d4091256c39e3b6e224353cec63588858dcef9 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Thu, 19 Dec 2024 12:22:07 +0100 Subject: [PATCH 01/10] return uuid of latest build when header contains an accept json --- lib/builder_web.ml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index af6c328..eb7a5b6 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -330,9 +330,18 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = Dream.sql req (Model.latest_successful_build_uuid job_id platform)) >>= Model.not_found |> if_error "Error getting job" >>= fun build -> - Dream.redirect req - (Link.Job_build_artifact.make_from_string ~job_name ~build ~artifact ()) - |> Lwt_result.ok + match Dream.header req "Accept" with + | Some accept when String.starts_with ~prefix:"application/json" accept -> + let json_response = + `Assoc [ + "uuid", `String (Uuidm.to_string build); + ] |> Yojson.Basic.to_string + in + Dream.json ~status:`OK json_response |> Lwt_result.ok + | _ -> + Dream.redirect req + (Link.Job_build_artifact.make_from_string ~job_name ~build ~artifact ()) + |> Lwt_result.ok in let redirect_latest req = From 8fb99041ba3796e6d124ec8e54a6943873c3d45e Mon Sep 17 00:00:00 2001 From: PizieDust Date: Fri, 20 Dec 2024 07:01:40 +0100 Subject: [PATCH 02/10] 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 From 14626c0bfea68060e83045ab389cb79299f0c5d7 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Fri, 20 Dec 2024 07:03:47 +0100 Subject: [PATCH 03/10] some documentation --- README.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/README.md b/README.md index 3dcf98c..a254062 100644 --- a/README.md +++ b/README.md @@ -58,3 +58,9 @@ see `builder-db user-add --help`): ```ocaml curl --data-binary @.full http://:@localhost:/upload ``` + +## JSON Responses +Some endpoints return JSON when the headers contain `Accept: application/json`. +- `/compare/:build_left/:build_right` +- `/job/:job/build/latest/**` +- `/job/:job/build/latest` From b26d0a28d10b7ae047b8aec9ba775db05bc29114 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Fri, 20 Dec 2024 07:03:58 +0100 Subject: [PATCH 04/10] add opam dir to gitignore --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index ba7ce2a..7f06c54 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,4 @@ _build *~ *# - +_opam From 63223b8c461b696a3d0a6a18defe32ff84bea615 Mon Sep 17 00:00:00 2001 From: PizieDust Date: Fri, 20 Dec 2024 08:29:16 +0100 Subject: [PATCH 05/10] add more data to build endpoint --- lib/builder_web.ml | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 8a7436d..9ba75ac 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -406,17 +406,31 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e)) >>= fun (build, main_binary, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) -> let solo5_manifest = Option.bind main_binary (Model.solo5_manifest datadir) in - Views.Job_build.make - ~job_name - ~build - ~artifacts - ~main_binary - ~solo5_manifest - ~same_input_same_output - ~different_input_same_output - ~same_input_different_output - ~latest ~next ~previous - |> string_of_html |> Dream.html |> Lwt_result.ok + match Dream.header req "Accept" with + | Some accept when String.starts_with ~prefix:"application/json" accept -> + let json_response = + `Assoc [ + "job_name", `String job_name; + "uuid", `String (Uuidm.to_string build.uuid); + "platform", `String build.platform; + "build_start_time", `String (Ptime.to_rfc3339 build.start); + "build_finish_time", `String (Ptime.to_rfc3339 build.finish); + "main_binary", (match build.main_binary with Some _ -> `Bool true | None -> `Bool false) + ] |> Yojson.Basic.to_string + in + Dream.json ~status:`OK json_response |> Lwt_result.ok + | _ -> + Views.Job_build.make + ~job_name + ~build + ~artifacts + ~main_binary + ~solo5_manifest + ~same_input_same_output + ~different_input_same_output + ~same_input_different_output + ~latest ~next ~previous + |> string_of_html |> Dream.html |> Lwt_result.ok in let job_build_file req = From 92ee6b9aaf77c2b91c481a32879211dacd9f8881 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 20 Dec 2024 10:12:55 +0100 Subject: [PATCH 06/10] Yojson is now a non-test dependency --- builder-web.opam | 2 +- opamdiff/dune | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/builder-web.opam b/builder-web.opam index ddae823..a89c5fb 100644 --- a/builder-web.opam +++ b/builder-web.opam @@ -50,10 +50,10 @@ depends: [ "decompress" {>= "1.5.0"} "digestif" {>= "1.2.0"} "uuidm" {>= "0.9.9"} + "yojson" "alcotest" {>= "1.2.0" & with-test} "ppx_deriving" {with-test} "ppx_deriving_yojson" {with-test} - "yojson" {with-test} ] synopsis: "Web interface for builder" diff --git a/opamdiff/dune b/opamdiff/dune index 941f235..fc5561d 100644 --- a/opamdiff/dune +++ b/opamdiff/dune @@ -1,3 +1,3 @@ (library (name opamdiff) - (libraries opam-core opam-format)) + (libraries opam-core opam-format yojson)) From 23db42fed3fe06b64b829117a66004300cbc5585 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 20 Dec 2024 10:13:30 +0100 Subject: [PATCH 07/10] Rely on redirect also for Accept: json --- lib/builder_web.ml | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 9ba75ac..b686262 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -330,18 +330,9 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = Dream.sql req (Model.latest_successful_build_uuid job_id platform)) >>= Model.not_found |> if_error "Error getting job" >>= fun build -> - match Dream.header req "Accept" with - | Some accept when String.starts_with ~prefix:"application/json" accept -> - let json_response = - `Assoc [ - "uuid", `String (Uuidm.to_string build); - ] |> Yojson.Basic.to_string - in - Dream.json ~status:`OK json_response |> Lwt_result.ok - | _ -> - Dream.redirect req - (Link.Job_build_artifact.make_from_string ~job_name ~build ~artifact ()) - |> Lwt_result.ok + Dream.redirect req + (Link.Job_build_artifact.make_from_string ~job_name ~build ~artifact ()) + |> Lwt_result.ok in let redirect_latest req = From 2c44f88460fbaceacde49bca27d721fc5ab7876f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 20 Dec 2024 10:25:52 +0100 Subject: [PATCH 08/10] compare_builds json: return null if no main binary --- lib/builder_web.ml | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index b686262..54ec98b 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -552,15 +552,12 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = in - let resolve_artifact id_opt conn = - let default_file : Builder_db.file = { - filepath = Fpath.v "null"; - sha256 = "0"; - size = -1; - } in + let resolve_artifact_size id_opt conn = match id_opt with - | None -> Lwt.return_ok default_file - | Some id -> Model.build_artifact_by_id id conn + | None -> Lwt.return_ok None + | Some id -> + Model.build_artifact_by_id id conn >|= fun file -> + Some file.size in @@ -584,16 +581,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 -> + resolve_artifact_size build_left.Builder_db.Build.main_binary conn >>= fun build_left_file_size -> + resolve_artifact_size build_right.Builder_db.Build.main_binary conn >>= fun build_right_file_size -> 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, build_left_file, - build_right_file, switch_left, build_env_left, system_packages_left, + (job_left, job_right, build_left, build_right, build_left_file_size, + build_right_file_size, 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, build_left_file, - build_right_file, switch_left, build_env_left, system_packages_left, + >>= fun (job_left, job_right, build_left, build_right, build_left_file_size, + build_right_file_size, 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 @@ -601,16 +598,17 @@ 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 - (job_left, job_right, build_left, build_right, build_left_file, build_right_file, env_diff, pkg_diff, opam_diff) + (job_left, job_right, build_left, build_right, build_left_file_size, build_right_file_size, 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) -> + (job_left, job_right, build_left, build_right, build_left_file_size, build_right_file_size, env_diff, pkg_diff, opam_diff) -> match Dream.header req "Accept" with | Some accept when String.starts_with ~prefix:"application/json" accept -> + let file_size_json = Option.fold ~none:`Null ~some:(fun size -> `Int size) in let json_response = `Assoc [ "left", `Assoc [ @@ -619,7 +617,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = "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) + "build_size", file_size_json build_left_file_size; ]; "right", `Assoc [ "job", `String job_right; @@ -627,7 +625,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = "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) + "build_size", file_size_json build_right_file_size; ]; "env_diff", Utils.diff_map_to_json env_diff; "package_diff", Utils.diff_map_to_json pkg_diff; From c670df643e6020ea2c495dd7fc532879a862c447 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 20 Dec 2024 10:27:21 +0100 Subject: [PATCH 09/10] Tweak json field names Also add "main_binary" boolean field in comparison for consistency with `job_build` json. --- lib/builder_web.ml | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 54ec98b..5f54fd8 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -404,8 +404,8 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = "job_name", `String job_name; "uuid", `String (Uuidm.to_string build.uuid); "platform", `String build.platform; - "build_start_time", `String (Ptime.to_rfc3339 build.start); - "build_finish_time", `String (Ptime.to_rfc3339 build.finish); + "start_time", `String (Ptime.to_rfc3339 build.start); + "finish_time", `String (Ptime.to_rfc3339 build.finish); "main_binary", (match build.main_binary with Some _ -> `Bool true | None -> `Bool false) ] |> Yojson.Basic.to_string in @@ -612,20 +612,22 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = let json_response = `Assoc [ "left", `Assoc [ - "job", `String job_left; - "build", `String (Uuidm.to_string build_left.uuid); + "job_name", `String job_left; + "uuid", `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", file_size_json build_left_file_size; + "start_time", `String (Ptime.to_rfc3339 build_left.start); + "finish_time", `String (Ptime.to_rfc3339 build_left.finish); + "main_binary", `Bool (Option.is_some build_left_file_size); + "main_binary_size", file_size_json build_left_file_size; ]; "right", `Assoc [ - "job", `String job_right; + "job_name", `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", file_size_json build_right_file_size; + "start_time", `String (Ptime.to_rfc3339 build_right.start); + "finish_time", `String (Ptime.to_rfc3339 build_right.finish); + "main_binary", `Bool (Option.is_some build_right_file_size); + "main_binary_size", file_size_json build_right_file_size; ]; "env_diff", Utils.diff_map_to_json env_diff; "package_diff", Utils.diff_map_to_json pkg_diff; From 44e7cd566feb0b28f231dfdc00fa038627073d2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 20 Dec 2024 10:46:16 +0100 Subject: [PATCH 10/10] Refactor accept: json logic, return json errors Now `or_error_response` will return the error message as a json object if Accept: application/json. --- lib/builder_web.ml | 99 +++++++++++++++++++++++++--------------------- 1 file changed, 54 insertions(+), 45 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 5f54fd8..e33ca5c 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -70,11 +70,22 @@ let mime_lookup path = let string_of_html = Format.asprintf "%a" (Tyxml.Html.pp ()) -let or_error_response r = +let is_accept_json req = + match Dream.header req "Accept" with + | Some accept when String.starts_with ~prefix:"application/json" accept -> + true + | _ -> false + +let or_error_response req r = let* r = r in match r with | Ok response -> Lwt.return response - | Error (text, status) -> Dream.respond ~status text + | Error (text, status) -> + if is_accept_json req then + let json_response = Yojson.Basic.to_string (`Assoc [ "error", `String text ]) in + Dream.json ~status json_response + else + Dream.respond ~status text let default_log_warn ~status e = Log.warn (fun m -> m "%s: %a" (Dream.status_to_string status) pp_error e) @@ -397,8 +408,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e)) >>= fun (build, main_binary, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) -> let solo5_manifest = Option.bind main_binary (Model.solo5_manifest datadir) in - match Dream.header req "Accept" with - | Some accept when String.starts_with ~prefix:"application/json" accept -> + if is_accept_json req then let json_response = `Assoc [ "job_name", `String job_name; @@ -410,7 +420,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = ] |> Yojson.Basic.to_string in Dream.json ~status:`OK json_response |> Lwt_result.ok - | _ -> + else Views.Job_build.make ~job_name ~build @@ -605,45 +615,44 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = let compare_builds req = process_comparison req >>= fun - (job_left, job_right, build_left, build_right, build_left_file_size, build_right_file_size, env_diff, pkg_diff, opam_diff) -> - match Dream.header req "Accept" with - | Some accept when String.starts_with ~prefix:"application/json" accept -> - let file_size_json = Option.fold ~none:`Null ~some:(fun size -> `Int size) in - let json_response = - `Assoc [ - "left", `Assoc [ - "job_name", `String job_left; - "uuid", `String (Uuidm.to_string build_left.uuid); - "platform", `String build_left.platform; - "start_time", `String (Ptime.to_rfc3339 build_left.start); - "finish_time", `String (Ptime.to_rfc3339 build_left.finish); - "main_binary", `Bool (Option.is_some build_left_file_size); - "main_binary_size", file_size_json build_left_file_size; - ]; - "right", `Assoc [ - "job_name", `String job_right; - "build", `String (Uuidm.to_string build_right.uuid); - "platform", `String build_right.platform; - "start_time", `String (Ptime.to_rfc3339 build_right.start); - "finish_time", `String (Ptime.to_rfc3339 build_right.finish); - "main_binary", `Bool (Option.is_some build_right_file_size); - "main_binary_size", file_size_json 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 + (job_left, job_right, build_left, build_right, build_left_file_size, build_right_file_size, env_diff, pkg_diff, opam_diff) -> + if is_accept_json req then + let file_size_json = Option.fold ~none:`Null ~some:(fun size -> `Int size) in + let json_response = + `Assoc [ + "left", `Assoc [ + "job_name", `String job_left; + "uuid", `String (Uuidm.to_string build_left.uuid); + "platform", `String build_left.platform; + "start_time", `String (Ptime.to_rfc3339 build_left.start); + "finish_time", `String (Ptime.to_rfc3339 build_left.finish); + "main_binary", `Bool (Option.is_some build_left_file_size); + "main_binary_size", file_size_json build_left_file_size; + ]; + "right", `Assoc [ + "job_name", `String job_right; + "build", `String (Uuidm.to_string build_right.uuid); + "platform", `String build_right.platform; + "start_time", `String (Ptime.to_rfc3339 build_right.start); + "finish_time", `String (Ptime.to_rfc3339 build_right.finish); + "main_binary", `Bool (Option.is_some build_right_file_size); + "main_binary_size", file_size_json 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 + else + 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 @@ -683,7 +692,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = >>= fun () -> Dream.respond "" |> Lwt_result.ok in - let w f req = or_error_response (f req) in + let w f req = or_error_response req (f req) in [ `Get, "/", (w (builds ~all:false ~filter_builds_later_than:expired_jobs));