robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor accept: json logic, return json errors

Browse source 
Now `or_error_response` will return the error message as a json object
if Accept: application/json.
This commit is contained in:
Reynir Björnsson 2024-12-20 10:46:16 +01:00
parent c670df643e
commit 44e7cd566f
1 changed files with 54 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

99
lib/builder_web.ml
View file

@ -70,11 +70,22 @@ let mime_lookup path =
let string_of_html = let string_of_html =
Format.asprintf "%a" (Tyxml.Html.pp ()) 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 let* r = r in
match r with match r with
| Ok response -> Lwt.return response | 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 = let default_log_warn ~status e =
Log.warn (fun m -> m "%s: %a" (Dream.status_to_string status) pp_error 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)) ~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) -> >>= 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 let solo5_manifest = Option.bind main_binary (Model.solo5_manifest datadir) in
match Dream.header req "Accept" with if is_accept_json req then
| Some accept when String.starts_with ~prefix:"application/json" accept ->
let json_response = let json_response =
`Assoc [ `Assoc [
"job_name", `String job_name; "job_name", `String job_name;
@ -410,7 +420,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
] |> Yojson.Basic.to_string ] |> Yojson.Basic.to_string
in in
Dream.json ~status:`OK json_response |> Lwt_result.ok Dream.json ~status:`OK json_response |> Lwt_result.ok
| _ -> else
Views.Job_build.make Views.Job_build.make
~job_name ~job_name
~build ~build
@ -605,45 +615,44 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
let compare_builds req = let compare_builds req =
process_comparison req >>= fun 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) -> (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 if is_accept_json req then
| 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 file_size_json = Option.fold ~none:`Null ~some:(fun size -> `Int size) in let json_response =
let json_response = `Assoc [
`Assoc [ "left", `Assoc [
"left", `Assoc [ "job_name", `String job_left;
"job_name", `String job_left; "uuid", `String (Uuidm.to_string build_left.uuid);
"uuid", `String (Uuidm.to_string build_left.uuid); "platform", `String build_left.platform;
"platform", `String build_left.platform; "start_time", `String (Ptime.to_rfc3339 build_left.start);
"start_time", `String (Ptime.to_rfc3339 build_left.start); "finish_time", `String (Ptime.to_rfc3339 build_left.finish);
"finish_time", `String (Ptime.to_rfc3339 build_left.finish); "main_binary", `Bool (Option.is_some build_left_file_size);
"main_binary", `Bool (Option.is_some build_left_file_size); "main_binary_size", file_size_json build_left_file_size;
"main_binary_size", file_size_json build_left_file_size; ];
]; "right", `Assoc [
"right", `Assoc [ "job_name", `String job_right;
"job_name", `String job_right; "build", `String (Uuidm.to_string build_right.uuid);
"build", `String (Uuidm.to_string build_right.uuid); "platform", `String build_right.platform;
"platform", `String build_right.platform; "start_time", `String (Ptime.to_rfc3339 build_right.start);
"start_time", `String (Ptime.to_rfc3339 build_right.start); "finish_time", `String (Ptime.to_rfc3339 build_right.finish);
"finish_time", `String (Ptime.to_rfc3339 build_right.finish); "main_binary", `Bool (Option.is_some build_right_file_size);
"main_binary", `Bool (Option.is_some build_right_file_size); "main_binary_size", file_size_json build_right_file_size;
"main_binary_size", file_size_json build_right_file_size; ];
]; "env_diff", Utils.diff_map_to_json env_diff;
"env_diff", Utils.diff_map_to_json env_diff; "package_diff", Utils.diff_map_to_json pkg_diff;
"package_diff", Utils.diff_map_to_json pkg_diff; "opam_diff", Opamdiff.compare_to_json opam_diff
"opam_diff", Opamdiff.compare_to_json opam_diff ] |> Yojson.Basic.to_string
] |> Yojson.Basic.to_string in
in Dream.json ~status:`OK json_response |> Lwt_result.ok
Dream.json ~status:`OK json_response |> Lwt_result.ok else
| _ -> Views.compare_builds
Views.compare_builds ~job_left ~job_right
~job_left ~job_right ~build_left ~build_right
~build_left ~build_right ~env_diff
~env_diff ~pkg_diff
~pkg_diff ~opam_diff
~opam_diff |> string_of_html |> Dream.html |> Lwt_result.ok
|> string_of_html |> Dream.html |> Lwt_result.ok in
in
let upload_binary req = let upload_binary req =
let job = Dream.param req "job" in let job = Dream.param req "job" in
@ -683,7 +692,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
>>= fun () -> Dream.respond "" |> Lwt_result.ok >>= fun () -> Dream.respond "" |> Lwt_result.ok
in 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)); `Get, "/", (w (builds ~all:false ~filter_builds_later_than:expired_jobs));