diff --git a/.gitignore b/.gitignore index ba7ce2a..7f06c54 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,4 @@ _build *~ *# - +_opam 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` 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/lib/builder_web.ml b/lib/builder_web.ml index af6c328..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,17 +408,30 @@ 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 + if is_accept_json req then + let json_response = + `Assoc [ + "job_name", `String job_name; + "uuid", `String (Uuidm.to_string build.uuid); + "platform", `String build.platform; + "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 + Dream.json ~status:`OK json_response |> Lwt_result.ok + else + 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 = @@ -537,7 +561,17 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = |> Lwt_result.ok in - let compare_builds req = + + let resolve_artifact_size id_opt conn = + match id_opt with + | None -> Lwt.return_ok None + | Some id -> + Model.build_artifact_by_id id conn >|= fun file -> + Some file.size + + 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 -> @@ -557,14 +591,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_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, - 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, - 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 @@ -572,13 +608,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_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_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 = @@ -619,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)); 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/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)) 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