diff --git a/CHANGES.rst b/CHANGES.rst index eaf9e744f2b3640b29b7c4aacdfe5ca9e306af5b..2aed0edd8f1fb66af74459d2ecbc6402af40bb05 100644 --- a/CHANGES.rst +++ b/CHANGES.rst @@ -135,6 +135,7 @@ Client code. These options can be used to override the values normally returned by the ``NOW`` and ``LEVEL`` instructions. +- The output of ``tezos-client``'s RPC commands now uses the format specified by the ``--media-type``. Baker / Endorser / Accuser -------------------------- diff --git a/src/bin_client/client_rpc_commands.ml b/src/bin_client/client_rpc_commands.ml index 0a7efd00eba1d9eb4b9d2a8dc38d6f4809e5dc75..90d4664cd0cd0dc4683db44b361f15a01a7b7de4 100644 --- a/src/bin_client/client_rpc_commands.ml +++ b/src/bin_client/client_rpc_commands.ml @@ -377,25 +377,41 @@ let fill_in ?(show_optionals = true) schema = | Any | Object {properties = []; _} -> Lwt.return_ok (`O []) | _ -> editor_fill_in ~show_optionals schema -let display_answer (cctxt : #Client_context.full) = function - | `Ok json -> cctxt#answer "%a" Json_repr.(pp (module Ezjsonm)) json - | `Not_found _ -> cctxt#error "No service found at this URL\n%!" - | `Gone _ -> - cctxt#error - "Requested data concerns a pruned block and target resource is no \ - longer available\n\ - %!" - | `Unauthorized None -> - cctxt#error "@[[HTTP 403] Access denied to: %a@]@." Uri.pp cctxt#base - | `Error (Some json) -> +let display_answer (cctxt : #Client_context.full) : + RPC_context.generic_call_result -> unit Lwt.t = function + | `Json (`Ok json) -> cctxt#answer "%a" Json_repr.(pp (module Ezjsonm)) json + | `Binary (`Ok binary) -> cctxt#answer "%a" Hex.pp (Hex.of_string binary) + | `Json (`Error (Some error)) -> cctxt#error "@[Command failed: @[%a@]@]@." (Format.pp_print_list Error_monad.pp) (Data_encoding.Json.destruct (Data_encoding.list Error_monad.error_encoding) - json) - | `Error None | `Unauthorized _ | `Forbidden _ | `Conflict _ -> - cctxt#error "Unexpected server answer\n%!" + error) + | `Binary (`Error (Some error)) -> ( + match Data_encoding.Binary.of_string Error_monad.trace_encoding error with + | Ok trace -> + cctxt#error + "@[Command failed: @[%a@]@]@." + Error_monad.pp_print_trace + trace + | Error msg -> + cctxt#error + "@[Error whilst decoding the server response: @[%a@]@]@." + Data_encoding.Binary.pp_read_error + msg) + | `Json (`Not_found _) | `Binary (`Not_found _) | `Other (_, `Not_found _) -> + cctxt#error "No service found at this URL\n%!" + | `Json (`Gone _) | `Binary (`Gone _) | `Other (_, `Gone _) -> + cctxt#error + "Requested data concerns a pruned block and target resource is no \ + longer available\n\ + %!" + | `Json (`Unauthorized _) + | `Binary (`Unauthorized _) + | `Other (_, `Unauthorized _) -> + cctxt#error "@[[HTTP 403] Access denied to: %a@]@." Uri.pp cctxt#base + | _ -> cctxt#error "Unexpected server answer\n%!" let call ?body meth raw_url (cctxt : #Client_context.full) = let uri = Uri.of_string raw_url in @@ -411,7 +427,7 @@ let call ?body meth raw_url (cctxt : #Client_context.full) = cctxt#warning "This URL did not expect a JSON input but one was provided\n%!") >>= fun () -> - cctxt#generic_json_call meth ?body uri >>=? fun answer -> + cctxt#generic_media_type_call meth ?body uri >>=? fun answer -> display_answer cctxt answer >|= ok | Some {input = Some input; _} -> ( (match body with @@ -420,7 +436,7 @@ let call ?body meth raw_url (cctxt : #Client_context.full) = >>= function | Error msg -> cctxt#error "%s" msg | Ok body -> - cctxt#generic_json_call meth ~body uri >>=? fun answer -> + cctxt#generic_media_type_call meth ~body uri >>=? fun answer -> display_answer cctxt answer >|= ok)) | _ -> cctxt#error "No service found at this URL\n%!" diff --git a/src/lib_client_base/client_context.ml b/src/lib_client_base/client_context.ml index 332253e7a71046acac69033748c05cdd5a14cace..e6272beb3c762d88f4ada180191ded2906e9522a 100644 --- a/src/lib_client_base/client_context.ml +++ b/src/lib_client_base/client_context.ml @@ -185,6 +185,8 @@ class proxy_context (obj : full) = method generic_json_call = obj#generic_json_call + method generic_media_type_call = obj#generic_media_type_call + method with_lock : type a. (unit -> a Lwt.t) -> a Lwt.t = obj#with_lock method load : type a. diff --git a/src/lib_mockup/RPC_client.ml b/src/lib_mockup/RPC_client.ml index b03ae2048bbe66a0c2aa0023697d8b0d56bab92b..4978591f7b32a21fc4139fa58ba477fbaf9828cd 100644 --- a/src/lib_mockup/RPC_client.ml +++ b/src/lib_mockup/RPC_client.ml @@ -43,6 +43,9 @@ class mockup_ctxt (base_dir : string) (mem_only : bool) method generic_json_call meth ?body uri = local_ctxt#generic_json_call meth ?body uri + method generic_media_type_call meth ?body uri = + local_ctxt#generic_media_type_call meth ?body uri + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/lib_mockup_proxy/RPC_client.ml b/src/lib_mockup_proxy/RPC_client.ml index 3461b54908cd4d0de1dab15a380d7875cd6c9b9d..d55c4833b5b055125985672e6345cf5413f05835 100644 --- a/src/lib_mockup_proxy/RPC_client.ml +++ b/src/lib_mockup_proxy/RPC_client.ml @@ -68,6 +68,9 @@ let local_ctxt (directory : unit RPC_directory.t) : RPC_context.json = method generic_json_call meth ?body uri = C.generic_json_call meth ?body uri + method generic_media_type_call meth ?body uri = + C.generic_media_type_call ~accept:media_types meth ?body uri + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/lib_proxy/RPC_client.ml b/src/lib_proxy/RPC_client.ml index b22e2ccae897b7a0ef0862c834a9a9f41a4d3ee7..77953c846472598db5ad5e8e61110d307ef0b470 100644 --- a/src/lib_proxy/RPC_client.ml +++ b/src/lib_proxy/RPC_client.ml @@ -156,8 +156,8 @@ class http_local_ctxt (printer : Tezos_client_base.Client_context.printer) in if method_is_writer meth then delegate () else - let* y = local_ctxt#generic_json_call meth ?body uri in - match y with + let* answer = local_ctxt#generic_json_call meth ?body uri in + match answer with | Ok (`Not_found _) | Error [Tezos_rpc.RPC_context.Not_found _] -> delegate () | Ok x -> @@ -166,4 +166,38 @@ class http_local_ctxt (printer : Tezos_client_base.Client_context.printer) in return_ok x | Error _ as err -> Lwt.return err + + method generic_media_type_call + : Service.meth -> + ?body:Data_encoding.json -> + Uri.t -> + RPC_context.generic_call_result Tezos_error_monad.Error_monad.tzresult + Lwt.t = + let open Lwt_syntax in + fun meth ?body uri -> + let meth_string = RPC_service.string_of_meth meth in + let uri_string = Uri.to_string uri in + let delegate () = + let* () = + Events.(emit delegate_media_type_call_to_http) + (meth_string, uri_string) + in + http_ctxt#generic_media_type_call meth ?body uri + in + if method_is_writer meth then delegate () + else + let* answer = local_ctxt#generic_media_type_call meth ?body uri in + match answer with + | Ok (`Json (`Not_found _)) + | Ok (`Binary (`Not_found _)) + | Ok (`Other (_, `Not_found _)) + | Error [Tezos_rpc.RPC_context.Not_found _] -> + delegate () + | Ok x -> + let* () = + Events.(emit done_media_type_call_locally) + (meth_string, uri_string) + in + return_ok x + | Error _ as err -> Lwt.return err end diff --git a/src/lib_proxy/proxy_events.ml b/src/lib_proxy/proxy_events.ml index d5b3f48dec40cb9ca1361b2b6f1237707e6494a7..2d5dfd5222e5fcb192774f86529019dcb43c346e 100644 --- a/src/lib_proxy/proxy_events.ml +++ b/src/lib_proxy/proxy_events.ml @@ -41,3 +41,21 @@ let done_json_call_locally = ~msg:"locally done generic json call: {method} {uri}" ("method", Data_encoding.string) ("uri", Data_encoding.string) + +let delegate_media_type_call_to_http = + declare_2 + ~section + ~level + ~name:"delegate_media_type_call_to_http" + ~msg:"delegating to http generic media type call: {method} {uri}" + ("method", Data_encoding.string) + ("uri", Data_encoding.string) + +let done_media_type_call_locally = + declare_2 + ~section + ~level + ~name:"done_media_type_call_locally" + ~msg:"locally done generic media type call: {method} {uri}" + ("method", Data_encoding.string) + ("uri", Data_encoding.string) diff --git a/src/lib_rpc/RPC_context.ml b/src/lib_rpc/RPC_context.ml index 846c2fdccbb80a9fd3d85a67e769dded11e76837..93f7f3ff8e4100e32f9297208d7868c7af757f7c 100644 --- a/src/lib_rpc/RPC_context.ml +++ b/src/lib_rpc/RPC_context.ml @@ -73,7 +73,7 @@ class type t = inherit streamed end -type ('o, 'e) rest_result = +type ('o, 'e) rest = [ `Ok of 'o | `Conflict of 'e | `Error of 'e @@ -81,7 +81,13 @@ type ('o, 'e) rest_result = | `Not_found of 'e | `Gone of 'e | `Unauthorized of 'e ] - tzresult + +type ('o, 'e) rest_result = ('o, 'e) rest tzresult + +type generic_call_result = + [ `Json of (Data_encoding.json, Data_encoding.json option) rest + | `Binary of (string, string option) rest + | `Other of (string * string) option * (string, string option) rest ] class type json = object @@ -93,6 +99,12 @@ class type json = Uri.t -> (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t + method generic_media_type_call : + RPC_service.meth -> + ?body:Data_encoding.json -> + Uri.t -> + generic_call_result tzresult Lwt.t + method base : Uri.t end diff --git a/src/lib_rpc/RPC_context.mli b/src/lib_rpc/RPC_context.mli index c3779771f36c7cdaeac11f0ea4354b0d750ced00..c237b934d530efe2677cbd11b864c3cc55255f08 100644 --- a/src/lib_rpc/RPC_context.mli +++ b/src/lib_rpc/RPC_context.mli @@ -73,7 +73,8 @@ class type t = inherit streamed end -type ('o, 'e) rest_result = +(** ['o] is the type of the result (output) and ['e] the type of the error *) +type ('o, 'e) rest = [ `Ok of 'o | `Conflict of 'e | `Error of 'e @@ -81,7 +82,16 @@ type ('o, 'e) rest_result = | `Not_found of 'e | `Gone of 'e | `Unauthorized of 'e ] - tzresult + +type ('o, 'e) rest_result = ('o, 'e) rest tzresult + +(** The type of a generic call result *) +type generic_call_result = + [ `Json of (Data_encoding.json, Data_encoding.json option) rest + | `Binary of (string, string option) rest + | `Other of + (string * string) option * (string, string option) rest + (* [(string * string) option] corresponds to the content type *) ] class type json = object @@ -93,6 +103,12 @@ class type json = Uri.t -> (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t + method generic_media_type_call : + RPC_service.meth -> + ?body:Data_encoding.json -> + Uri.t -> + generic_call_result tzresult Lwt.t + method base : Uri.t end diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml index 31deb31793e1a74da8a49a2f19b6f9f78a0c2a2e..59e7dabe56ec7760ef49aa186491522f9a166c81 100644 --- a/src/lib_rpc_http/RPC_client.ml +++ b/src/lib_rpc_http/RPC_client.ml @@ -100,10 +100,18 @@ module type S = sig (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result Lwt.t - type content_type = string * string + type content_type = Media_type.Content_type.t type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option + val generic_media_type_call : + ?headers:(string * string) list -> + accept:Media_type.t list -> + ?body:Data_encoding.json -> + [< RPC_service.meth] -> + Uri.t -> + RPC_context.generic_call_result tzresult Lwt.t + val generic_call : ?headers:(string * string) list -> ?accept:Media_type.t list -> @@ -127,7 +135,7 @@ module Make (Client : Resto_cohttp_client.Client.CALL) = struct let full_logger = Client.full_logger - type content_type = string * string + type content_type = Media_type.Content_type.t type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option @@ -167,106 +175,174 @@ module Make (Client : Resto_cohttp_client.Client.CALL) = struct | `Unauthorized_host host -> request_failed meth uri (Unauthorized_host host) - let handle_error meth uri (body, media, _) f = + let handle_error (body, content_type, _) f = Cohttp_lwt.Body.is_empty body >>= fun empty -> - if empty then return (f None) + if empty then return (content_type, f None) else - match media with + Cohttp_lwt.Body.to_string body >>= fun body -> + return (content_type, f (Some body)) + + let jsonify_other meth uri content_type error : + (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result + Lwt.t = + let jsonify_body string_body = + match content_type with | Some ("application", "json") | None -> ( - Cohttp_lwt.Body.to_string body >>= fun body -> - match Data_encoding.Json.from_string body with - | Ok body -> return (f (Some body)) + match Data_encoding.Json.from_string string_body with + | Ok json_body -> return json_body | Error msg -> request_failed meth uri (Unexpected_content { - content = body; + content = string_body; media_type = Media_type.(name json); error = msg; })) - | Some (l, r) -> - Cohttp_lwt.Body.to_string body >>= fun body -> + | Some content_type -> request_failed meth uri (Unexpected_content_type { - received = l ^ "/" ^ r; + received = + Format.asprintf "%a" Media_type.Content_type.pp content_type; acceptable = [Media_type.(name json)]; - body; + body = string_body; }) + in + let jsonify_body_opt = function + | None -> return_none + | Some string_body -> + jsonify_body string_body >>=? fun json_body -> return_some json_body + in + match error with + | `Conflict s -> jsonify_body_opt s >|=? fun s -> `Conflict s + | `Error s -> jsonify_body_opt s >|=? fun s -> `Error s + | `Forbidden s -> jsonify_body_opt s >|=? fun s -> `Forbidden s + | `Not_found s -> jsonify_body_opt s >|=? fun s -> `Not_found s + | `Gone s -> jsonify_body_opt s >|=? fun s -> `Gone s + | `Unauthorized s -> jsonify_body_opt s >|=? fun s -> `Unauthorized s + | `Ok s -> jsonify_body s >|=? fun s -> `Ok s + + let post_process_error_responses response meth uri accept = + match response with + | `Conflict body -> handle_error body (fun v -> `Conflict v) + | `Error body -> handle_error body (fun v -> `Error v) + | `Forbidden body -> handle_error body (fun v -> `Forbidden v) + | `Not_found body -> + (* The client's proxy mode matches on the `Not_found returned here, + to detect that a local RPC is unavailable at generic_json_call, + and hence that delegation to the endpoint must be done. *) + handle_error body (fun v -> `Not_found v) + | `Gone body -> handle_error body (fun v -> `Gone v) + | `Unauthorized body -> handle_error body (fun v -> `Unauthorized v) + | `Ok (body, (Some _ as content_type), _) -> + Cohttp_lwt.Body.to_string body >>= fun body -> + request_failed + meth + uri + (Unexpected_content_type + { + received = + Format.asprintf + "%a" + (Format.pp_print_option Media_type.Content_type.pp) + content_type; + acceptable = List.map Media_type.name accept; + body; + }) + | `Ok (body, None, _) -> + Cohttp_lwt.Body.to_string body >>= fun body -> return (None, `Ok body) - let generic_json_call ?headers ?body meth uri : - (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result - Lwt.t = + let post_process_json_response ~body meth uri = + match Data_encoding.Json.from_string body with + | Ok json -> return json + | Error msg -> + request_failed + meth + uri + (Unexpected_content + {content = body; media_type = Media_type.(name json); error = msg}) + + let post_process_bson_response ~body meth uri = + match + Json_repr_bson.bytes_to_bson + ~laziness:false + ~copy:false + (Bytes.of_string body) + with + | exception Json_repr_bson.Bson_decoding_error (msg, _, pos) -> + let error = Format.asprintf "(at offset: %d) %s" pos msg in + request_failed + meth + uri + (Unexpected_content + {content = body; media_type = Media_type.(name bson); error}) + | bson -> + return + (Json_repr.convert + (module Json_repr_bson.Repr) + (module Json_repr.Ezjsonm) + bson) + + let generic_json_call ?headers ?body meth uri = let body = Option.map (fun b -> Cohttp_lwt.Body.of_string (Data_encoding.Json.to_string b)) body in let media = Media_type.json in - generic_call meth ?headers ~accept:Media_type.[bson; json] ?body ~media uri - >>=? function - | `Ok (body, (Some ("application", "json") | None), _) -> ( + generic_call ?headers ?body meth ~accept:Media_type.[json; bson] ~media uri + >>=? fun response -> + match response with + | `Ok (body, Some ("application", "json"), _) -> Cohttp_lwt.Body.to_string body >>= fun body -> - match Data_encoding.Json.from_string body with - | Ok json -> return (`Ok json) - | Error msg -> - request_failed - meth - uri - (Unexpected_content - { - content = body; - media_type = Media_type.(name json); - error = msg; - })) - | `Ok (body, Some ("application", "bson"), _) -> ( + post_process_json_response ~body meth uri >>=? fun body -> + return (`Ok body) + | `Ok (body, Some ("application", "bson"), _) -> Cohttp_lwt.Body.to_string body >>= fun body -> - match - Json_repr_bson.bytes_to_bson - ~laziness:false - ~copy:false - (Bytes.of_string body) - with - | exception Json_repr_bson.Bson_decoding_error (msg, _, pos) -> - let error = Format.asprintf "(at offset: %d) %s" pos msg in - request_failed - meth - uri - (Unexpected_content - {content = body; media_type = Media_type.(name bson); error}) - | bson -> - return - (`Ok - (Json_repr.convert - (module Json_repr_bson.Repr) - (module Json_repr.Ezjsonm) - bson))) - | `Ok (body, Some (l, r), _) -> + post_process_bson_response ~body meth uri >>=? fun body -> + return (`Ok body) + | _ -> + post_process_error_responses response meth uri Media_type.[json; bson] + >>=? fun (content_type, other) -> + jsonify_other meth uri content_type other + + (* This function checks that the content type of the answer belongs to accepted ones in [accept]. If not, it is processed as an error. If the answer lacks content-type, the response is decoded as JSON if possible. *) + let generic_media_type_call ?headers ~accept ?body meth uri : + RPC_context.generic_call_result tzresult Lwt.t = + let body = + Option.map + (fun b -> Cohttp_lwt.Body.of_string (Data_encoding.Json.to_string b)) + body + in + let media = Media_type.json in + generic_call meth ?headers ~accept ?body ~media uri >>=? fun response -> + match response with + | `Ok (body, Some ("application", "octet-stream"), _) + when List.mem ~equal:( == ) Media_type.octet_stream accept -> Cohttp_lwt.Body.to_string body >>= fun body -> - request_failed - meth - uri - (Unexpected_content_type - { - received = l ^ "/" ^ r; - acceptable = [Media_type.(name json)]; - body; - }) - | `Conflict body -> handle_error meth uri body (fun v -> `Conflict v) - | `Error body -> handle_error meth uri body (fun v -> `Error v) - | `Forbidden body -> handle_error meth uri body (fun v -> `Forbidden v) - | `Not_found body -> - (* The client's proxy mode matches on the `Not_found returned here, - to detect that a local RPC is unavailable at generic_json_call, - and hence that delegation to the endpoint must be done. *) - handle_error meth uri body (fun v -> `Not_found v) - | `Gone body -> handle_error meth uri body (fun v -> `Gone v) - | `Unauthorized body -> - handle_error meth uri body (fun v -> `Unauthorized v) + return (`Binary (`Ok body)) + | `Ok (body, Some ("application", "json"), _) + when List.mem ~equal:( == ) Media_type.json accept -> + Cohttp_lwt.Body.to_string body >>= fun body -> + post_process_json_response ~body meth uri >>=? fun body -> + return (`Json (`Ok body)) + | `Ok (body, Some ("application", "bson"), _) + when List.mem ~equal:( == ) Media_type.bson accept -> + Cohttp_lwt.Body.to_string body >>= fun body -> + post_process_bson_response ~body meth uri >>=? fun body -> + return (`Json (`Ok body)) + | _ -> ( + post_process_error_responses response meth uri accept + >>=? fun (content_type, other_resp) -> + (* We attempt to decode in JSON. It might + work. *) + jsonify_other meth uri content_type other_resp >>= function + | Ok jsonified -> return (`Json jsonified) + | Error _ -> return (`Other (content_type, other_resp))) let handle accept (meth, uri, ans) = match ans with @@ -382,14 +458,20 @@ module Make (Client : Resto_cohttp_client.Client.CALL) = struct class http_ctxt config media_types : RPC_context.json = let base = config.endpoint in let logger = config.logger in + let call meth uri f = + let path = Uri.path uri and query = Uri.query uri in + let prefix = Uri.path base in + let prefixed_path = if prefix = "" then path else prefix ^ "/" ^ path in + let uri = Uri.with_path base prefixed_path in + let uri = Uri.with_query uri query in + f meth uri + in object method generic_json_call meth ?body uri = - let path = Uri.path uri and query = Uri.query uri in - let prefix = Uri.path base in - let prefixed_path = if prefix = "" then path else prefix ^ "/" ^ path in - let uri = Uri.with_path base prefixed_path in - let uri = Uri.with_query uri query in - generic_json_call meth ?body uri + call meth uri (generic_json_call ?body) + + method generic_media_type_call meth ?body uri = + call meth uri (generic_media_type_call ?body ~accept:config.media_type) method call_service : 'm 'p 'q 'i 'o. diff --git a/src/lib_rpc_http/RPC_client.mli b/src/lib_rpc_http/RPC_client.mli index 2289dfc4585bcf5030d5b22147c698d9ddf92e67..25a45099fc9ab6e8fed53ff7e02d342da01d6a4d 100644 --- a/src/lib_rpc_http/RPC_client.mli +++ b/src/lib_rpc_http/RPC_client.mli @@ -100,6 +100,14 @@ module type S = sig (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result Lwt.t + val generic_media_type_call : + ?headers:(string * string) list -> + accept:Media_type.t list -> + ?body:Data_encoding.json -> + [< Resto.meth] -> + Uri.t -> + RPC_context.generic_call_result tzresult Lwt.t + type content_type = string * string type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option diff --git a/src/lib_rpc_http/media_type.ml b/src/lib_rpc_http/media_type.ml index 64b7dabc84e3adf7e5330b4569663e0ef3eb3f8f..f7d7b9fb167f2dd55fedffde4fd9b94b9e1e850f 100644 --- a/src/lib_rpc_http/media_type.ml +++ b/src/lib_rpc_http/media_type.ml @@ -170,3 +170,21 @@ let encoding : t RPC_encoding.t = ("application/bson", bson); ("application/octet-stream", octet_stream); ] + +module Content_type = struct + type t = string * string + + let json = ("application", "json") + + let bson = ("application", "bson") + + let octet_stream = ("application", "octet-stream") + + let pp fmt (l, r) = Format.fprintf fmt "%s/%s" l r +end + +let of_content_type c = + if c = Content_type.json then Some json + else if c = Content_type.bson then Some bson + else if c = Content_type.octet_stream then Some octet_stream + else None diff --git a/src/lib_rpc_http/media_type.mli b/src/lib_rpc_http/media_type.mli index 33687fe8b3d7f1db1412c4a7d17be5644492bf06..d5711307b412f3c8c687af0fe6c9bf8d37e28c60 100644 --- a/src/lib_rpc_http/media_type.mli +++ b/src/lib_rpc_http/media_type.mli @@ -47,3 +47,17 @@ val accept_header : t list -> string val first_complete_media : t list -> ((string * string) * t) option val encoding : t RPC_encoding.t + +module Content_type : sig + type t = string * string + + val json : t + + val bson : t + + val octet_stream : t + + val pp : Format.formatter -> t -> unit +end + +val of_content_type : Content_type.t -> t option diff --git a/src/proto_001_PtCJ7pwo/lib_client/alpha_client_context.ml b/src/proto_001_PtCJ7pwo/lib_client/alpha_client_context.ml index a6e0c76473d477634f9fd0bb612dca12a781702c..546b29355a3fdfd47ee3e2e9860ec1fc3fd3c5a7 100644 --- a/src/proto_001_PtCJ7pwo/lib_client/alpha_client_context.ml +++ b/src/proto_001_PtCJ7pwo/lib_client/alpha_client_context.ml @@ -43,6 +43,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_002_PsYLVpVv/lib_client/alpha_client_context.ml b/src/proto_002_PsYLVpVv/lib_client/alpha_client_context.ml index a6e0c76473d477634f9fd0bb612dca12a781702c..546b29355a3fdfd47ee3e2e9860ec1fc3fd3c5a7 100644 --- a/src/proto_002_PsYLVpVv/lib_client/alpha_client_context.ml +++ b/src/proto_002_PsYLVpVv/lib_client/alpha_client_context.ml @@ -43,6 +43,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_003_PsddFKi3/lib_client/alpha_client_context.ml b/src/proto_003_PsddFKi3/lib_client/alpha_client_context.ml index a6e0c76473d477634f9fd0bb612dca12a781702c..546b29355a3fdfd47ee3e2e9860ec1fc3fd3c5a7 100644 --- a/src/proto_003_PsddFKi3/lib_client/alpha_client_context.ml +++ b/src/proto_003_PsddFKi3/lib_client/alpha_client_context.ml @@ -43,6 +43,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_004_Pt24m4xi/lib_client/alpha_client_context.ml b/src/proto_004_Pt24m4xi/lib_client/alpha_client_context.ml index 9900abb9045d1c7fd2d1bf6cd8b25b223c7a5208..495d0bc84c36715fde70cc19e4cb0fb2901e80b7 100644 --- a/src/proto_004_Pt24m4xi/lib_client/alpha_client_context.ml +++ b/src/proto_004_Pt24m4xi/lib_client/alpha_client_context.ml @@ -43,6 +43,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_005_PsBabyM1/lib_client/protocol_client_context.ml b/src/proto_005_PsBabyM1/lib_client/protocol_client_context.ml index 448bcd2d61058686a14891641925595aa89a7da6..1d3a15e9fe03e3bd41a5f9a99c650be28101c099 100644 --- a/src/proto_005_PsBabyM1/lib_client/protocol_client_context.ml +++ b/src/proto_005_PsBabyM1/lib_client/protocol_client_context.ml @@ -50,6 +50,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_006_PsCARTHA/lib_client/protocol_client_context.ml b/src/proto_006_PsCARTHA/lib_client/protocol_client_context.ml index 437387a9fb86a8ad2d3570df8e8620acf579c8de..c4633362bed3eed4b36e3ab394af8f61476f2508 100644 --- a/src/proto_006_PsCARTHA/lib_client/protocol_client_context.ml +++ b/src/proto_006_PsCARTHA/lib_client/protocol_client_context.ml @@ -50,6 +50,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml b/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml index 40d5c90dcf8651916e9114730f0cd8c50e6bbce6..cd41a489c7e0f9d9d5c8debed7afd63db2e4dcd7 100644 --- a/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml +++ b/src/proto_007_PsDELPH1/lib_client/protocol_client_context.ml @@ -53,6 +53,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_008_PtEdo2Zk/lib_client/protocol_client_context.ml b/src/proto_008_PtEdo2Zk/lib_client/protocol_client_context.ml index 9aab0e521407486fb7ffcdc0d784b3524e3b0cab..06c2f09263e8225108b664ef8ed0ec0838d82c8a 100644 --- a/src/proto_008_PtEdo2Zk/lib_client/protocol_client_context.ml +++ b/src/proto_008_PtEdo2Zk/lib_client/protocol_client_context.ml @@ -53,6 +53,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_009_PsFLoren/lib_client/protocol_client_context.ml b/src/proto_009_PsFLoren/lib_client/protocol_client_context.ml index 2063d712c00263d80a77a05ef512a2e50f42e09b..3ad8de5d605062d91f33141efa7f01b5299e7530 100644 --- a/src/proto_009_PsFLoren/lib_client/protocol_client_context.ml +++ b/src/proto_009_PsFLoren/lib_client/protocol_client_context.ml @@ -53,6 +53,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_010_PtGRANAD/lib_client/protocol_client_context.ml b/src/proto_010_PtGRANAD/lib_client/protocol_client_context.ml index 2063d712c00263d80a77a05ef512a2e50f42e09b..3ad8de5d605062d91f33141efa7f01b5299e7530 100644 --- a/src/proto_010_PtGRANAD/lib_client/protocol_client_context.ml +++ b/src/proto_010_PtGRANAD/lib_client/protocol_client_context.ml @@ -53,6 +53,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_011_PtHangz2/lib_client/protocol_client_context.ml b/src/proto_011_PtHangz2/lib_client/protocol_client_context.ml index 2063d712c00263d80a77a05ef512a2e50f42e09b..3ad8de5d605062d91f33141efa7f01b5299e7530 100644 --- a/src/proto_011_PtHangz2/lib_client/protocol_client_context.ml +++ b/src/proto_011_PtHangz2/lib_client/protocol_client_context.ml @@ -53,6 +53,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_alpha/lib_client/protocol_client_context.ml b/src/proto_alpha/lib_client/protocol_client_context.ml index 904d95821a480e691828b4343fc3982aaf93e06c..1d2fc145eeb6092b0120050ea42ac9542e3a1501 100644 --- a/src/proto_alpha/lib_client/protocol_client_context.ml +++ b/src/proto_alpha/lib_client/protocol_client_context.ml @@ -53,6 +53,8 @@ class wrap_rpc_context (t : RPC_context.json) : rpc_context = method generic_json_call = t#generic_json_call + method generic_media_type_call = t#generic_media_type_call + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/src/proto_alpha/lib_delegate/test/mockup_simulator/faked_client_context.ml b/src/proto_alpha/lib_delegate/test/mockup_simulator/faked_client_context.ml index 99ef6799821a5cc5e31a2f56e3b8a67b3a2279b7..d5e58d1879992ead8bc6147cba57c9b61898cac0 100644 --- a/src/proto_alpha/lib_delegate/test/mockup_simulator/faked_client_context.ml +++ b/src/proto_alpha/lib_delegate/test/mockup_simulator/faked_client_context.ml @@ -58,6 +58,9 @@ class faked_ctxt (hooks : Faked_services.hooks) (chain_id : Chain_id.t) : method generic_json_call meth ?body uri = local_ctxt#generic_json_call meth ?body uri + method generic_media_type_call meth ?body uri = + local_ctxt#generic_media_type_call meth ?body uri + method call_service : 'm 'p 'q 'i 'o. (([< Resto.meth] as 'm), unit, 'p, 'q, 'i, 'o) RPC_service.t -> diff --git a/tezt/_regressions/rpc/binary_rpc.out b/tezt/_regressions/rpc/binary_rpc.out new file mode 100644 index 0000000000000000000000000000000000000000..828826b25d6c6cc9a71acfeac9cf9cf858828ddc --- /dev/null +++ b/tezt/_regressions/rpc/binary_rpc.out @@ -0,0 +1,12 @@ +tezt/_regressions/rpc/binary_rpc.out + +./tezos-client --media-type json rpc get /chains/main/blocks/head/header/shell +{ "level": 0, "proto": 0, + "predecessor": "BLockGenesisGenesisGenesisGenesisGenesisf79b5d1CoW2", + "timestamp": "[TIMESTAMP]", "validation_pass": 0, + "operations_hash": "LLoZS2LW3rEi7KYU4ouBQtorua37aWWCtpDmv1n2x3xoKi6sVXLWp", + "fitness": [], + "context": "CoVBYdAGWBoDTkiVXJEGX6FQvDN1oGCPJu8STMvaTYdeh7N3KGTz" } + +./tezos-client --media-type binary rpc get /chains/main/blocks/head/header/shell +00000000008fcf233671b6a04fcf679d2a381c2544ea6c1ea29ba6157776ed8424c7ccd00b000000005b37aac4000e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a80000000046eda4bd10fa370d99881852b74be8a0e2f407afb9d4722fefffcfbe76878a66 diff --git a/tezt/tests/RPC_test.ml b/tezt/tests/RPC_test.ml index dac94d83bf902edd11877124646b8c4f9dc244c7..cd052b163e2627c4ce58f9cc34d12b98c2c6f8b6 100644 --- a/tezt/tests/RPC_test.ml +++ b/tezt/tests/RPC_test.ml @@ -916,19 +916,30 @@ let test_blacklist address () = let* _success_resp = Client.rpc GET ["network"; "connections"] client in unit -(* Test RPC with binary mode. *) -let start_binary address = - let node = Node.create ~rpc_host:address [] in +let binary_regression_test () = + let node = Node.create ~rpc_host:"127.0.0.1" [] in let endpoint = Client.(Node node) in let* () = Node.config_init node [] in let* () = Node.identity_generate node in let* () = Node.run node [] in - Client.init ~endpoint ~media_type:Binary () - -let test_client_binary_mode address () = - let* client = start_binary address in - let* _success_resp = Client.rpc GET ["network"; "connections"] client in - unit + let* json_client = Client.init ~endpoint ~media_type:Json () in + let* binary_client = Client.init ~endpoint ~media_type:Binary () in + let call_rpc client = + Client.spawn_rpc + ~hooks + GET + ["chains"; "main"; "blocks"; "head"; "header"; "shell"] + client + |> Process.check_and_read_stdout + in + let* json_result = call_rpc json_client in + let* binary_result = call_rpc binary_client in + let* decoded_binary_result = + Codec.decode ~name:"block_header.shell" binary_result + in + if JSON.unannotate decoded_binary_result = Ezjsonm.from_string json_result + then Lwt.return_unit + else Test.fail "Unexpected binary answer" let test_no_service_at_valid_prefix address () = let node = Node.create ~rpc_host:address [] in @@ -950,6 +961,13 @@ let test_no_service_at_valid_prefix address () = unit let register () = + Regression.register + ~__FILE__ + ~title:"Binary RPC regression tests" + ~tags:["rpc"; "regression"; "binary"] + ~output_file:"binary_rpc" + ~regression_output_path:"tezt/_regressions/rpc/" + binary_regression_test ; let alpha_consensus_threshold = [(["consensus_threshold"], Some "0")] in let alpha_overrides = Some alpha_consensus_threshold in let register_alpha test_mode_tag = @@ -1047,11 +1065,6 @@ let register () = ~title:(mk_title "blacklist" addr) ~tags:["rpc"; "acl"] (test_blacklist addr) ; - Test.register - ~__FILE__ - ~title:(mk_title "client binary mode" addr) - ~tags:["rpc"; "client"; "binary"] - (test_client_binary_mode addr) ; Test.register ~__FILE__ ~title:(mk_title "no_service_at_valid_prefix" addr)