RPC: improves error handling for exceptions on generic RPCs

This commit is contained in:
Milo Davis 2018-01-24 09:38:19 -05:00 committed by Grégoire Henry
parent 4109adfd77
commit 00f7a0ea87
2 changed files with 27 additions and 16 deletions

View File

@ -39,7 +39,8 @@ type rest_error =
content: string ; content: string ;
media_type: string option } media_type: string option }
| Unexpected_content_type of { received: string ; | Unexpected_content_type of { received: string ;
acceptable: string list } acceptable: string list ;
body : string}
| Unexpected_content of { content: string ; | Unexpected_content of { content: string ;
media_type: string ; media_type: string ;
error: string } error: string }
@ -102,16 +103,17 @@ let rest_error_encoding =
let code = Cohttp.Code.status_of_code code in let code = Cohttp.Code.status_of_code code in
Unexpected_status_code { code ; content ; media_type }) ; Unexpected_status_code { code ; content ; media_type }) ;
case (Tag 7) case (Tag 7)
(obj3 (obj4
(req "kind" (constant "unexpected_content_type")) (req "kind" (constant "unexpected_content_type"))
(req "received" string) (req "received" string)
(req "acceptable" (list string))) (req "acceptable" (list string))
(req "body" string))
(function (function
| Unexpected_content_type { received ; acceptable } -> | Unexpected_content_type { received ; acceptable ; body } ->
Some ((), received, acceptable) Some ((), received, acceptable, body)
| _ -> None) | _ -> None)
(function ((), received, acceptable) -> (function ((), received, acceptable, body) ->
Unexpected_content_type { received ; acceptable }) ; Unexpected_content_type { received ; acceptable ; body }) ;
case (Tag 8) case (Tag 8)
(obj4 (obj4
(req "kind" (constant "unexpected_content")) (req "kind" (constant "unexpected_content"))
@ -165,9 +167,11 @@ let pp_rest_error ppf err =
Format.fprintf ppf Format.fprintf ppf
"@[<v 2>Unexpected error %d:@,%S" "@[<v 2>Unexpected error %d:@,%S"
(Cohttp.Code.code_of_status code) content (Cohttp.Code.code_of_status code) content
| Unexpected_content_type { received ; acceptable = _ } -> | Unexpected_content_type { received ; acceptable = _ ; body } ->
Format.fprintf ppf Format.fprintf ppf
"The server answered with a media type we do not understand: %s" received "@[<v 0>The server answered with a media type we do not understand: %s.@,\
The response body was:@,\
%s@]" received body
| Unexpected_content { content ; media_type ; error } -> | Unexpected_content { content ; media_type ; error } ->
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@]@]"
@ -261,9 +265,11 @@ let handle_error meth uri (body, media, _) f =
error = msg }) error = msg })
end end
| Some (l, r) -> | Some (l, r) ->
Cohttp_lwt.Body.to_string body >>= fun body ->
request_failed meth uri request_failed meth uri
(Unexpected_content_type { received = l^"/"^r ; (Unexpected_content_type { received = l^"/"^r ;
acceptable = [Media_type.(name json)] }) acceptable = [Media_type.(name json)] ;
body })
let generic_json_call ?logger ?body meth uri : (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t = let generic_json_call ?logger ?body meth uri : (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t =
let body = let body =
@ -298,10 +304,12 @@ let generic_json_call ?logger ?body meth uri : (Data_encoding.json, Data_encodin
(module Json_repr.Ezjsonm) (module Json_repr.Ezjsonm)
bson)) bson))
end end
| `Ok (_body, Some (l, r), _) -> | `Ok (body, Some (l, r), _) ->
Cohttp_lwt.Body.to_string body >>= fun body ->
request_failed meth uri request_failed meth uri
(Unexpected_content_type { received = l^"/"^r ; (Unexpected_content_type { received = l^"/"^r ;
acceptable = [Media_type.(name json)] }) acceptable = [Media_type.(name json)] ;
body })
| `Conflict body -> | `Conflict body ->
handle_error meth uri body (fun v -> `Conflict v) handle_error meth uri body (fun v -> `Conflict v)
| `Error body -> | `Error body ->
@ -344,13 +352,15 @@ let handle accept (meth, uri, ans) =
| `Unexpected_error_content ((content, media_type), error) -> | `Unexpected_error_content ((content, media_type), error) ->
let media_type = Media_type.name media_type in let media_type = Media_type.name media_type in
request_failed meth uri (Unexpected_content { content ; media_type ; error }) request_failed meth uri (Unexpected_content { content ; media_type ; error })
| `Unexpected_error_content_type (_, media) | `Unexpected_error_content_type (body, media)
| `Unexpected_content_type (_, media) -> | `Unexpected_content_type (body, media) ->
Cohttp_lwt.Body.to_string body >>= fun body ->
let received = let received =
Option.unopt_map media ~default:"" ~f:(fun (l, r) -> l^"/"^r) in Option.unopt_map media ~default:"" ~f:(fun (l, r) -> l^"/"^r) in
request_failed meth uri request_failed meth uri
(Unexpected_content_type { received ; (Unexpected_content_type { received ;
acceptable = List.map Media_type.name accept }) acceptable = List.map Media_type.name accept ;
body})
| `Connection_failed msg -> | `Connection_failed msg ->
request_failed meth uri (Connection_failed msg) request_failed meth uri (Connection_failed msg)

View File

@ -48,7 +48,8 @@ type rest_error =
content: string ; content: string ;
media_type: string option } media_type: string option }
| Unexpected_content_type of { received: string ; | Unexpected_content_type of { received: string ;
acceptable: string list } acceptable: string list ;
body : string }
| Unexpected_content of { content: string ; | Unexpected_content of { content: string ;
media_type: string ; media_type: string ;
error: string } error: string }