From 0bd31b0c38f615fec7bd77aaa1519011873d1f6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sun, 11 Feb 2018 19:17:39 +0100 Subject: [PATCH] Client refactor: remove last bits of `lib_client_base/client_rpcs.ml` Split between `lib_rpc_http/RPC_client` and `lib_shell_services/Block_services`. --- src/bin_client/main_lib.ml | 8 +- src/lib_client_base/client_commands.ml | 8 +- src/lib_client_base/client_commands.mli | 6 +- src/lib_client_base/client_rpcs.ml | 127 --------------- src/lib_client_base/client_rpcs.mli | 106 ------------- src/lib_rpc_http/RPC_client.ml | 69 ++++++++ src/lib_rpc_http/RPC_client.mli | 57 +++++-- src/lib_shell_services/block_services.ml | 5 + src/lib_shell_services/block_services.mli | 7 + src/proto_alpha/lib_client/alpha.ml | 2 - src/proto_alpha/lib_client/alpha.mli | 2 - .../lib_client/client_baking_blocks.ml | 2 +- .../lib_client/client_baking_blocks.mli | 6 +- .../lib_client/client_baking_endorsement.ml | 4 +- .../lib_client/client_baking_forge.ml | 2 +- .../lib_client/client_baking_forge.mli | 4 +- .../lib_client/client_baking_lib.ml | 2 +- .../lib_client/client_baking_operations.mli | 4 +- .../lib_client/client_baking_revelation.ml | 2 +- .../lib_client/client_baking_revelation.mli | 2 +- .../lib_client/client_proto_context.ml | 10 +- .../lib_client/client_proto_context.mli | 18 +-- .../lib_client/client_proto_contracts.mli | 6 +- .../lib_client/client_proto_programs.ml | 4 +- .../lib_client/client_proto_programs.mli | 14 +- .../lib_client/client_proto_rpcs.ml | 148 +++++++++--------- .../lib_client/client_proto_rpcs.mli | 114 +++++++------- .../lib_client/test/proto_alpha_helpers.ml | 60 +++---- .../lib_client/client_proto_main.ml | 2 +- .../lib_client/client_proto_main.ml | 2 +- .../lib_client/client_proto_main.mli | 2 +- 31 files changed, 339 insertions(+), 466 deletions(-) delete mode 100644 src/lib_client_base/client_rpcs.ml delete mode 100644 src/lib_client_base/client_rpcs.mli diff --git a/src/bin_client/main_lib.ml b/src/bin_client/main_lib.ml index e15ceabe2..8018d64fb 100644 --- a/src/bin_client/main_lib.ml +++ b/src/bin_client/main_lib.ml @@ -50,16 +50,16 @@ let main ?only_commands () = Client_config.parse_config_args (cctxt ~base_dir:Client_commands.default_base_dir ~block:Client_commands.default_block - Client_rpcs.default_config) + RPC_client.default_config) original_args >>=? fun (parsed_config_file, parsed_args, config_commands, remaining) -> - let rpc_config : Client_rpcs.config = { - Client_rpcs.default_config with + let rpc_config : RPC_client.config = { + RPC_client.default_config with host = parsed_config_file.node_addr ; port = parsed_config_file.node_port ; tls = parsed_config_file.tls ; } in - let ctxt = new Client_rpcs.http_ctxt rpc_config in + let ctxt = new RPC_client.http_ctxt rpc_config Media_type.all_media_types in begin match only_commands with | None -> get_commands_for_version ctxt diff --git a/src/lib_client_base/client_commands.ml b/src/lib_client_base/client_commands.ml index 3d8c53e03..9b569cebf 100644 --- a/src/lib_client_base/client_commands.ml +++ b/src/lib_client_base/client_commands.ml @@ -54,13 +54,13 @@ end class type logging_rpcs = object inherit logger - inherit Client_rpcs.ctxt + inherit RPC_client.ctxt end class type full_context = object inherit logger inherit wallet - inherit Client_rpcs.ctxt + inherit RPC_client.ctxt inherit block end @@ -137,12 +137,12 @@ let default_log ~base_dir channel msg = let make_context ?(base_dir = default_base_dir) ?(block = default_block) - ?(rpc_config = Client_rpcs.default_config) + ?(rpc_config = RPC_client.default_config) log = object inherit logger log inherit file_wallet base_dir - inherit Client_rpcs.http_ctxt rpc_config + inherit RPC_client.http_ctxt rpc_config Media_type.all_media_types method block = block end diff --git a/src/lib_client_base/client_commands.mli b/src/lib_client_base/client_commands.mli index 9df021ed5..0c50487ef 100644 --- a/src/lib_client_base/client_commands.mli +++ b/src/lib_client_base/client_commands.mli @@ -38,13 +38,13 @@ end class type logging_rpcs = object inherit logger_sig - inherit Client_rpcs.ctxt + inherit RPC_client.ctxt end class type full_context = object inherit logger_sig inherit wallet - inherit Client_rpcs.ctxt + inherit RPC_client.ctxt inherit block end (** The [full_context] allows the client {!command} handlers to work in @@ -57,7 +57,7 @@ end val make_context : ?base_dir:string -> ?block:Block_services.block -> - ?rpc_config:Client_rpcs.config -> + ?rpc_config:RPC_client.config -> (string -> string -> unit Lwt.t) -> full_context (** [make_context ?config log_fun] builds a context whose logging callbacks call [log_fun section msg], and whose [error] function diff --git a/src/lib_client_base/client_rpcs.ml b/src/lib_client_base/client_rpcs.ml deleted file mode 100644 index c94c61f90..000000000 --- a/src/lib_client_base/client_rpcs.ml +++ /dev/null @@ -1,127 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -module Client = Resto_cohttp.Client.Make(RPC_encoding) - -type config = { - host : string ; - port : int ; - tls : bool ; - logger : RPC_client.logger ; -} - -let config_encoding = - let open Data_encoding in - conv - (fun { host ; port ; tls } -> (host, port, tls)) - (fun (host, port, tls) -> { host ; port ; tls ; logger = RPC_client.null_logger}) - (obj3 - (req "host" string) - (req "port" uint16) - (req "tls" bool)) - -let default_config = { - host = "localhost" ; - port = 8732 ; - tls = false ; - logger = RPC_client.null_logger ; -} - -class type json_ctxt = object - method generic_json_call : - RPC_service.meth -> - ?body:Data_encoding.json -> - Uri.t -> - (Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t -end - -class type service_ctxt = RPC_context.t - -class type ctxt = object - inherit json_ctxt - inherit service_ctxt -end - -class http_ctxt config : ctxt = - let base = - Uri.make - ~scheme:(if config.tls then "https" else "http") - ~host:config.host - ~port:config.port - () in - let logger = config.logger in - object - method generic_json_call meth ?body uri = - let uri = Uri.with_path base (Uri.path uri) in - let uri = Uri.with_query uri (Uri.query uri) in - RPC_client.generic_json_call ~logger meth ?body uri - method call_service - : 'm 'p 'q 'i 'o. - ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t -> - 'p -> 'q -> 'i -> 'o tzresult Lwt.t = - fun service params query body -> - RPC_client.call_service Media_type.all_media_types ~logger ~base service params query body - method call_streamed_service - : 'm 'p 'q 'i 'o. - ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t -> - on_chunk: ('o -> unit) -> - on_close: (unit -> unit) -> - 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = - fun service ~on_chunk ~on_close params query body -> - RPC_client.call_streamed_service Media_type.all_media_types service - ~logger ~base ~on_chunk ~on_close params query body - end - -let call_service (ctxt : #service_ctxt) service params query body = - ctxt#call_service service params query body - -let call_err_service ctxt service params query body = - call_service ctxt service params query body >>=? Lwt.return - -let call_streamed_service (ctxt : #service_ctxt) service param query body = - let stream, push = Lwt_stream.create () in - ctxt#call_streamed_service - ~on_chunk:(fun o -> push (Some o)) ~on_close:(fun () -> push None) - service param query body >>= function - | Error _ as err -> Lwt.return err - | Ok _finalizer -> - return stream - -(* Currified params *) - -let call_service0 ctxt service body = - call_service ctxt service () () body - -let call_service1 ctxt service a1 body = - call_service ctxt service ((), a1) () body - -let call_service2 ctxt service a1 a2 body = - call_service ctxt service (((), a1), a2) () body - -let call_streamed_service0 ctxt service body = - call_streamed_service ctxt service () () body - -let call_streamed_service1 ctxt service a1 body = - call_streamed_service ctxt service ((), a1) () body - -let call_err_service0 ctxt service body = - call_err_service ctxt service () () body - -let call_err_service1 ctxt service a1 body = - call_err_service ctxt service ((), a1) () body - -let call_err_service2 ctxt service a1 a2 body = - call_err_service ctxt service (((), a1), a2) () body - -type block = Block_services.block - -let last_baked_block = function - | `Prevalidation -> `Head 0 - | `Test_prevalidation -> `Test_head 0 - | `Genesis | `Head _ | `Test_head _ | `Hash _ as block -> block diff --git a/src/lib_client_base/client_rpcs.mli b/src/lib_client_base/client_rpcs.mli deleted file mode 100644 index 012e7be50..000000000 --- a/src/lib_client_base/client_rpcs.mli +++ /dev/null @@ -1,106 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -type config = { - host : string ; - port : int ; - tls : bool ; - logger : RPC_client.logger ; -} - -class type json_ctxt = object - method generic_json_call : - RPC_service.meth -> - ?body:Data_encoding.json -> - Uri.t -> - (Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t -end - -class type service_ctxt = RPC_context.t - -class type ctxt = object - inherit json_ctxt - inherit service_ctxt -end - -val default_config: config -class http_ctxt: config -> ctxt - -val call_service: - #service_ctxt -> - ('m, unit, - 'p, 'q, 'i, - 'o) RPC_service.t -> - 'p -> 'q -> 'i -> 'o tzresult Lwt.t - -val call_service0: - #service_ctxt -> - ('m, unit, - unit, unit, 'i, - 'o) RPC_service.t -> - 'i -> 'o tzresult Lwt.t - -val call_service1: - #service_ctxt -> - ('m, unit, - unit * 'a, unit, 'i, - 'o) RPC_service.t -> - 'a -> 'i -> 'o tzresult Lwt.t - -val call_service2: - #service_ctxt -> - ('m, unit, - (unit * 'a) * 'b, unit, 'i, - 'o) RPC_service.t -> - 'a -> 'b -> 'i -> 'o tzresult Lwt.t - -val call_streamed_service0: - #service_ctxt -> - ('m, unit, - unit, unit, 'a, - 'b) RPC_service.t -> - 'a -> 'b Lwt_stream.t tzresult Lwt.t - -val call_streamed_service1: - #service_ctxt -> - ('m, unit, - unit * 'a, unit, 'b, - 'c) RPC_service.t -> - 'a -> 'b -> 'c Lwt_stream.t tzresult Lwt.t - -val call_err_service0: - #service_ctxt -> - ('m, unit, - unit, unit, 'i, - 'o tzresult) RPC_service.t -> - 'i -> 'o tzresult Lwt.t - -val call_err_service1: - #service_ctxt -> - ('m, unit, - unit * 'a, unit, 'i, - 'o tzresult) RPC_service.t -> - 'a -> 'i -> 'o tzresult Lwt.t - -val call_err_service2: - #service_ctxt -> - ('m, unit, - (unit * 'a) * 'b, unit, 'i, - 'o tzresult) RPC_service.t -> - 'a -> 'b -> 'i -> 'o tzresult Lwt.t - -type block = Block_services.block - -val last_baked_block: - block -> [> - | `Genesis - | `Head of int - | `Test_head of int - | `Hash of Block_hash.t - ] diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml index 99f524883..cc7cbfc8c 100644 --- a/src/lib_rpc_http/RPC_client.ml +++ b/src/lib_rpc_http/RPC_client.ml @@ -391,3 +391,72 @@ let call_service Client.call_service ?logger ~base accept service params query body >>= fun ans -> handle accept ans + +type config = { + host : string ; + port : int ; + tls : bool ; + logger : logger ; +} + +let config_encoding = + let open Data_encoding in + conv + (fun { host ; port ; tls } -> (host, port, tls)) + (fun (host, port, tls) -> { host ; port ; tls ; logger = null_logger}) + (obj3 + (req "host" string) + (req "port" uint16) + (req "tls" bool)) + +let default_config = { + host = "localhost" ; + port = 8732 ; + tls = false ; + logger = null_logger ; +} + +class type json_ctxt = object + method generic_json_call : + RPC_service.meth -> + ?body:Data_encoding.json -> + Uri.t -> + (Data_encoding.json, Data_encoding.json option) + rest_result Lwt.t +end + +class type ctxt = object + inherit RPC_context.t + inherit json_ctxt +end + +class http_ctxt config media_types : ctxt = + let base = + Uri.make + ~scheme:(if config.tls then "https" else "http") + ~host:config.host + ~port:config.port + () in + let logger = config.logger in + object + method generic_json_call meth ?body uri = + let uri = Uri.with_path base (Uri.path uri) in + let uri = Uri.with_query uri (Uri.query uri) in + generic_json_call ~logger meth ?body uri + method call_service + : 'm 'p 'q 'i 'o. + ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t -> + 'p -> 'q -> 'i -> 'o tzresult Lwt.t = + fun service params query body -> + call_service media_types + ~logger ~base service params query body + method call_streamed_service + : 'm 'p 'q 'i 'o. + ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t -> + on_chunk: ('o -> unit) -> + on_close: (unit -> unit) -> + 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = + fun service ~on_chunk ~on_close params query body -> + call_streamed_service media_types service + ~logger ~base ~on_chunk ~on_close params query body + end diff --git a/src/lib_rpc_http/RPC_client.mli b/src/lib_rpc_http/RPC_client.mli index 6f2545504..f72342d01 100644 --- a/src/lib_rpc_http/RPC_client.mli +++ b/src/lib_rpc_http/RPC_client.mli @@ -24,6 +24,15 @@ val null_logger: logger val timings_logger: Format.formatter -> logger val full_logger: Format.formatter -> logger +type config = { + host : string ; + port : int ; + tls : bool ; + logger : logger ; +} +val config_encoding: config Data_encoding.t +val default_config: config + type ('o, 'e) rest_result = [ `Ok of 'o | `Conflict of 'e @@ -32,9 +41,21 @@ type ('o, 'e) rest_result = | `Not_found of 'e | `Unauthorized of 'e ] tzresult -type content_type = (string * string) -type raw_content = Cohttp_lwt.Body.t * content_type option -type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option +class type json_ctxt = object + method generic_json_call : + RPC_service.meth -> + ?body:Data_encoding.json -> + Uri.t -> + (Data_encoding.json, Data_encoding.json option) + rest_result Lwt.t +end + +class type ctxt = object + inherit RPC_context.t + inherit json_ctxt +end + +class http_ctxt : config -> Media_type.t list -> ctxt type rpc_error = | Empty_answer @@ -59,19 +80,11 @@ type error += uri: Uri.t ; error: rpc_error } -val generic_call : - ?logger:logger -> - ?accept:Media_type.t list -> - ?body:Cohttp_lwt.Body.t -> - ?media:Media_type.t -> - [< RPC_service.meth ] -> - Uri.t -> (content, content) rest_result Lwt.t +(**/**) -val generic_json_call : - ?logger:logger -> - ?body:Data_encoding.json -> - [< RPC_service.meth ] -> Uri.t -> - (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t +type content_type = (string * string) +type raw_content = Cohttp_lwt.Body.t * content_type option +type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option val call_service : Media_type.t list -> @@ -88,3 +101,17 @@ val call_streamed_service : on_chunk: ('o -> unit) -> on_close: (unit -> unit) -> 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t + +val generic_call : + ?logger:logger -> + ?accept:Media_type.t list -> + ?body:Cohttp_lwt.Body.t -> + ?media:Media_type.t -> + [< RPC_service.meth ] -> + Uri.t -> (content, content) rest_result Lwt.t + +val generic_json_call : + ?logger:logger -> + ?body:Data_encoding.json -> + [< RPC_service.meth ] -> Uri.t -> + (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml index df049a420..c6d9d8106 100644 --- a/src/lib_shell_services/block_services.ml +++ b/src/lib_shell_services/block_services.ml @@ -16,6 +16,11 @@ type block = [ | `Hash of Block_hash.t ] +let last_baked_block = function + | `Prevalidation -> `Head 0 + | `Test_prevalidation -> `Test_head 0 + | `Genesis | `Head _ | `Test_head _ | `Hash _ as block -> block + let parse_block s = try match String.split '~' s with diff --git a/src/lib_shell_services/block_services.mli b/src/lib_shell_services/block_services.mli index d133b2789..bd422ad6d 100644 --- a/src/lib_shell_services/block_services.mli +++ b/src/lib_shell_services/block_services.mli @@ -14,6 +14,13 @@ type block = [ | `Hash of Block_hash.t ] +val last_baked_block: + block -> [> + | `Genesis + | `Head of int + | `Test_head of int + | `Hash of Block_hash.t + ] val parse_block: string -> (block, string) result val to_string: block -> string diff --git a/src/proto_alpha/lib_client/alpha.ml b/src/proto_alpha/lib_client/alpha.ml index 3a8a8e2cd..7027576bd 100644 --- a/src/proto_alpha/lib_client/alpha.ml +++ b/src/proto_alpha/lib_client/alpha.ml @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -module RPCs = Client_rpcs - module Contracts = Client_proto_contracts module Context = Client_proto_context diff --git a/src/proto_alpha/lib_client/alpha.mli b/src/proto_alpha/lib_client/alpha.mli index 2cfc5f1a9..2741de59e 100644 --- a/src/proto_alpha/lib_client/alpha.mli +++ b/src/proto_alpha/lib_client/alpha.mli @@ -7,8 +7,6 @@ (* *) (**************************************************************************) -module RPCs = Client_rpcs - module Contracts : module type of Client_proto_contracts module Context : module type of Client_proto_context diff --git a/src/proto_alpha/lib_client/client_baking_blocks.ml b/src/proto_alpha/lib_client/client_baking_blocks.ml index 8d03d2412..84fd23fdc 100644 --- a/src/proto_alpha/lib_client/client_baking_blocks.ml +++ b/src/proto_alpha/lib_client/client_baking_blocks.ml @@ -70,7 +70,7 @@ let monitor cctxt return (Lwt_stream.map_s convert block_stream) let blocks_from_cycle cctxt block cycle = - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in Client_proto_rpcs.Context.level cctxt block >>=? fun level -> Client_proto_rpcs.Helpers.levels cctxt block cycle >>=? fun (first, last) -> let length = Int32.to_int (Raw_level.diff level.level first) in diff --git a/src/proto_alpha/lib_client/client_baking_blocks.mli b/src/proto_alpha/lib_client/client_baking_blocks.mli index 6032781d2..140f8ef6e 100644 --- a/src/proto_alpha/lib_client/client_baking_blocks.mli +++ b/src/proto_alpha/lib_client/client_baking_blocks.mli @@ -21,21 +21,21 @@ type block_info = { } val info: - #Client_rpcs.ctxt -> + #RPC_context.simple -> ?include_ops:bool -> Block_services.block -> block_info tzresult Lwt.t val compare: block_info -> block_info -> int val monitor: - #Client_rpcs.ctxt -> + #RPC_context.t -> ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list -> ?delay:int -> ?min_date:Time.t -> ?min_heads:int -> ?compare:(block_info -> block_info -> int) -> unit -> block_info list tzresult Lwt_stream.t tzresult Lwt.t val blocks_from_cycle: - #Client_rpcs.ctxt -> + #RPC_context.simple -> Block_services.block -> Cycle.t -> Block_hash.t list tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/client_baking_endorsement.ml b/src/proto_alpha/lib_client/client_baking_endorsement.ml index ef29f7fc1..b5870c47a 100644 --- a/src/proto_alpha/lib_client/client_baking_endorsement.ml +++ b/src/proto_alpha/lib_client/client_baking_endorsement.ml @@ -94,7 +94,7 @@ let get_signing_slots cctxt ?max_priority block delegate level = let inject_endorsement (cctxt : Client_commands.full_context) block level ?async src_sk source slot = - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in Block_services.info cctxt block >>=? fun bi -> Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt block @@ -126,7 +126,7 @@ let check_endorsement cctxt level slot = let forge_endorsement (cctxt : Client_commands.full_context) block ~src_sk ?slot ?max_priority src_pk = - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in let src_pkh = Ed25519.Public_key.hash src_pk in Client_proto_rpcs.Context.next_level cctxt block >>=? fun { level } -> begin diff --git a/src/proto_alpha/lib_client/client_baking_forge.ml b/src/proto_alpha/lib_client/client_baking_forge.ml index 33e2d49c8..641016035 100644 --- a/src/proto_alpha/lib_client/client_baking_forge.ml +++ b/src/proto_alpha/lib_client/client_baking_forge.ml @@ -114,7 +114,7 @@ let forge_block cctxt block ?timestamp ~priority ~seed_nonce_hash ~src_sk () = - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in begin match operations with | None -> diff --git a/src/proto_alpha/lib_client/client_baking_forge.mli b/src/proto_alpha/lib_client/client_baking_forge.mli index f91ec1346..7b1f4cc38 100644 --- a/src/proto_alpha/lib_client/client_baking_forge.mli +++ b/src/proto_alpha/lib_client/client_baking_forge.mli @@ -17,7 +17,7 @@ val generate_seed_nonce: unit -> Nonce.t reveal the aforementionned nonce during the next cycle. *) val inject_block: - #Client_rpcs.ctxt -> + #RPC_context.simple -> ?force:bool -> ?net_id:Net_id.t -> shell_header:Block_header.shell_header -> @@ -36,7 +36,7 @@ type error += | Failed_to_preapply of Tezos_base.Operation.t * error list val forge_block: - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> ?force:bool -> ?operations:Operation.raw list -> diff --git a/src/proto_alpha/lib_client/client_baking_lib.ml b/src/proto_alpha/lib_client/client_baking_lib.ml index 6c1806692..0d4684432 100644 --- a/src/proto_alpha/lib_client/client_baking_lib.ml +++ b/src/proto_alpha/lib_client/client_baking_lib.ml @@ -86,7 +86,7 @@ let reveal_block_nonces (cctxt : Client_commands.full_context) block_hashes = do_reveal cctxt cctxt#block blocks let reveal_nonces cctxt () = - let block = Client_rpcs.last_baked_block cctxt#block in + let block = Block_services.last_baked_block cctxt#block in Client_baking_forge.get_unrevealed_nonces cctxt block >>=? fun nonces -> do_reveal cctxt cctxt#block nonces diff --git a/src/proto_alpha/lib_client/client_baking_operations.mli b/src/proto_alpha/lib_client/client_baking_operations.mli index a3fd6d26f..eb1f0edfb 100644 --- a/src/proto_alpha/lib_client/client_baking_operations.mli +++ b/src/proto_alpha/lib_client/client_baking_operations.mli @@ -16,7 +16,7 @@ type operation = { } val monitor: - #Client_rpcs.ctxt -> + #RPC_context.t -> ?contents:bool -> ?check:bool -> unit -> operation list tzresult Lwt_stream.t tzresult Lwt.t @@ -28,6 +28,6 @@ type valid_endorsement = { } val monitor_endorsement: - #Client_rpcs.ctxt -> + #RPC_context.t -> valid_endorsement tzresult Lwt_stream.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/client_baking_revelation.ml b/src/proto_alpha/lib_client/client_baking_revelation.ml index c01761479..efa23faaa 100644 --- a/src/proto_alpha/lib_client/client_baking_revelation.ml +++ b/src/proto_alpha/lib_client/client_baking_revelation.ml @@ -15,7 +15,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces = List.map (fun (level, nonce) -> Seed_nonce_revelation { level ; nonce }) nonces in - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in Block_services.info rpc_config block >>=? fun bi -> Client_proto_rpcs.Helpers.Forge.Anonymous.operations rpc_config block ~branch:bi.hash operations >>=? fun bytes -> diff --git a/src/proto_alpha/lib_client/client_baking_revelation.mli b/src/proto_alpha/lib_client/client_baking_revelation.mli index 9d82e28e5..d67dd6bad 100644 --- a/src/proto_alpha/lib_client/client_baking_revelation.mli +++ b/src/proto_alpha/lib_client/client_baking_revelation.mli @@ -11,7 +11,7 @@ open Proto_alpha open Tezos_context val inject_seed_nonce_revelation: - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> ?async:bool -> (Raw_level.t * Nonce.t) list -> diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 94b765f9e..6574d2d9e 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -13,10 +13,10 @@ open Tezos_micheline open Client_proto_contracts open Client_keys -let get_balance (rpc : #Client_rpcs.ctxt) block contract = +let get_balance (rpc : #RPC_context.simple) block contract = Client_proto_rpcs.Context.Contract.balance rpc block contract -let get_storage (rpc : #Client_rpcs.ctxt) block contract = +let get_storage (rpc : #RPC_context.simple) block contract = Client_proto_rpcs.Context.Contract.storage rpc block contract let rec find_predecessor rpc_config h n = @@ -28,7 +28,7 @@ let rec find_predecessor rpc_config h n = let get_branch rpc_config block branch = let branch = Option.unopt ~default:0 branch in (* TODO export parameter *) - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in begin match block with | `Head n -> return (`Head (n+branch)) @@ -177,7 +177,7 @@ let get_manager (cctxt : Client_commands.full_context) block source = return (src_name, src_pkh, src_pk, src_sk) let dictate rpc_config block command seckey = - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in Block_services.info rpc_config block >>=? fun { net_id ; hash = branch } -> Client_proto_rpcs.Helpers.Forge.Dictator.operation @@ -190,7 +190,7 @@ let dictate rpc_config block command seckey = assert (Operation_hash.equal oph injected_oph) ; return oph -let set_delegate (cctxt : #Client_rpcs.ctxt) block ~fee contract ~src_pk ~manager_sk opt_delegate = +let set_delegate (cctxt : #RPC_context.simple) block ~fee contract ~src_pk ~manager_sk opt_delegate = delegate_contract cctxt block ~source:contract ~src_pk ~manager_sk ~fee opt_delegate diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index 85720a0c5..e64084521 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -17,7 +17,7 @@ val list_contract_labels : (string * string * string) list tzresult Lwt.t val get_storage : - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> Contract.t -> Script.expr option tzresult Lwt.t @@ -30,13 +30,13 @@ val get_manager : public_key * Client_keys.sk_locator) tzresult Lwt.t val get_balance: - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> Contract.t -> Tez.t tzresult Lwt.t val set_delegate : - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> fee:Tez.tez -> Contract.t -> @@ -66,8 +66,8 @@ val originate_account : ?delegate:public_key_hash -> balance:Tez.tez -> fee:Tez.tez -> - Client_rpcs.block -> - #Client_rpcs.ctxt -> + Block_services.block -> + #RPC_context.simple -> unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t val save_contract : @@ -101,12 +101,12 @@ val originate_contract: val faucet : ?branch:int -> manager_pkh:public_key_hash -> - Client_rpcs.block -> - #Client_rpcs.ctxt -> + Block_services.block -> + #RPC_context.simple -> unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t val transfer : - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> ?branch:int -> source:Contract.t -> @@ -120,7 +120,7 @@ val transfer : (Operation_hash.t * Contract.t list) tzresult Lwt.t val dictate : - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> dictator_operation -> secret_key -> diff --git a/src/proto_alpha/lib_client/client_proto_contracts.mli b/src/proto_alpha/lib_client/client_proto_contracts.mli index 761bfa2fc..c922dc1f0 100644 --- a/src/proto_alpha/lib_client/client_proto_contracts.mli +++ b/src/proto_alpha/lib_client/client_proto_contracts.mli @@ -41,19 +41,19 @@ val list_contracts: (string * string * RawContractAlias.t) list tzresult Lwt.t val get_manager: - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> Contract.t -> public_key_hash tzresult Lwt.t val get_delegate: - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> Contract.t -> public_key_hash tzresult Lwt.t val check_public_key : - #Client_rpcs.ctxt -> + #RPC_context.simple -> Client_proto_rpcs.block -> ?src_pk:public_key -> public_key_hash -> diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 99aec5d67..ffdc936eb 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -92,7 +92,7 @@ let run ~(storage : Michelson_v1_parser.parsed) ~(input : Michelson_v1_parser.parsed) block - (cctxt : #Client_rpcs.ctxt) = + (cctxt : #RPC_context.simple) = Client_proto_rpcs.Helpers.run_code cctxt block program.expanded (storage.expanded, input.expanded, amount) @@ -102,7 +102,7 @@ let trace ~(storage : Michelson_v1_parser.parsed) ~(input : Michelson_v1_parser.parsed) block - (cctxt : #Client_rpcs.ctxt) = + (cctxt : #RPC_context.simple) = Client_proto_rpcs.Helpers.trace_code cctxt block program.expanded (storage.expanded, input.expanded, amount) diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli index 2003349a5..8bff9d365 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.mli +++ b/src/proto_alpha/lib_client/client_proto_programs.mli @@ -19,8 +19,8 @@ val run : program:Michelson_v1_parser.parsed -> storage:Michelson_v1_parser.parsed -> input:Michelson_v1_parser.parsed -> - Client_rpcs.block -> - #Client_rpcs.ctxt -> + Block_services.block -> + #RPC_context.simple -> (Script.expr * Script.expr * (Script.expr * Script.expr option) list option) tzresult Lwt.t val trace : @@ -28,8 +28,8 @@ val trace : program:Michelson_v1_parser.parsed -> storage:Michelson_v1_parser.parsed -> input:Michelson_v1_parser.parsed -> - Client_rpcs.block -> - #Client_rpcs.ctxt -> + Block_services.block -> + #RPC_context.simple -> (Script.expr * Script.expr * (int * Gas.t * Script.expr list) list * (Script.expr * Script.expr option) list option) tzresult Lwt.t val print_run_result : @@ -53,20 +53,20 @@ val hash_and_sign : Michelson_v1_parser.parsed -> Client_keys.sk_locator -> Client_proto_rpcs.block -> - #Client_rpcs.ctxt -> + #RPC_context.simple -> (string * string) tzresult Lwt.t val typecheck_data : data:Michelson_v1_parser.parsed -> ty:Michelson_v1_parser.parsed -> Client_proto_rpcs.block -> - #Client_rpcs.ctxt -> + #RPC_context.simple -> unit tzresult Lwt.t val typecheck_program : Michelson_v1_parser.parsed -> Client_proto_rpcs.block -> - #Client_rpcs.ctxt -> + #RPC_context.simple -> Script_tc_errors.type_map tzresult Lwt.t val print_typecheck_result : diff --git a/src/proto_alpha/lib_client/client_proto_rpcs.ml b/src/proto_alpha/lib_client/client_proto_rpcs.ml index 977c63b5b..96f737646 100644 --- a/src/proto_alpha/lib_client/client_proto_rpcs.ml +++ b/src/proto_alpha/lib_client/client_proto_rpcs.ml @@ -10,19 +10,15 @@ open Proto_alpha open Tezos_context -let call_service0 cctxt s block = - Client_rpcs.call_service0 cctxt - (s Block_services.S.proto_path) block -let call_service1 cctxt s block a1 = - Client_rpcs.call_service1 cctxt - (s Block_services.S.proto_path) block a1 -let call_service2 cctxt s block a1 a2 = - Client_rpcs.call_service2 cctxt - (s Block_services.S.proto_path) block a1 a2 +let make_call1 cctxt s= + RPC_context.make_call1 (s Block_services.S.proto_path) cctxt +let make_call2 cctxt s = + RPC_context.make_call2 (s Block_services.S.proto_path) cctxt +let make_call3 cctxt s = + RPC_context.make_call3 (s Block_services.S.proto_path) cctxt -let call_opt_service2 cctxt s block a1 a2 = - Client_rpcs.call_service2 cctxt - (s Block_services.S.proto_path) block a1 a2 >>= function +let make_opt_call2 cctxt s block a1 q i = + make_call2 cctxt s block a1 q i >>= function | Ok v -> return (Some v) | Error [RPC_context.Not_found _] -> return None | Error _ as err -> Lwt.return err @@ -30,46 +26,46 @@ let call_opt_service2 cctxt s block a1 a2 = type block = Block_services.block let header cctxt block = - call_service1 cctxt Services.header block () + make_call1 cctxt Services.header block () () module Header = struct let priority cctxt block = - call_service1 cctxt Services.Header.priority block () + make_call1 cctxt Services.Header.priority block () () let seed_nonce_hash cctxt block = - call_service1 cctxt Services.Header.seed_nonce_hash block () + make_call1 cctxt Services.Header.seed_nonce_hash block () () end module Constants = struct let errors cctxt block = - call_service1 cctxt Services.Constants.errors block () + make_call1 cctxt Services.Constants.errors block () () let cycle_length cctxt block = - call_service1 cctxt Services.Constants.cycle_length block () + make_call1 cctxt Services.Constants.cycle_length block () () let voting_period_length cctxt block = - call_service1 cctxt Services.Constants.voting_period_length block () + make_call1 cctxt Services.Constants.voting_period_length block () () let time_before_reward cctxt block = - call_service1 cctxt Services.Constants.time_before_reward block () + make_call1 cctxt Services.Constants.time_before_reward block () () let slot_durations cctxt block = - call_service1 cctxt Services.Constants.slot_durations block () + make_call1 cctxt Services.Constants.slot_durations block () () let first_free_baking_slot cctxt block = - call_service1 cctxt Services.Constants.first_free_baking_slot block () + make_call1 cctxt Services.Constants.first_free_baking_slot block () () let max_signing_slot cctxt block = - call_service1 cctxt Services.Constants.max_signing_slot block () + make_call1 cctxt Services.Constants.max_signing_slot block () () let instructions_per_transaction cctxt block = - call_service1 cctxt Services.Constants.max_gas block () + make_call1 cctxt Services.Constants.max_gas block () () let stamp_threshold cctxt block = - call_service1 cctxt Services.Constants.proof_of_work_threshold block () + make_call1 cctxt Services.Constants.proof_of_work_threshold block () () end module Context = struct let level cctxt block = - call_service1 cctxt Services.Context.level block () + make_call1 cctxt Services.Context.level block () () let next_level cctxt block = - call_service1 cctxt Services.Context.next_level block () + make_call1 cctxt Services.Context.next_level block () () let voting_period_kind cctxt block = - call_service1 cctxt Services.Context.voting_period_kind block () + make_call1 cctxt Services.Context.voting_period_kind block () () module Nonce = struct @@ -79,26 +75,26 @@ module Context = struct | Forgotten let get cctxt block level = - call_service2 cctxt Services.Context.Nonce.get block level () + make_call2 cctxt Services.Context.Nonce.get block level () () let hash cctxt block = - call_service1 cctxt Services.Context.Nonce.hash block () + make_call1 cctxt Services.Context.Nonce.hash block () () end module Key = struct let get cctxt block pk_h = - call_service2 cctxt Services.Context.Key.get block pk_h () + make_call2 cctxt Services.Context.Key.get block pk_h () () let list cctxt block = - call_service1 cctxt Services.Context.Key.list block () + make_call1 cctxt Services.Context.Key.list block () () end module Contract = struct let list cctxt b = - call_service1 cctxt Services.Context.Contract.list b () + make_call1 cctxt Services.Context.Contract.list b () () type info = Services.Context.Contract.info = { manager: public_key_hash ; balance: Tez.t ; @@ -108,23 +104,23 @@ module Context = struct counter: int32 ; } let get cctxt b c = - call_service2 cctxt Services.Context.Contract.get b c () + make_call2 cctxt Services.Context.Contract.get b c () () let balance cctxt b c = - call_service2 cctxt Services.Context.Contract.balance b c () + make_call2 cctxt Services.Context.Contract.balance b c () () let manager cctxt b c = - call_service2 cctxt Services.Context.Contract.manager b c () + make_call2 cctxt Services.Context.Contract.manager b c () () let delegate cctxt b c = - call_opt_service2 cctxt Services.Context.Contract.delegate b c () + make_opt_call2 cctxt Services.Context.Contract.delegate b c () () let counter cctxt b c = - call_service2 cctxt Services.Context.Contract.counter b c () + make_call2 cctxt Services.Context.Contract.counter b c () () let spendable cctxt b c = - call_service2 cctxt Services.Context.Contract.spendable b c () + make_call2 cctxt Services.Context.Contract.spendable b c () () let delegatable cctxt b c = - call_service2 cctxt Services.Context.Contract.delegatable b c () + make_call2 cctxt Services.Context.Contract.delegatable b c () () let script cctxt b c = - call_opt_service2 cctxt Services.Context.Contract.script b c () + make_opt_call2 cctxt Services.Context.Contract.script b c () () let storage cctxt b c = - call_opt_service2 cctxt Services.Context.Contract.storage b c () + make_opt_call2 cctxt Services.Context.Contract.storage b c () () end end @@ -132,46 +128,46 @@ end module Helpers = struct let minimal_time cctxt block ?prio () = - call_service1 cctxt Services.Helpers.minimal_timestamp block prio + make_call1 cctxt Services.Helpers.minimal_timestamp block () prio - let typecheck_code cctxt = - call_service1 cctxt Services.Helpers.typecheck_code + let typecheck_code cctxt block = + make_call1 cctxt Services.Helpers.typecheck_code block () let apply_operation cctxt block pred_block hash forged_operation signature = - call_service1 cctxt Services.Helpers.apply_operation - block (pred_block, hash, forged_operation, signature) + make_call1 cctxt Services.Helpers.apply_operation + block () (pred_block, hash, forged_operation, signature) let run_code cctxt block code (storage, input, amount) = - call_service1 cctxt Services.Helpers.run_code - block (code, storage, input, amount, None, None) + make_call1 cctxt Services.Helpers.run_code + block () (code, storage, input, amount, None, None) let trace_code cctxt block code (storage, input, amount) = - call_service1 cctxt Services.Helpers.trace_code - block (code, storage, input, amount, None, None) + make_call1 cctxt Services.Helpers.trace_code + block () (code, storage, input, amount, None, None) - let typecheck_data cctxt = - call_service1 cctxt Services.Helpers.typecheck_data + let typecheck_data cctxt block = + make_call1 cctxt Services.Helpers.typecheck_data block () - let hash_data cctxt = - call_service1 cctxt Services.Helpers.hash_data + let hash_data cctxt block = + make_call1 cctxt Services.Helpers.hash_data block () let level cctxt block ?offset lvl = - call_service2 cctxt Services.Helpers.level block lvl offset + make_call2 cctxt Services.Helpers.level block lvl () offset let levels cctxt block cycle = - call_service2 cctxt Services.Helpers.levels block cycle () + make_call2 cctxt Services.Helpers.levels block cycle () () module Rights = struct type baking_slot = Raw_level.t * int * Time.t type endorsement_slot = Raw_level.t * int let baking_rights_for_delegate cctxt b c ?max_priority ?first_level ?last_level () = - call_service2 cctxt Services.Helpers.Rights.baking_rights_for_delegate - b c (max_priority, first_level, last_level) + make_call2 cctxt Services.Helpers.Rights.baking_rights_for_delegate + b c () (max_priority, first_level, last_level) let endorsement_rights_for_delegate cctxt b c ?max_priority ?first_level ?last_level () = - call_service2 cctxt Services.Helpers.Rights.endorsement_rights_for_delegate - b c (max_priority, first_level, last_level) + make_call2 cctxt Services.Helpers.Rights.endorsement_rights_for_delegate + b c () (max_priority, first_level, last_level) end module Forge = struct @@ -182,8 +178,8 @@ module Helpers = struct let ops = Manager_operations { source ; public_key = sourcePubKey ; counter ; operations ; fee } in - (call_service1 cctxt Services.Helpers.Forge.operations block - ({ branch }, Sourced_operations ops)) + (make_call1 cctxt Services.Helpers.Forge.operations block + () ({ branch }, Sourced_operations ops)) let transaction cctxt block ~branch ~source ?sourcePubKey ~counter ~amount ~destination ?parameters ~fee ()= @@ -214,8 +210,8 @@ module Helpers = struct let operations cctxt block ~branch ~source operations = let ops = Delegate_operations { source ; operations } in - (call_service1 cctxt Services.Helpers.Forge.operations block - ({ branch }, Sourced_operations ops)) + (make_call1 cctxt Services.Helpers.Forge.operations block + () ({ branch }, Sourced_operations ops)) let endorsement cctxt b ~branch ~source ~block ~slot () = operations cctxt b ~branch ~source @@ -233,8 +229,8 @@ module Helpers = struct let operation cctxt block ~branch operation = let op = Dictator_operation operation in - (call_service1 cctxt Services.Helpers.Forge.operations block - ({ branch }, Sourced_operations op)) + (make_call1 cctxt Services.Helpers.Forge.operations block + () ({ branch }, Sourced_operations op)) let activate cctxt b ~branch hash = operation cctxt b ~branch (Activate hash) @@ -244,8 +240,8 @@ module Helpers = struct end module Anonymous = struct let operations cctxt block ~branch operations = - (call_service1 cctxt Services.Helpers.Forge.operations block - ({ branch }, Anonymous_operations operations)) + (make_call1 cctxt Services.Helpers.Forge.operations block + () ({ branch }, Anonymous_operations operations)) let seed_nonce_revelation cctxt block ~branch ~level ~nonce () = operations cctxt block ~branch [Seed_nonce_revelation { level ; nonce }] @@ -261,18 +257,18 @@ module Helpers = struct block ~priority ~seed_nonce_hash ?(proof_of_work_nonce = empty_proof_of_work_nonce) () = - call_service1 cctxt Services.Helpers.Forge.block_proto_header - block (priority, seed_nonce_hash, proof_of_work_nonce) + make_call1 cctxt Services.Helpers.Forge.block_proto_header + block () (priority, seed_nonce_hash, proof_of_work_nonce) end module Parse = struct let operations cctxt block ?check operations = - call_service1 cctxt - Services.Helpers.Parse.operations block (operations, check) + make_call1 cctxt + Services.Helpers.Parse.operations block () (operations, check) let block cctxt block shell proto = - call_service1 cctxt + make_call1 cctxt Services.Helpers.Parse.block block - ({ shell ; proto } : Block_header.raw) + () ({ shell ; proto } : Block_header.raw) end end @@ -280,8 +276,8 @@ end (* raw_level * int * timestamp option *) (* let baking_possibilities *) (* b c ?max_priority ?first_level ?last_level () = *) -(* call_service2 Services.Helpers.Context.Contract.baking_possibilities *) +(* make_call2 Services.Helpers.Context.Contract.baking_possibilities *) (* b c (max_priority, first_level, last_level) *) (* (\* let endorsement_possibilities b c ?max_priority ?first_level ?last_level () = *\) *) -(* call_service2 Services.Helpers.Context.Contract.endorsement_possibilities *) +(* make_call2 Services.Helpers.Context.Contract.endorsement_possibilities *) (* b c (max_priority, first_level, last_level) *) diff --git a/src/proto_alpha/lib_client/client_proto_rpcs.mli b/src/proto_alpha/lib_client/client_proto_rpcs.mli index 3f2180452..961e03090 100644 --- a/src/proto_alpha/lib_client/client_proto_rpcs.mli +++ b/src/proto_alpha/lib_client/client_proto_rpcs.mli @@ -13,89 +13,89 @@ open Tezos_context type block = Block_services.block val header: - #Client_rpcs.ctxt -> block -> Block_header.t tzresult Lwt.t + #RPC_context.simple -> block -> Block_header.t tzresult Lwt.t module Header : sig val priority: - #Client_rpcs.ctxt -> block -> int tzresult Lwt.t + #RPC_context.simple -> block -> int tzresult Lwt.t val seed_nonce_hash: - #Client_rpcs.ctxt -> block -> Nonce_hash.t tzresult Lwt.t + #RPC_context.simple -> block -> Nonce_hash.t tzresult Lwt.t end module Constants : sig val errors: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Json_schema.schema tzresult Lwt.t val cycle_length: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> int32 tzresult Lwt.t val voting_period_length: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> int32 tzresult Lwt.t val time_before_reward: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Period.t tzresult Lwt.t val slot_durations: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> (Period.t list) tzresult Lwt.t val first_free_baking_slot: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> int tzresult Lwt.t val max_signing_slot: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> int tzresult Lwt.t val instructions_per_transaction: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> int tzresult Lwt.t val stamp_threshold: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> int64 tzresult Lwt.t end module Context : sig val level: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Level.t tzresult Lwt.t (** [level cctxt blk] returns the (protocol view of the) level of [blk]. *) val next_level: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Level.t tzresult Lwt.t (** [next_level cctxt blk] returns the (protocol view of the) level of the successor of [blk]. *) val voting_period_kind: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Voting_period.kind tzresult Lwt.t (** [voting_period_kind cctxt blk] returns the voting period kind of [blk]. *) module Nonce : sig val hash: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Nonce_hash.t tzresult Lwt.t type nonce_info = | Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten val get: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Raw_level.t -> nonce_info tzresult Lwt.t end module Key : sig val get : - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> public_key_hash -> (public_key_hash * public_key) tzresult Lwt.t val list : - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> ((public_key_hash * public_key) list) tzresult Lwt.t end module Contract : sig val list: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t list tzresult Lwt.t type info = { manager: public_key_hash ; @@ -106,92 +106,92 @@ module Context : sig counter: int32 ; } val get: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> info tzresult Lwt.t val balance: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> Tez.t tzresult Lwt.t val manager: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> public_key_hash tzresult Lwt.t val delegate: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> public_key_hash option tzresult Lwt.t val counter: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> int32 tzresult Lwt.t val spendable: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> bool tzresult Lwt.t val delegatable: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> bool tzresult Lwt.t val script: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> Script.t option tzresult Lwt.t val storage: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Contract.t -> Script.expr option tzresult Lwt.t end end module Helpers : sig val minimal_time: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> ?prio:int -> unit -> Time.t tzresult Lwt.t (** [minimal_time cctxt blk ?prio ()] is the minimal acceptable timestamp for the successor of [blk]. [?prio] defaults to [0]. *) val apply_operation: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Block_hash.t -> Operation_hash.t -> MBytes.t -> Ed25519.Signature.t option -> (Contract.t list) tzresult Lwt.t val run_code: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Script.expr -> (Script.expr * Script.expr * Tez.t) -> (Script.expr * Script.expr * (Script.expr * Script.expr option) list option) tzresult Lwt.t val trace_code: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Script.expr -> (Script.expr * Script.expr * Tez.t) -> (Script.expr * Script.expr * (Script.location * Gas.t * Script.expr list) list * (Script.expr * Script.expr option) list option) tzresult Lwt.t val typecheck_code: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Script.expr -> Script_tc_errors.type_map tzresult Lwt.t val typecheck_data: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Script.expr * Script.expr -> unit tzresult Lwt.t val hash_data: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Script.expr * Script.expr -> string tzresult Lwt.t val level: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> ?offset:int32 -> Raw_level.t -> Level.t tzresult Lwt.t val levels: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Cycle.t -> (Raw_level.t * Raw_level.t) tzresult Lwt.t module Rights : sig type baking_slot = Raw_level.t * int * Time.t type endorsement_slot = Raw_level.t * int val baking_rights_for_delegate: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> public_key_hash -> ?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> unit -> (baking_slot list) tzresult Lwt.t val endorsement_rights_for_delegate: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> public_key_hash -> ?max_priority:int -> ?first_level:Raw_level.t -> ?last_level:Raw_level.t -> unit -> (endorsement_slot list) tzresult Lwt.t @@ -200,7 +200,7 @@ module Helpers : sig module Forge : sig module Manager : sig val operations: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:Contract.t -> @@ -210,7 +210,7 @@ module Helpers : sig manager_operation list -> MBytes.t tzresult Lwt.t val transaction: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:Contract.t -> @@ -222,7 +222,7 @@ module Helpers : sig fee:Tez.t -> unit -> MBytes.t tzresult Lwt.t val origination: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:Contract.t -> @@ -238,7 +238,7 @@ module Helpers : sig unit -> MBytes.t tzresult Lwt.t val delegation: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:Contract.t -> @@ -250,19 +250,19 @@ module Helpers : sig end module Dictator : sig val operation: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> dictator_operation -> MBytes.t tzresult Lwt.t val activate: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> Protocol_hash.t -> MBytes.t tzresult Lwt.t val activate_testnet: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> Protocol_hash.t -> @@ -270,14 +270,14 @@ module Helpers : sig end module Delegate : sig val operations: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:public_key -> delegate_operation list -> MBytes.t tzresult Lwt.t val endorsement: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:public_key -> @@ -285,7 +285,7 @@ module Helpers : sig slot:int -> unit -> MBytes.t tzresult Lwt.t val proposals: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:public_key -> @@ -293,7 +293,7 @@ module Helpers : sig proposals:Protocol_hash.t list -> unit -> MBytes.t tzresult Lwt.t val ballot: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> source:public_key -> @@ -304,27 +304,27 @@ module Helpers : sig end module Anonymous : sig val operations: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> anonymous_operation list -> MBytes.t tzresult Lwt.t val seed_nonce_revelation: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> level:Raw_level.t -> nonce:Nonce.t -> unit -> MBytes.t tzresult Lwt.t val faucet: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> branch:Block_hash.t -> id:public_key_hash -> unit -> MBytes.t tzresult Lwt.t end val block_proto_header: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> priority: int -> seed_nonce_hash: Nonce_hash.t -> @@ -334,11 +334,11 @@ module Helpers : sig module Parse : sig val operations: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> ?check:bool -> Operation.raw list -> Operation.t list tzresult Lwt.t val block: - #Client_rpcs.ctxt -> + #RPC_context.simple -> block -> Block_header.shell_header -> MBytes.t -> Block_header.proto_header tzresult Lwt.t end diff --git a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml index 3f6226447..7a7b9e564 100644 --- a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml @@ -15,15 +15,18 @@ let (//) = Filename.concat let () = Random.self_init () let rpc_config = ref { - Client_rpcs.host = "localhost" ; + RPC_client.host = "localhost" ; port = 8192 + Random.int 8192 ; tls = false ; logger = RPC_client.null_logger ; } +let rpc_ctxt = + ref (new RPC_client.http_ctxt !rpc_config Media_type.all_media_types) + (* Context that does not write to alias files *) let no_write_context config block : Client_commands.full_context = object - inherit Client_rpcs.http_ctxt config + inherit RPC_client.http_ctxt config Media_type.all_media_types inherit Client_commands.logger (fun _ _ -> Lwt.return_unit) method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t = fun _ ~default _ -> return default @@ -40,7 +43,7 @@ let activate_alpha () = ~scheme:"unencrypted" ~location:"edsk31vznjHSSpGExDMHYASz45VZqXN4DPxvsa4hAyY8dHM28cZzp6" in Tezos_client_genesis.Client_proto_main.bake - (new Client_rpcs.http_ctxt !rpc_config) (`Head 0) + !rpc_ctxt (`Head 0) (Activate { protocol = Client_proto_main.protocol ; fitness }) dictator_sk @@ -49,7 +52,10 @@ let init ?exe ?(sandbox = "sandbox.json") ?rpc_port () = begin match rpc_port with | None -> () - | Some port -> rpc_config := { !rpc_config with port } + | Some port -> + rpc_config := { !rpc_config with port } ; + rpc_ctxt := + new RPC_client.http_ctxt !rpc_config Media_type.all_media_types ; end ; let pid = Node_helpers.fork_node @@ -61,7 +67,7 @@ let init ?exe ?(sandbox = "sandbox.json") ?rpc_port () = return (pid, hash) let level block = - Client_proto_rpcs.Context.level (new Client_rpcs.http_ctxt !rpc_config) block + Client_proto_rpcs.Context.level !rpc_ctxt block module Account = struct @@ -164,7 +170,7 @@ module Account = struct let src_sk = Client_keys.Secret_key_locator.create ~scheme:"unencrypted" ~location:(Ed25519.Secret_key.to_b58check account.sk) in - Client_proto_context.transfer (new Client_rpcs.http_ctxt !rpc_config) + Client_proto_context.transfer !rpc_ctxt block ~source:account.contract ~src_pk:account.pk @@ -197,7 +203,7 @@ module Account = struct ?delegate ~fee block - (new Client_rpcs.http_ctxt !rpc_config) + !rpc_ctxt () let set_delegate @@ -208,7 +214,7 @@ module Account = struct ~src_pk delegate_opt = Client_proto_context.set_delegate - (new Client_rpcs.http_ctxt !rpc_config) + !rpc_ctxt block ~fee contract @@ -217,12 +223,12 @@ module Account = struct delegate_opt let balance ?(block = `Prevalidation) (account : t) = - Client_proto_rpcs.Context.Contract.balance (new Client_rpcs.http_ctxt !rpc_config) + Client_proto_rpcs.Context.Contract.balance !rpc_ctxt block account.contract (* TODO: gather contract related functions in a Contract module? *) let delegate ?(block = `Prevalidation) (contract : Contract.t) = - Client_proto_rpcs.Context.Contract.delegate (new Client_rpcs.http_ctxt !rpc_config) + Client_proto_rpcs.Context.Contract.delegate !rpc_ctxt block contract end @@ -232,12 +238,12 @@ module Protocol = struct open Account let voting_period_kind ?(block = `Prevalidation) () = - Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block + Client_proto_rpcs.Context.voting_period_kind !rpc_ctxt block let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals = - Block_services.info (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_info -> - Client_proto_rpcs.Context.next_level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun next_level -> - Client_proto_rpcs.Helpers.Forge.Delegate.proposals (new Client_rpcs.http_ctxt !rpc_config) block + Block_services.info !rpc_ctxt block >>=? fun block_info -> + Client_proto_rpcs.Context.next_level !rpc_ctxt block >>=? fun next_level -> + Client_proto_rpcs.Helpers.Forge.Delegate.proposals !rpc_ctxt block ~branch:block_info.hash ~source:pk ~period:next_level.voting_period @@ -247,7 +253,7 @@ module Protocol = struct return (Tezos_base.Operation.of_bytes_exn signed_bytes) let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot = - let rpc = new Client_rpcs.http_ctxt !rpc_config in + let rpc = new RPC_client.http_ctxt !rpc_config Media_type.all_media_types in Block_services.info rpc block >>=? fun block_info -> Client_proto_rpcs.Context.next_level rpc block >>=? fun next_level -> Client_proto_rpcs.Helpers.Forge.Delegate.ballot rpc block @@ -397,7 +403,7 @@ module Assert = struct end let check_protocol ?msg ~block h = - Block_services.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto -> + Block_services.protocol !rpc_ctxt block >>=? fun block_proto -> return @@ equal ?msg ~prn:Protocol_hash.to_b58check @@ -405,7 +411,7 @@ module Assert = struct block_proto h let check_voting_period_kind ?msg ~block kind = - Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block + Client_proto_rpcs.Context.voting_period_kind !rpc_ctxt block >>=? fun current_kind -> return @@ equal ?msg @@ -431,7 +437,7 @@ module Baking = struct ~scheme:"unencrypted" ~location:(Ed25519.Secret_key.to_b58check contract.sk) in Client_baking_forge.forge_block - (new Client_rpcs.http_ctxt !rpc_config) + !rpc_ctxt block ~operations ~force:true @@ -443,7 +449,7 @@ module Baking = struct () let endorsement_reward block = - Client_proto_rpcs.Header.priority (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun prio -> + Client_proto_rpcs.Header.priority !rpc_ctxt block >>=? fun prio -> Baking.endorsement_reward ~block_priority:prio >|= Environment.wrap_error >>|? Tez.to_mutez @@ -457,8 +463,8 @@ module Endorse = struct src_sk source slot = - let block = Client_rpcs.last_baked_block block in - let rpc = new Client_rpcs.http_ctxt !rpc_config in + let block = Block_services.last_baked_block block in + let rpc = new RPC_client.http_ctxt !rpc_config Media_type.all_media_types in Block_services.info rpc block >>=? fun { hash ; _ } -> Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc block @@ -476,7 +482,7 @@ module Endorse = struct delegate level = Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate - (new Client_rpcs.http_ctxt !rpc_config) ~max_priority ~first_level:level ~last_level:level + !rpc_ctxt ~max_priority ~first_level:level ~last_level:level block delegate () >>=? fun possibilities -> let slots = List.map (fun (_,slot) -> slot) @@ -487,7 +493,7 @@ module Endorse = struct ?slot (contract : Account.t) block = - Client_proto_rpcs.Context.next_level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun { level } -> + Client_proto_rpcs.Context.next_level !rpc_ctxt block >>=? fun { level } -> begin match slot with | Some slot -> return slot @@ -506,7 +512,7 @@ module Endorse = struct let endorsers_list block = let get_endorser_list result (account : Account.t) level block = Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate - (new Client_rpcs.http_ctxt !rpc_config) block account.pkh + !rpc_ctxt block account.pkh ~max_priority:16 ~first_level:level ~last_level:level () >>|? fun slots -> @@ -514,7 +520,7 @@ module Endorse = struct in let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in let result = Array.make 16 b1 in - Client_proto_rpcs.Context.level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun level -> + Client_proto_rpcs.Context.level !rpc_ctxt block >>=? fun level -> let level = Raw_level.succ @@ level.level in get_endorser_list result b1 level block >>=? fun () -> get_endorser_list result b2 level block >>=? fun () -> @@ -526,7 +532,7 @@ module Endorse = struct let endorsement_rights ?(max_priority = 1024) (contract : Account.t) block = - let rpc = new Client_rpcs.http_ctxt !rpc_config in + let rpc = new RPC_client.http_ctxt !rpc_config Media_type.all_media_types in Client_proto_rpcs.Context.level rpc block >>=? fun level -> let delegate = contract.pkh in let level = level.level in @@ -540,6 +546,6 @@ module Endorse = struct end let display_level block = - Client_proto_rpcs.Context.level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun lvl -> + Client_proto_rpcs.Context.level !rpc_ctxt block >>=? fun lvl -> Format.eprintf "Level: %a@." Level.pp_full lvl ; return () diff --git a/src/proto_demo/lib_client/client_proto_main.ml b/src/proto_demo/lib_client/client_proto_main.ml index 6f37a0943..5b90e7a24 100644 --- a/src/proto_demo/lib_client/client_proto_main.ml +++ b/src/proto_demo/lib_client/client_proto_main.ml @@ -34,7 +34,7 @@ let demo cctxt = return () let bake cctxt = - let block = Client_rpcs.last_baked_block cctxt.Client_commands.config.block in + let block = Block_services.last_baked_block cctxt.Client_commands.config.block in Client_node_rpcs.Blocks.info cctxt.rpc_config block >>=? fun bi -> let fitness = match bi.fitness with diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index 817edc654..5cfedf7c1 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -14,7 +14,7 @@ let protocol = "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" let bake rpc_config ?(timestamp = Time.now ()) block command sk = - let block = Client_rpcs.last_baked_block block in + let block = Block_services.last_baked_block block in let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in Block_services.preapply rpc_config block ~timestamp ~proto_header [] >>=? fun { shell_header } -> diff --git a/src/proto_genesis/lib_client/client_proto_main.mli b/src/proto_genesis/lib_client/client_proto_main.mli index fc6ba06af..f4cba3993 100644 --- a/src/proto_genesis/lib_client/client_proto_main.mli +++ b/src/proto_genesis/lib_client/client_proto_main.mli @@ -10,7 +10,7 @@ open Proto_genesis val bake: - #Client_rpcs.ctxt -> + #RPC_context.simple -> ?timestamp: Time.t -> Block_services.block -> Data.Command.t ->