diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml index aa546fdc2..81c38a586 100644 --- a/src/lib_rpc_http/RPC_client.ml +++ b/src/lib_rpc_http/RPC_client.ml @@ -44,6 +44,7 @@ type rest_error = | Unexpected_content of { content: string ; media_type: string ; error: string } + | OCaml_exception of string | Generic_error (* temporary *) let rest_error_encoding = @@ -126,6 +127,12 @@ let rest_error_encoding = | _ -> None) (function ((), content, media_type, error) -> Unexpected_content { content ; media_type ; error }) ; + case (Tag 9) + (obj2 + (req "kind" (constant "ocaml_exception")) + (req "content" string)) + (function OCaml_exception msg -> Some ((), msg) | _ -> None) + (function ((), msg) -> OCaml_exception msg) ; ] let pp_rest_error ppf err = @@ -176,6 +183,10 @@ let pp_rest_error ppf err = Format.fprintf ppf "@[Failed to parse the answer (%s):@,@[error:@ %s@]@,@[content:@ %S@]@]" media_type error content + | OCaml_exception msg -> + Format.fprintf ppf + "@[The server failed with an unexpected exception:@ %s@]" + msg | Generic_error -> Format.fprintf ppf "Generic error" @@ -247,6 +258,8 @@ let generic_call ?logger ?accept ?body ?media meth uri : (content, content) rest request_failed meth uri (Bad_request msg) | `Connection_failed msg -> request_failed meth uri (Connection_failed msg) + | `OCaml_exception msg -> + request_failed meth uri (OCaml_exception msg) let handle_error meth uri (body, media, _) f = Cohttp_lwt.Body.is_empty body >>= fun empty -> @@ -363,6 +376,8 @@ let handle accept (meth, uri, ans) = body}) | `Connection_failed msg -> request_failed meth uri (Connection_failed msg) + | `OCaml_exception msg -> + request_failed meth uri (OCaml_exception msg) let call_streamed_service (type p q i o ) diff --git a/src/lib_rpc_http/RPC_client.mli b/src/lib_rpc_http/RPC_client.mli index 50a6896b4..6e478000a 100644 --- a/src/lib_rpc_http/RPC_client.mli +++ b/src/lib_rpc_http/RPC_client.mli @@ -53,6 +53,7 @@ type rest_error = | Unexpected_content of { content: string ; media_type: string ; error: string } + | OCaml_exception of string | Generic_error (* temporary *) type error += diff --git a/vendors/ocplib-resto/lib_resto-cohttp/client.ml b/vendors/ocplib-resto/lib_resto-cohttp/client.ml index 9b9c33d01..dd843a428 100644 --- a/vendors/ocplib-resto/lib_resto-cohttp/client.ml +++ b/vendors/ocplib-resto/lib_resto-cohttp/client.ml @@ -32,7 +32,8 @@ module Make (Encoding : Resto.ENCODING) = struct | `Unsupported_media_type | `Not_acceptable of string | `Unexpected_status_code of Cohttp.Code.status_code * content - | `Connection_failed of string ] + | `Connection_failed of string + | `OCaml_exception of string ] type ('o, 'e) service_result = [ ('o, 'e option) generic_rest_result @@ -174,7 +175,12 @@ module Make (Encoding : Resto.ENCODING) = struct | `Forbidden -> Lwt.return (`Forbidden (ansbody, media_name, media)) | `Not_found -> Lwt.return (`Not_found (ansbody, media_name, media)) | `Conflict -> Lwt.return (`Conflict (ansbody, media_name, media)) - | `Internal_server_error -> Lwt.return (`Error (ansbody, media_name, media)) + | `Internal_server_error -> + if media_name = Some ("text", "ocaml.exception") then + Cohttp_lwt.Body.to_string ansbody >>= fun msg -> + Lwt.return (`OCaml_exception msg) + else + Lwt.return (`Error (ansbody, media_name, media)) | `Bad_request -> Cohttp_lwt.Body.to_string body >>= fun body -> Lwt.return (`Bad_request body) @@ -286,7 +292,8 @@ module Make (Encoding : Resto.ENCODING) = struct | `Unsupported_media_type | `Not_acceptable _ | `Unexpected_status_code _ - | `Connection_failed _ as err -> Lwt.return err + | `Connection_failed _ + | `OCaml_exception _ as err -> Lwt.return err end >>= fun ans -> Lwt.return (meth, uri, ans) @@ -354,7 +361,8 @@ module Make (Encoding : Resto.ENCODING) = struct | `Unsupported_media_type | `Not_acceptable _ | `Unexpected_status_code _ - | `Connection_failed _ as err -> Lwt.return err + | `Connection_failed _ + | `OCaml_exception _ as err -> Lwt.return err end >>= fun ans -> Lwt.return (meth, uri, ans) diff --git a/vendors/ocplib-resto/lib_resto-cohttp/client.mli b/vendors/ocplib-resto/lib_resto-cohttp/client.mli index 14fb4d6a8..0fa353309 100644 --- a/vendors/ocplib-resto/lib_resto-cohttp/client.mli +++ b/vendors/ocplib-resto/lib_resto-cohttp/client.mli @@ -31,7 +31,8 @@ module Make (Encoding : Resto.ENCODING) : sig | `Unsupported_media_type | `Not_acceptable of string | `Unexpected_status_code of Cohttp.Code.status_code * content - | `Connection_failed of string ] + | `Connection_failed of string + | `OCaml_exception of string ] module type LOGGER = sig type request