Resto: properly handle text/ocaml.exception
.
This commit is contained in:
parent
00f7a0ea87
commit
bd8eaddc8c
@ -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
|
||||
"@[<v 2>Failed to parse the answer (%s):@,@[<v 2>error:@ %s@]@,@[<v 2>content:@ %S@]@]"
|
||||
media_type error content
|
||||
| OCaml_exception msg ->
|
||||
Format.fprintf ppf
|
||||
"@[<v 2>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 )
|
||||
|
@ -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 +=
|
||||
|
16
vendors/ocplib-resto/lib_resto-cohttp/client.ml
vendored
16
vendors/ocplib-resto/lib_resto-cohttp/client.ml
vendored
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user