From bd8eaddc8ce4ce8d34fb2628bf4efc62b8b085cd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= <gregoire.henry@tezos.com>
Date: Thu, 25 Jan 2018 12:29:45 +0100
Subject: [PATCH] Resto: properly handle `text/ocaml.exception`.

---
 src/lib_rpc_http/RPC_client.ml                   | 15 +++++++++++++++
 src/lib_rpc_http/RPC_client.mli                  |  1 +
 vendors/ocplib-resto/lib_resto-cohttp/client.ml  | 16 ++++++++++++----
 vendors/ocplib-resto/lib_resto-cohttp/client.mli |  3 ++-
 4 files changed, 30 insertions(+), 5 deletions(-)

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
         "@[<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 )
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