From 00f7a0ea87d264dcfd7e6547b5d95312ca87f3f2 Mon Sep 17 00:00:00 2001
From: Milo Davis <davis.mil@husky.neu.edu>
Date: Wed, 24 Jan 2018 09:38:19 -0500
Subject: [PATCH] RPC: improves error handling for exceptions on generic RPCs

---
 src/lib_rpc_http/RPC_client.ml  | 40 ++++++++++++++++++++-------------
 src/lib_rpc_http/RPC_client.mli |  3 ++-
 2 files changed, 27 insertions(+), 16 deletions(-)

diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml
index a1edb14f9..aa546fdc2 100644
--- a/src/lib_rpc_http/RPC_client.ml
+++ b/src/lib_rpc_http/RPC_client.ml
@@ -39,7 +39,8 @@ type rest_error =
                                 content: string ;
                                 media_type: string option }
   | Unexpected_content_type of { received: string ;
-                                 acceptable: string list }
+                                 acceptable: string list ;
+                                 body : string}
   | Unexpected_content of { content: string ;
                             media_type: string ;
                             error: string }
@@ -102,16 +103,17 @@ let rest_error_encoding =
            let code = Cohttp.Code.status_of_code code in
            Unexpected_status_code { code ; content ; media_type }) ;
       case (Tag  7)
-        (obj3
+        (obj4
            (req "kind" (constant "unexpected_content_type"))
            (req "received" string)
-           (req "acceptable" (list string)))
+           (req "acceptable" (list string))
+           (req "body" string))
         (function
-          | Unexpected_content_type { received ; acceptable } ->
-              Some ((), received, acceptable)
+          | Unexpected_content_type { received ; acceptable ; body } ->
+              Some ((), received, acceptable, body)
           | _ -> None)
-        (function ((), received, acceptable) ->
-           Unexpected_content_type { received ; acceptable }) ;
+        (function ((), received, acceptable, body) ->
+           Unexpected_content_type { received ; acceptable ; body }) ;
       case (Tag  8)
         (obj4
            (req "kind" (constant "unexpected_content"))
@@ -165,9 +167,11 @@ let pp_rest_error ppf err =
       Format.fprintf ppf
         "@[<v 2>Unexpected error %d:@,%S"
         (Cohttp.Code.code_of_status code) content
-  | Unexpected_content_type { received ; acceptable = _ } ->
+  | Unexpected_content_type { received ; acceptable = _ ; body } ->
       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 } ->
       Format.fprintf ppf
         "@[<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 })
       end
     | Some (l, r) ->
+        Cohttp_lwt.Body.to_string body >>= fun body ->
         request_failed meth uri
           (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 body =
@@ -298,10 +304,12 @@ let generic_json_call ?logger ?body meth uri : (Data_encoding.json, Data_encodin
                          (module Json_repr.Ezjsonm)
                          bson))
     end
-  | `Ok (_body, Some (l, r), _) ->
+  | `Ok (body, Some (l, r), _) ->
+      Cohttp_lwt.Body.to_string body >>= fun body ->
       request_failed meth uri
         (Unexpected_content_type { received = l^"/"^r ;
-                                   acceptable = [Media_type.(name json)] })
+                                   acceptable = [Media_type.(name json)] ;
+                                   body })
   | `Conflict body ->
       handle_error meth uri body (fun v -> `Conflict v)
   | `Error body ->
@@ -344,13 +352,15 @@ let handle accept (meth, uri, ans) =
   | `Unexpected_error_content ((content, media_type), error) ->
       let media_type = Media_type.name media_type in
       request_failed meth uri (Unexpected_content { content ; media_type ; error })
-  | `Unexpected_error_content_type (_, media)
-  | `Unexpected_content_type (_, media) ->
+  | `Unexpected_error_content_type (body, media)
+  | `Unexpected_content_type (body, media) ->
+      Cohttp_lwt.Body.to_string body >>= fun body ->
       let received =
         Option.unopt_map media ~default:"" ~f:(fun (l, r) -> l^"/"^r) in
       request_failed meth uri
         (Unexpected_content_type { received ;
-                                   acceptable = List.map Media_type.name accept })
+                                   acceptable = List.map Media_type.name accept ;
+                                   body})
   | `Connection_failed msg ->
       request_failed meth uri (Connection_failed msg)
 
diff --git a/src/lib_rpc_http/RPC_client.mli b/src/lib_rpc_http/RPC_client.mli
index 9929355e0..50a6896b4 100644
--- a/src/lib_rpc_http/RPC_client.mli
+++ b/src/lib_rpc_http/RPC_client.mli
@@ -48,7 +48,8 @@ type rest_error =
                                 content: string ;
                                 media_type: string option }
   | Unexpected_content_type of { received: string ;
-                                 acceptable: string list }
+                                 acceptable: string list ;
+                                 body : string }
   | Unexpected_content of { content: string ;
                             media_type: string ;
                             error: string }