Resto: properly handle text/ocaml.exception.

This commit is contained in:
Grégoire Henry 2018-01-25 12:29:45 +01:00
parent 00f7a0ea87
commit bd8eaddc8c
4 changed files with 30 additions and 5 deletions

View File

@ -44,6 +44,7 @@ type rest_error =
| Unexpected_content of { content: string ; | Unexpected_content of { content: string ;
media_type: string ; media_type: string ;
error: string } error: string }
| OCaml_exception of string
| Generic_error (* temporary *) | Generic_error (* temporary *)
let rest_error_encoding = let rest_error_encoding =
@ -126,6 +127,12 @@ let rest_error_encoding =
| _ -> None) | _ -> None)
(function ((), content, media_type, error) -> (function ((), content, media_type, error) ->
Unexpected_content { 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 = let pp_rest_error ppf err =
@ -176,6 +183,10 @@ let pp_rest_error ppf err =
Format.fprintf ppf Format.fprintf ppf
"@[<v 2>Failed to parse the answer (%s):@,@[<v 2>error:@ %s@]@,@[<v 2>content:@ %S@]@]" "@[<v 2>Failed to parse the answer (%s):@,@[<v 2>error:@ %s@]@,@[<v 2>content:@ %S@]@]"
media_type error content media_type error content
| OCaml_exception msg ->
Format.fprintf ppf
"@[<v 2>The server failed with an unexpected exception:@ %s@]"
msg
| Generic_error -> | Generic_error ->
Format.fprintf ppf Format.fprintf ppf
"Generic error" "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) request_failed meth uri (Bad_request msg)
| `Connection_failed msg -> | `Connection_failed msg ->
request_failed meth uri (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 = let handle_error meth uri (body, media, _) f =
Cohttp_lwt.Body.is_empty body >>= fun empty -> Cohttp_lwt.Body.is_empty body >>= fun empty ->
@ -363,6 +376,8 @@ let handle accept (meth, uri, ans) =
body}) body})
| `Connection_failed msg -> | `Connection_failed msg ->
request_failed meth uri (Connection_failed msg) request_failed meth uri (Connection_failed msg)
| `OCaml_exception msg ->
request_failed meth uri (OCaml_exception msg)
let call_streamed_service let call_streamed_service
(type p q i o ) (type p q i o )

View File

@ -53,6 +53,7 @@ type rest_error =
| Unexpected_content of { content: string ; | Unexpected_content of { content: string ;
media_type: string ; media_type: string ;
error: string } error: string }
| OCaml_exception of string
| Generic_error (* temporary *) | Generic_error (* temporary *)
type error += type error +=

View File

@ -32,7 +32,8 @@ module Make (Encoding : Resto.ENCODING) = struct
| `Unsupported_media_type | `Unsupported_media_type
| `Not_acceptable of string | `Not_acceptable of string
| `Unexpected_status_code of Cohttp.Code.status_code * content | `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 = type ('o, 'e) service_result =
[ ('o, 'e option) generic_rest_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)) | `Forbidden -> Lwt.return (`Forbidden (ansbody, media_name, media))
| `Not_found -> Lwt.return (`Not_found (ansbody, media_name, media)) | `Not_found -> Lwt.return (`Not_found (ansbody, media_name, media))
| `Conflict -> Lwt.return (`Conflict (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 -> | `Bad_request ->
Cohttp_lwt.Body.to_string body >>= fun body -> Cohttp_lwt.Body.to_string body >>= fun body ->
Lwt.return (`Bad_request body) Lwt.return (`Bad_request body)
@ -286,7 +292,8 @@ module Make (Encoding : Resto.ENCODING) = struct
| `Unsupported_media_type | `Unsupported_media_type
| `Not_acceptable _ | `Not_acceptable _
| `Unexpected_status_code _ | `Unexpected_status_code _
| `Connection_failed _ as err -> Lwt.return err | `Connection_failed _
| `OCaml_exception _ as err -> Lwt.return err
end >>= fun ans -> end >>= fun ans ->
Lwt.return (meth, uri, ans) Lwt.return (meth, uri, ans)
@ -354,7 +361,8 @@ module Make (Encoding : Resto.ENCODING) = struct
| `Unsupported_media_type | `Unsupported_media_type
| `Not_acceptable _ | `Not_acceptable _
| `Unexpected_status_code _ | `Unexpected_status_code _
| `Connection_failed _ as err -> Lwt.return err | `Connection_failed _
| `OCaml_exception _ as err -> Lwt.return err
end >>= fun ans -> end >>= fun ans ->
Lwt.return (meth, uri, ans) Lwt.return (meth, uri, ans)

View File

@ -31,7 +31,8 @@ module Make (Encoding : Resto.ENCODING) : sig
| `Unsupported_media_type | `Unsupported_media_type
| `Not_acceptable of string | `Not_acceptable of string
| `Unexpected_status_code of Cohttp.Code.status_code * content | `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 module type LOGGER = sig
type request type request