diff --git a/src/bin_client/jbuild b/src/bin_client/jbuild index 4b1ea9a7d..af2d9e39f 100644 --- a/src/bin_client/jbuild +++ b/src/bin_client/jbuild @@ -5,6 +5,7 @@ (public_names (tezos-client tezos-admin)) (libraries (tezos-base tezos-rpc-http + tezos-shell-services tezos-client-base tezos-client-genesis tezos-client-alpha)) @@ -12,6 +13,7 @@ -safe-string -open Tezos_base__TzPervasives -open Tezos_rpc_http + -open Tezos_shell_services -open Tezos_client_base -linkall)))) diff --git a/src/bin_client/main_lib.ml b/src/bin_client/main_lib.ml index b9fd088c8..e15ceabe2 100644 --- a/src/bin_client/main_lib.ml +++ b/src/bin_client/main_lib.ml @@ -13,7 +13,7 @@ let cctxt ~base_dir ~block rpc_config = Client_commands.make_context ~base_dir ~block ~rpc_config (Client_commands.default_log ~base_dir) let get_commands_for_version ctxt block protocol = - Client_node_rpcs.Blocks.protocol ctxt block >>= function + Block_services.protocol ctxt block >>= function | Ok version -> begin match protocol with | None -> diff --git a/src/lib_client_base/client_admin.ml b/src/lib_client_base/client_admin.ml index 0b12315a5..4d392aa12 100644 --- a/src/lib_client_base/client_admin.ml +++ b/src/lib_client_base/client_admin.ml @@ -18,6 +18,6 @@ let commands () = @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list" @@ stop) (fun () block (cctxt : Client_commands.full_context) -> - Client_rpcs.call_err_service0 cctxt Block_services.unmark_invalid block >>=? fun () -> + Block_services.unmark_invalid cctxt block >>=? fun () -> cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ; ] diff --git a/src/lib_client_base/client_debug.ml b/src/lib_client_base/client_debug.ml index baa91e8fe..6c175056b 100644 --- a/src/lib_client_base/client_debug.ml +++ b/src/lib_client_base/client_debug.ml @@ -62,14 +62,10 @@ let registered_protocols ppf = (Client_commands.get_versions ()) let print_heads ppf cctxt = - Client_rpcs.call_service0 cctxt Block_services.list - { include_ops = true ; - length = Some 1 ; - heads = None ; - monitor = None ; - delay = None ; - min_date = None ; - min_heads = None } >>=? fun heads -> + Block_services.list + ~include_ops:true + ~length:1 + cctxt >>=? fun heads -> return @@ Format.pp_print_list ~pp_sep:Format.pp_print_newline (fun ppf blocks -> @@ -81,8 +77,7 @@ let print_heads ppf cctxt = ppf heads let print_rejected ppf cctxt = - Client_rpcs.call_service0 cctxt - Block_services.list_invalid () >>=? fun invalid -> + Block_services.list_invalid cctxt >>=? fun invalid -> return @@ Format.pp_print_list (fun ppf (hash, level, errors) -> diff --git a/src/lib_client_base/client_node_rpcs.ml b/src/lib_client_base/client_node_rpcs.ml index ff363f73e..4c5683984 100644 --- a/src/lib_client_base/client_node_rpcs.ml +++ b/src/lib_client_base/client_node_rpcs.ml @@ -39,98 +39,13 @@ let complete cctxt ?block prefix = | None -> call_service1 cctxt Shell_services.complete prefix () | Some block -> - call_service2 cctxt Block_services.complete block prefix () + Block_services.complete cctxt block prefix let describe cctxt ?(recurse = true) path = Client_rpcs.call_service cctxt Shell_services.describe ((), path) { recurse } () -module Blocks = struct - - type block = Block_services.block - - type block_info = Block_services.block_info = { - hash: Block_hash.t ; - net_id: Net_id.t ; - level: Int32.t ; - proto_level: int ; (* uint8 *) - predecessor: Block_hash.t ; - timestamp: Time.t ; - validation_passes: int ; (* uint8 *) - operations_hash: Operation_list_list_hash.t ; - fitness: MBytes.t list ; - context: Context_hash.t ; - data: MBytes.t ; - operations: (Operation_hash.t * Operation.t) list list option ; - protocol: Protocol_hash.t ; - test_network: Test_network_status.t; - } - type preapply_param = Block_services.preapply_param = { - timestamp: Time.t ; - proto_header: MBytes.t ; - operations: Operation.t list list ; - sort_operations: bool ; - } - type preapply_result = Block_services.preapply_result = { - shell_header: Block_header.shell_header ; - operations: error Preapply_result.t list ; - } - let net_id cctxt h = - call_service1 cctxt Block_services.net_id h () - let level cctxt h = - call_service1 cctxt Block_services.level h () - let predecessor cctxt h = - call_service1 cctxt Block_services.predecessor h () - let predecessors cctxt h l = - call_service1 cctxt Block_services.predecessors h l - let hash cctxt h = - call_service1 cctxt Block_services.hash h () - let timestamp cctxt h = - call_service1 cctxt Block_services.timestamp h () - let fitness cctxt h = - call_service1 cctxt Block_services.fitness h () - let operations cctxt ?(contents = false) h = - call_service1 cctxt Block_services.operations h - { contents ; monitor = false } - let protocol cctxt h = - call_service1 cctxt Block_services.protocol h () - let test_network cctxt h = - call_service1 cctxt Block_services.test_network h () - - let preapply cctxt h - ?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations = - call_err_service1 - cctxt Block_services.preapply h - { timestamp ; proto_header ; sort_operations = sort ; operations } - let pending_operations cctxt block = - call_service1 cctxt Block_services.pending_operations block () - let info cctxt ?(include_ops = true) h = - call_service1 cctxt Block_services.info h include_ops - let complete cctxt block prefix = - call_service2 cctxt Block_services.complete block prefix () - let list cctxt ?(include_ops = false) - ?length ?heads ?delay ?min_date ?min_heads () = - call_service0 cctxt Block_services.list - { include_ops ; length ; heads ; monitor = Some false ; delay ; - min_date ; min_heads } - let monitor cctxt ?(include_ops = false) - ?length ?heads ?delay ?min_date ?min_heads () = - call_streamed_service0 cctxt Block_services.list - { include_ops ; length ; heads ; monitor = Some true ; delay ; - min_date ; min_heads } - -end - -module Operations = struct - - let monitor cctxt ?(contents = false) () = - call_streamed_service1 cctxt Block_services.operations - `Prevalidation - { contents ; monitor = true } - -end - module Protocols = struct let contents cctxt hash = diff --git a/src/lib_client_base/client_node_rpcs.mli b/src/lib_client_base/client_node_rpcs.mli index 59e9f93ac..8da7160c3 100644 --- a/src/lib_client_base/client_node_rpcs.mli +++ b/src/lib_client_base/client_node_rpcs.mli @@ -38,105 +38,6 @@ val inject_protocol: Protocol.t -> Protocol_hash.t tzresult Lwt.t -module Blocks : sig - - type block = Block_services.block - - val net_id: - #Client_rpcs.ctxt -> - block -> Net_id.t tzresult Lwt.t - val level: - #Client_rpcs.ctxt -> - block -> Int32.t tzresult Lwt.t - val predecessor: - #Client_rpcs.ctxt -> - block -> Block_hash.t tzresult Lwt.t - val predecessors: - #Client_rpcs.ctxt -> - block -> int -> Block_hash.t list tzresult Lwt.t - val hash: - #Client_rpcs.ctxt -> - block -> Block_hash.t tzresult Lwt.t - val timestamp: - #Client_rpcs.ctxt -> - block -> Time.t tzresult Lwt.t - val fitness: - #Client_rpcs.ctxt -> - block -> MBytes.t list tzresult Lwt.t - val operations: - #Client_rpcs.ctxt -> - ?contents:bool -> - block -> (Operation_hash.t * Operation.t option) list list tzresult Lwt.t - val protocol: - #Client_rpcs.ctxt -> - block -> Protocol_hash.t tzresult Lwt.t - val test_network: - #Client_rpcs.ctxt -> - block -> Test_network_status.t tzresult Lwt.t - - val pending_operations: - #Client_rpcs.ctxt -> - block -> - (error Preapply_result.t * Operation.t Operation_hash.Map.t) tzresult Lwt.t - - type block_info = { - hash: Block_hash.t ; - net_id: Net_id.t ; - level: Int32.t ; - proto_level: int ; (* uint8 *) - predecessor: Block_hash.t ; - timestamp: Time.t ; - validation_passes: int ; (* uint8 *) - operations_hash: Operation_list_list_hash.t ; - fitness: MBytes.t list ; - context: Context_hash.t ; - data: MBytes.t ; - operations: (Operation_hash.t * Operation.t) list list option ; - protocol: Protocol_hash.t ; - test_network: Test_network_status.t ; - } - - val info: - #Client_rpcs.ctxt -> - ?include_ops:bool -> block -> block_info tzresult Lwt.t - - val list: - #Client_rpcs.ctxt -> - ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list -> - ?delay:int -> ?min_date:Time.t -> ?min_heads:int -> - unit -> block_info list list tzresult Lwt.t - - val monitor: - #Client_rpcs.ctxt -> - ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list -> - ?delay:int -> ?min_date:Time.t -> ?min_heads:int -> - unit -> block_info list list Lwt_stream.t tzresult Lwt.t - - type preapply_result = { - shell_header: Block_header.shell_header ; - operations: error Preapply_result.t list ; - } - - val preapply: - #Client_rpcs.ctxt -> - block -> - ?timestamp:Time.t -> - ?sort:bool -> - proto_header:MBytes.t -> - Operation.t list list -> preapply_result tzresult Lwt.t - -end - -module Operations : sig - - val monitor: - #Client_rpcs.ctxt -> - ?contents:bool -> - unit -> - (Operation_hash.t * Operation.t option) list list Lwt_stream.t tzresult Lwt.t - -end - module Protocols : sig val contents: @@ -171,7 +72,7 @@ end val complete: #Client_rpcs.ctxt -> - ?block:Blocks.block -> string -> string list tzresult Lwt.t + ?block:Block_services.block -> string -> string list tzresult Lwt.t val describe: #Client_rpcs.ctxt -> diff --git a/src/lib_client_base/client_rpcs.ml b/src/lib_client_base/client_rpcs.ml index 047378e10..c94c61f90 100644 --- a/src/lib_client_base/client_rpcs.ml +++ b/src/lib_client_base/client_rpcs.ml @@ -41,18 +41,7 @@ class type json_ctxt = object (Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t end -class type service_ctxt = object - method call_service : - 'm 'p 'q 'i 'o 'e. - ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t -> - 'p -> 'q -> 'i -> 'o tzresult Lwt.t - method call_streamed_service : - 'm 'p 'q 'i 'o 'e. - ([< 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 -end +class type service_ctxt = RPC_context.t class type ctxt = object inherit json_ctxt @@ -73,13 +62,13 @@ class http_ctxt config : ctxt = 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 'e. + : '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 'e. + : '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) -> diff --git a/src/lib_client_base/client_rpcs.mli b/src/lib_client_base/client_rpcs.mli index 74540e3fb..012e7be50 100644 --- a/src/lib_client_base/client_rpcs.mli +++ b/src/lib_client_base/client_rpcs.mli @@ -22,18 +22,7 @@ class type json_ctxt = object (Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t end -class type service_ctxt = object - method call_service : - 'm 'p 'q 'i 'o 'e. - ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t -> - 'p -> 'q -> 'i -> 'o tzresult Lwt.t - method call_streamed_service : - 'm 'p 'q 'i 'o 'e. - ([< 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 -end +class type service_ctxt = RPC_context.t class type ctxt = object inherit json_ctxt diff --git a/src/lib_rpc/RPC_context.ml b/src/lib_rpc/RPC_context.ml new file mode 100644 index 000000000..876f8d76c --- /dev/null +++ b/src/lib_rpc/RPC_context.ml @@ -0,0 +1,114 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Error_monad + +class type simple = object + 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 +end + +class type streamed = object + 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 +end + +class type t = object + inherit simple + inherit streamed +end + +type error += + | Not_found of { meth: RPC_service.meth ; + uri: Uri.t } + | Generic_error of { meth: RPC_service.meth ; + uri: Uri.t } + +let base = Uri.make ~scheme:"ocaml" () +let not_found s p q = + let { RPC_service.meth ; uri ; _ } = + RPC_service.forge_request s ~base p q in + fail (Not_found { meth ; uri }) + +let generic_error s p q = + let { RPC_service.meth ; uri ; _ } = + RPC_service.forge_request s ~base p q in + fail (Generic_error { meth ; uri }) + +let of_directory (dir : unit RPC_directory.t) : t = object + 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 s p q i -> + RPC_directory.transparent_lookup dir s p q i >>= function + | `Ok v -> return v + | `OkStream { next ; shutdown } -> begin + next () >>= function + | Some v -> shutdown () ; return v + | None -> shutdown () ; not_found s p q + end + | `Not_found None -> not_found s p q + | `Unauthorized _ + | `Error _ + | `Not_found _ + | `Forbidden _ + | `Created _ + | `Conflict _ + | `No_content -> generic_error s p q + 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 s ~on_chunk ~on_close p q i -> + RPC_directory.transparent_lookup dir s p q i >>= function + | `OkStream { next; shutdown } -> + let rec loop () = + next () >>= function + | None -> on_close () ; Lwt.return_unit + | Some v -> on_chunk v ; loop () in + let _ = loop () in + return shutdown + | `Ok v -> + on_chunk v ; on_close () ; + return (fun () -> ()) + | `Not_found None -> not_found s p q + | `Unauthorized _ + | `Error _ + | `Not_found (Some _) + | `Forbidden _ + | `Created _ + | `Conflict _ + | `No_content -> generic_error s p q +end + +let make_call s (ctxt : #simple) = ctxt#call_service s +let make_call1 s ctxt x = make_call s ctxt ((), x) +let make_call2 s ctxt x y = make_call s ctxt (((), x), y) +let make_call3 s ctxt x y z = make_call s ctxt ((((), x), y), z) + +let make_err_call s ctxt p q i = + make_call s ctxt p q i >>=? Lwt.return +let make_err_call1 s ctxt x = make_err_call s ctxt ((), x) +let make_err_call2 s ctxt x y = make_err_call s ctxt (((), x), y) + +type stopper = unit -> unit + +let make_streamed_call s (ctxt : #streamed) p q i = + let stream, push = Lwt_stream.create () in + let on_chunk v = push (Some v) + and on_close () = push None in + ctxt#call_streamed_service s ~on_chunk ~on_close p q i >>=? fun close -> + return (stream, close) diff --git a/src/lib_rpc/RPC_context.mli b/src/lib_rpc/RPC_context.mli new file mode 100644 index 000000000..44d96fba5 --- /dev/null +++ b/src/lib_rpc/RPC_context.mli @@ -0,0 +1,74 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Error_monad + +class type simple = object + 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 +end + +class type streamed = object + 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 +end + +class type t = object + inherit simple + inherit streamed +end + +val of_directory : unit RPC_directory.t -> t + +type error += + | Not_found of { meth: RPC_service.meth ; + uri: Uri.t } + | Generic_error of { meth: RPC_service.meth ; + uri: Uri.t } + +val make_call : + ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t -> + #simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t + +val make_call1 : + ([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o) RPC_service.t -> + #simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t + +val make_call2 : + ([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + #simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t + +val make_call3 : + ([< Resto.meth ], unit, ((unit * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> + #simple -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t + +val make_err_call : + ([< Resto.meth ], unit, 'p, 'q, 'i, 'o tzresult) RPC_service.t -> + #simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t + +val make_err_call1 : + ([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o tzresult) RPC_service.t -> + #simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t + +val make_err_call2 : + ([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o tzresult) RPC_service.t -> + #simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t + +type stopper = unit -> unit + +val make_streamed_call : + ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t -> + #streamed -> 'p -> 'q -> 'i -> + ('o Lwt_stream.t * stopper) tzresult Lwt.t diff --git a/src/lib_rpc_http/RPC_client.ml b/src/lib_rpc_http/RPC_client.ml index 30ed545e2..cc4f71265 100644 --- a/src/lib_rpc_http/RPC_client.ml +++ b/src/lib_rpc_http/RPC_client.ml @@ -27,10 +27,9 @@ 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 -type rest_error = +type rpc_error = | Empty_answer | Connection_failed of string - | Not_found | Bad_request of string | Method_not_allowed of RPC_service.meth list | Unsupported_media_type of string option @@ -45,9 +44,8 @@ type rest_error = media_type: string ; error: string } | OCaml_exception of string - | Generic_error (* temporary *) -let rest_error_encoding = +let rpc_error_encoding = let open Data_encoding in union [ case (Tag 0) @@ -135,7 +133,7 @@ let rest_error_encoding = (function ((), msg) -> OCaml_exception msg) ; ] -let pp_rest_error ppf err = +let pp_rpc_error ppf err = match err with | Empty_answer -> Format.fprintf ppf @@ -143,9 +141,6 @@ let pp_rest_error ppf err = | Connection_failed msg -> Format.fprintf ppf "Unable to connect to the node: \"%s\"" msg - | Not_found -> - Format.fprintf ppf - "404 Not Found" | Bad_request msg -> Format.fprintf ppf "@[Oups! It looks like we forged an invalid HTTP request.@,%s@]" @@ -187,14 +182,11 @@ let pp_rest_error ppf err = Format.fprintf ppf "@[The server failed with an unexpected exception:@ %s@]" msg - | Generic_error -> - Format.fprintf ppf - "Generic error" type error += | Request_failed of { meth: RPC_service.meth ; uri: Uri.t ; - error: rest_error } + error: rpc_error } let uri_encoding = let open Data_encoding in @@ -216,11 +208,11 @@ let () = \ - error: %a@]" (RPC_service.string_of_meth meth) (Uri.to_string uri) - pp_rest_error error) + pp_rpc_error error) Data_encoding.(obj3 (req "meth" RPC_service.meth_encoding) (req "uri" uri_encoding) - (req "error" rest_error_encoding)) + (req "error" rpc_error_encoding)) (function | Request_failed { uri ; error ; meth } -> Some (meth, uri, error) | _ -> None) @@ -338,10 +330,10 @@ let handle accept (meth, uri, ans) = match ans with | `Ok (Some v) -> return v | `Ok None -> request_failed meth uri Empty_answer - | `Not_found None -> request_failed meth uri Not_found + | `Not_found None -> fail (RPC_context.Not_found { meth ; uri }) | `Conflict _ | `Error _ | `Forbidden _ | `Unauthorized _ | `Not_found (Some _) -> - request_failed meth uri Generic_error + fail (RPC_context.Generic_error { meth ; uri }) | `Unexpected_status_code (code, (content, _, media_type)) -> let media_type = Option.map media_type ~f:Media_type.name in Cohttp_lwt.Body.to_string content >>= fun content -> diff --git a/src/lib_rpc_http/RPC_client.mli b/src/lib_rpc_http/RPC_client.mli index 54edd611c..6f2545504 100644 --- a/src/lib_rpc_http/RPC_client.mli +++ b/src/lib_rpc_http/RPC_client.mli @@ -36,10 +36,9 @@ 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 -type rest_error = +type rpc_error = | Empty_answer | Connection_failed of string - | Not_found | Bad_request of string | Method_not_allowed of RPC_service.meth list | Unsupported_media_type of string option @@ -54,12 +53,11 @@ type rest_error = media_type: string ; error: string } | OCaml_exception of string - | Generic_error (* temporary *) type error += | Request_failed of { meth: RPC_service.meth ; uri: Uri.t ; - error: rest_error } + error: rpc_error } val generic_call : ?logger:logger -> diff --git a/src/lib_shell/node_rpc.ml b/src/lib_shell/node_rpc.ml index bdb4c38be..1905a7e0d 100644 --- a/src/lib_shell/node_rpc.ml +++ b/src/lib_shell/node_rpc.ml @@ -42,65 +42,65 @@ let register_bi_dir node dir = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return (filter_bi include_ops bi) in RPC_directory.register1 dir - Block_services.info implementation in + Block_services.S.info implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.hash in RPC_directory.register1 dir - Block_services.hash + Block_services.S.hash implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.net_id in RPC_directory.register1 dir - Block_services.net_id implementation in + Block_services.S.net_id implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.level in RPC_directory.register1 dir - Block_services.level implementation in + Block_services.S.level implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.predecessor in RPC_directory.register1 dir - Block_services.predecessor implementation in + Block_services.S.predecessor implementation in let dir = let implementation b () len = Node.RPC.block_info node b >>= fun bi -> Node.RPC.predecessors node len bi.hash >>= fun hashes -> RPC_answer.return hashes in RPC_directory.register1 dir - Block_services.predecessors implementation in + Block_services.S.predecessors implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.fitness in RPC_directory.register1 dir - Block_services.fitness implementation in + Block_services.S.fitness implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.timestamp in RPC_directory.register1 dir - Block_services.timestamp implementation in + Block_services.S.timestamp implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.protocol in RPC_directory.register1 dir - Block_services.protocol implementation in + Block_services.S.protocol implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> RPC_answer.return bi.test_network in RPC_directory.register1 dir - Block_services.test_network implementation in + Block_services.S.test_network implementation in let dir = - let implementation b () { Block_services.contents ; monitor } = + let implementation b () { Block_services.S.contents ; monitor } = match b with | `Prevalidation when monitor -> monitor_operations node contents @@ -115,18 +115,18 @@ let register_bi_dir node dir = List.map (List.map (fun h -> h, None)) hashes in RPC_directory.register1 dir - Block_services.operations implementation in + Block_services.S.operations implementation in let dir = let implementation b () () = Node.RPC.pending_operations node b >>= fun res -> RPC_answer.return res in RPC_directory.register1 dir - Block_services.pending_operations + Block_services.S.pending_operations implementation in let dir = let implementation b () - { Block_services.operations ; sort_operations ; + { Block_services.S.operations ; sort_operations ; timestamp ; proto_header} = Node.RPC.preapply node b ~timestamp ~proto_header ~sort_operations operations >>= function @@ -135,7 +135,7 @@ let register_bi_dir node dir = (Ok { Block_services.shell_header ; operations }) | Error _ as err -> RPC_answer.return err in RPC_directory.register1 dir - Block_services.preapply implementation in + Block_services.S.preapply implementation in dir let rec insert_future_block (bi: Block_services.block_info) = function @@ -236,7 +236,7 @@ let create_delayed_stream let list_blocks node () - { Block_services.include_ops ; length ; heads ; monitor ; delay ; + { Block_services.S.include_ops ; length ; heads ; monitor ; delay ; min_date; min_heads} = let len = match length with None -> 1 | Some x -> x in let monitor = match monitor with None -> false | Some x -> x in @@ -327,7 +327,7 @@ let list_invalid node () () = Node.RPC.list_invalid node >>= fun l -> RPC_answer.return l -let unmark_invalid node () block = +let unmark_invalid node block () () = Node.RPC.unmark_invalid node block >>= fun x -> RPC_answer.return x @@ -370,13 +370,13 @@ let get_protocols node hash () () = let build_rpc_directory node = let dir = RPC_directory.empty in let dir = - RPC_directory.register0 dir Block_services.list + RPC_directory.register0 dir Block_services.S.list (list_blocks node) in let dir = - RPC_directory.register0 dir Block_services.list_invalid + RPC_directory.register0 dir Block_services.S.list_invalid (list_invalid node) in let dir = - RPC_directory.register0 dir Block_services.unmark_invalid + RPC_directory.register1 dir Block_services.S.unmark_invalid (unmark_invalid node) in let dir = register_bi_dir node dir in let dir = @@ -389,7 +389,7 @@ let build_rpc_directory node = RPC_directory.register_dynamic_directory1 ~descr: "All the RPCs which are specific to the protocol version." - dir Block_services.proto_path implementation in + dir Block_services.S.proto_path implementation in let dir = RPC_directory.register0 dir Protocol_services.list (list_protocols node) in @@ -442,7 +442,7 @@ let build_rpc_directory node = (fun s () () -> Node.RPC.complete node s >>= RPC_answer.return) in let dir = - RPC_directory.register2 dir Block_services.complete + RPC_directory.register2 dir Block_services.S.complete (fun block s () () -> Node.RPC.complete node ~block s >>= RPC_answer.return) in diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml index 65f53c37f..71b9e1fb6 100644 --- a/src/lib_shell_services/block_services.ml +++ b/src/lib_shell_services/block_services.ml @@ -16,6 +16,30 @@ type block = [ | `Hash of Block_hash.t ] +let parse_block s = + try + match String.split '~' s with + | ["genesis"] -> Ok `Genesis + | ["head"] -> Ok (`Head 0) + | ["prevalidation"] -> Ok `Prevalidation + | ["test_head"] -> Ok (`Test_head 0) + | ["test_prevalidation"] -> Ok `Test_prevalidation + | ["head"; n] -> Ok (`Head (int_of_string n)) + | ["test_head"; n] -> Ok (`Test_head (int_of_string n)) + | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h)) + | _ -> raise Exit + with _ -> Error "Cannot parse block identifier." + +let to_string = function + | `Genesis -> "genesis" + | `Head 0 -> "head" + | `Head n -> Printf.sprintf "head~%d" n + | `Prevalidation -> "prevalidation" + | `Test_head 0 -> "test_head" + | `Test_head n -> Printf.sprintf "test_head~%d" n + | `Test_prevalidation -> "test_prevalidation" + | `Hash h -> Block_hash.to_b58check h + type block_info = { hash: Block_hash.t ; net_id: Net_id.t ; @@ -70,214 +94,6 @@ let block_info_encoding = Test_network_status.encoding Not_running)) Block_header.encoding)) -let parse_block s = - try - match String.split '~' s with - | ["genesis"] -> Ok `Genesis - | ["head"] -> Ok (`Head 0) - | ["prevalidation"] -> Ok `Prevalidation - | ["test_head"] -> Ok (`Test_head 0) - | ["test_prevalidation"] -> Ok `Test_prevalidation - | ["head"; n] -> Ok (`Head (int_of_string n)) - | ["test_head"; n] -> Ok (`Test_head (int_of_string n)) - | [h] -> Ok (`Hash (Block_hash.of_b58check_exn h)) - | _ -> raise Exit - with _ -> Error "Cannot parse block identifier." - -let to_string = function - | `Genesis -> "genesis" - | `Head 0 -> "head" - | `Head n -> Printf.sprintf "head~%d" n - | `Prevalidation -> "prevalidation" - | `Test_head 0 -> "test_head" - | `Test_head n -> Printf.sprintf "test_head~%d" n - | `Test_prevalidation -> "test_prevalidation" - | `Hash h -> Block_hash.to_b58check h - -let blocks_arg = - let name = "block_id" in - let descr = - "A block identifier. This is either a block hash in hexadecimal \ - notation or a one the predefined aliases: \ - 'genesis', 'head', 'prevalidation', \ - 'test_head' or 'test_prevalidation'. One might alse use 'head~N' - to 'test_head~N', where N is an integer to denotes the Nth predecessors - of 'head' or 'test_head'." in - let construct = to_string in - let destruct = parse_block in - RPC_arg.make ~name ~descr ~construct ~destruct () - -let block_path : (unit, unit * block) RPC_path.path = - RPC_path.(root / "blocks" /: blocks_arg ) - -let info = - RPC_service.post_service - ~description:"All the information about a block." - ~query: RPC_query.empty - ~input: (obj1 (dft "operations" bool true)) - ~output: block_info_encoding - block_path - -let net_id = - RPC_service.post_service - ~description:"Returns the net of the chain in which the block belongs." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "net_id" Net_id.encoding)) - RPC_path.(block_path / "net_id") - -let level = - RPC_service.post_service - ~description:"Returns the block's level." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "level" int32)) - RPC_path.(block_path / "level") - -let predecessor = - RPC_service.post_service - ~description:"Returns the previous block's id." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "predecessor" Block_hash.encoding)) - RPC_path.(block_path / "predecessor") - -let predecessors = - RPC_service.post_service - ~description: - "...." - ~query: RPC_query.empty - ~input: (obj1 (req "length" Data_encoding.uint16)) - ~output: (obj1 - (req "blocks" (Data_encoding.list Block_hash.encoding))) - RPC_path.(block_path / "predecessors") - -let hash = - RPC_service.post_service - ~description:"Returns the block's id." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "hash" Block_hash.encoding)) - RPC_path.(block_path / "hash") - -let fitness = - RPC_service.post_service - ~description:"Returns the block's fitness." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "fitness" Fitness.encoding)) - RPC_path.(block_path / "fitness") - -let context = - RPC_service.post_service - ~description:"Returns the hash of the resulting context." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "context" Context_hash.encoding)) - RPC_path.(block_path / "context") - -let timestamp = - RPC_service.post_service - ~description:"Returns the block's timestamp." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "timestamp" Time.encoding)) - RPC_path.(block_path / "timestamp") - -type operations_param = { - contents: bool ; - monitor: bool ; -} - -let operations_param_encoding = - let open Data_encoding in - conv - (fun { contents ; monitor } -> (contents, monitor)) - (fun (contents, monitor) -> { contents ; monitor }) - (obj2 - (dft "contents" bool false) - (dft "monitor" bool false)) - -let operations = - RPC_service.post_service - ~description:"List the block operations." - ~query: RPC_query.empty - ~input: operations_param_encoding - ~output: (obj1 - (req "operations" - (list (list - (obj2 - (req "hash" Operation_hash.encoding) - (opt "contents" - (dynamic_size Operation.encoding))))))) - RPC_path.(block_path / "operations") - -let protocol = - RPC_service.post_service - ~description:"List the block protocol." - ~query: RPC_query.empty - ~input: empty - ~output: (obj1 (req "protocol" Protocol_hash.encoding)) - RPC_path.(block_path / "protocol") - -let test_network = - RPC_service.post_service - ~description:"Returns the status of the associated test network." - ~query: RPC_query.empty - ~input: empty - ~output: Test_network_status.encoding - RPC_path.(block_path / "test_network") - -let pending_operations = - let operation_encoding = - merge_objs - (obj1 (req "hash" Operation_hash.encoding)) - Operation.encoding in - (* TODO: branch_delayed/... *) - RPC_service.post_service - ~description: - "List the not-yet-prevalidated operations." - ~query: RPC_query.empty - ~input: empty - ~output: - (conv - (fun (preapplied, unprocessed) -> - ({ preapplied with - Preapply_result.refused = Operation_hash.Map.empty }, - Operation_hash.Map.bindings unprocessed)) - (fun (preapplied, unprocessed) -> - (preapplied, - List.fold_right - (fun (h, op) m -> Operation_hash.Map.add h op m) - unprocessed Operation_hash.Map.empty)) - (merge_objs - (dynamic_size - (Preapply_result.encoding RPC_error.encoding)) - (obj1 (req "unprocessed" (list (dynamic_size operation_encoding)))))) - RPC_path.(block_path / "pending_operations") - -let proto_path = - RPC_path.(block_path / "proto") - -type preapply_param = { - timestamp: Time.t ; - proto_header: MBytes.t ; - operations: Operation.t list list ; - sort_operations: bool ; -} - -let preapply_param_encoding = - (conv - (fun { timestamp ; proto_header ; operations ; sort_operations } -> - (timestamp, proto_header, operations, sort_operations)) - (fun (timestamp, proto_header, operations, sort_operations) -> - { timestamp ; proto_header ; operations ; sort_operations }) - (obj4 - (req "timestamp" Time.encoding) - (req "proto_header" bytes) - (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding))))) - (dft "sort_operations" bool false))) - type preapply_result = { shell_header: Block_header.shell_header ; operations: error Preapply_result.t list ; @@ -294,125 +110,359 @@ let preapply_result_encoding = (req "operations" (list (Preapply_result.encoding RPC_error.encoding))))) -let preapply = - RPC_service.post_service - ~description: - "Simulate the validation of a block that would contain \ - the given operations and return the resulting fitness." - ~query: RPC_query.empty - ~input: preapply_param_encoding - ~output: (RPC_error.wrap preapply_result_encoding) - RPC_path.(block_path / "preapply") +module S = struct -let complete = - let prefix_arg = - let destruct s = Ok s - and construct s = s in - RPC_arg.make ~name:"prefix" ~destruct ~construct () in - RPC_service.post_service - ~description: "Try to complete a prefix of a Base58Check-encoded data. \ - This RPC is actually able to complete hashes of \ - block, operations, public_keys and contracts." - ~query: RPC_query.empty - ~input: empty - ~output: (list string) - RPC_path.(block_path / "complete" /: prefix_arg ) + let blocks_arg = + let name = "block_id" in + let descr = + "A block identifier. This is either a block hash in hexadecimal \ + notation or a one the predefined aliases: \ + 'genesis', 'head', 'prevalidation', \ + 'test_head' or 'test_prevalidation'. One might alse use 'head~N' + to 'test_head~N', where N is an integer to denotes the Nth predecessors + of 'head' or 'test_head'." in + let construct = to_string in + let destruct = parse_block in + RPC_arg.make ~name ~descr ~construct ~destruct () -type list_param = { - include_ops: bool ; - length: int option ; - heads: Block_hash.t list option ; - monitor: bool option ; - delay: int option ; - min_date: Time.t option; - min_heads: int option; -} -let list_param_encoding = - conv - (fun { include_ops ; length ; heads ; monitor ; - delay ; min_date ; min_heads } -> - (include_ops, length, heads, monitor, delay, min_date, min_heads)) - (fun (include_ops, length, heads, monitor, - delay, min_date, min_heads) -> - { include_ops ; length ; heads ; monitor ; - delay ; min_date ; min_heads }) - (obj7 - (dft "include_ops" - (Data_encoding.describe - ~description: - "Whether the resulting block informations should include the \ - list of operations' hashes. Default false." - bool) false) - (opt "length" - (Data_encoding.describe - ~description: - "The requested number of predecessors to returns (per \ - requested head)." - int31)) - (opt "heads" - (Data_encoding.describe - ~description: - "An empty argument requests blocks from the current heads. \ - A non empty list allow to request specific fragment \ - of the chain." - (list Block_hash.encoding))) - (opt "monitor" - (Data_encoding.describe - ~description: - "When true, the socket is \"kept alive\" after the first \ - answer and new heads are streamed when discovered." - bool)) - (opt "delay" - (Data_encoding.describe - ~description: - "By default only the blocks that were validated by the node \ - are considered. \ - When this optional argument is 0, only blocks with a \ - timestamp in the past are considered. Other values allows to \ - adjust the current time." - int31)) - (opt "min_date" - (Data_encoding.describe - ~description: "When `min_date` is provided, heads with a \ - timestamp before `min_date` are filtered ouf" - Time.encoding)) - (opt "min_heads" - (Data_encoding.describe - ~description:"When `min_date` is provided, returns at least \ - `min_heads` even when their timestamp is before \ - `min_date`." - int31))) + let block_path : (unit, unit * block) RPC_path.path = + RPC_path.(root / "blocks" /: blocks_arg ) -let list = - RPC_service.post_service - ~description: - "Lists known heads of the blockchain sorted with decreasing fitness. \ - Optional arguments allows to returns the list of predecessors for \ - known heads or the list of predecessors for a given list of blocks." - ~query: RPC_query.empty - ~input: list_param_encoding - ~output: (obj1 (req "blocks" (list (list block_info_encoding)))) - RPC_path.(root / "blocks") + let info = + RPC_service.post_service + ~description:"All the information about a block." + ~query: RPC_query.empty + ~input: (obj1 (dft "operations" bool true)) + ~output: block_info_encoding + block_path -let list_invalid = - RPC_service.post_service - ~description: - "Lists blocks that have been declared invalid along with the errors\ - that led to them being declared invalid" - ~query: RPC_query.empty - ~input:empty - ~output:(Data_encoding.list - (obj3 - (req "block" Block_hash.encoding) - (req "level" int32) - (req "errors" RPC_error.encoding))) - RPC_path.(root / "invalid_blocks") + let net_id = + RPC_service.post_service + ~description:"Returns the net of the chain in which the block belongs." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "net_id" Net_id.encoding)) + RPC_path.(block_path / "net_id") -let unmark_invalid = - RPC_service.post_service - ~description: - "Unmark an invalid block" - ~query: RPC_query.empty - ~input:Data_encoding.(obj1 (req "block" Block_hash.encoding)) - ~output:(RPC_error.wrap Data_encoding.empty) - RPC_path.(root / "unmark_invalid") + let level = + RPC_service.post_service + ~description:"Returns the block's level." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "level" int32)) + RPC_path.(block_path / "level") + + let predecessor = + RPC_service.post_service + ~description:"Returns the previous block's id." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "predecessor" Block_hash.encoding)) + RPC_path.(block_path / "predecessor") + + let predecessors = + RPC_service.post_service + ~description: + "...." + ~query: RPC_query.empty + ~input: (obj1 (req "length" Data_encoding.uint16)) + ~output: (obj1 + (req "blocks" (Data_encoding.list Block_hash.encoding))) + RPC_path.(block_path / "predecessors") + + let hash = + RPC_service.post_service + ~description:"Returns the block's id." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "hash" Block_hash.encoding)) + RPC_path.(block_path / "hash") + + let fitness = + RPC_service.post_service + ~description:"Returns the block's fitness." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "fitness" Fitness.encoding)) + RPC_path.(block_path / "fitness") + + let context = + RPC_service.post_service + ~description:"Returns the hash of the resulting context." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "context" Context_hash.encoding)) + RPC_path.(block_path / "context") + + let timestamp = + RPC_service.post_service + ~description:"Returns the block's timestamp." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "timestamp" Time.encoding)) + RPC_path.(block_path / "timestamp") + + type operations_param = { + contents: bool ; + monitor: bool ; + } + + let operations_param_encoding = + let open Data_encoding in + conv + (fun { contents ; monitor } -> (contents, monitor)) + (fun (contents, monitor) -> { contents ; monitor }) + (obj2 + (dft "contents" bool false) + (dft "monitor" bool false)) + + let operations = + RPC_service.post_service + ~description:"List the block operations." + ~query: RPC_query.empty + ~input: operations_param_encoding + ~output: (obj1 + (req "operations" + (list (list + (obj2 + (req "hash" Operation_hash.encoding) + (opt "contents" + (dynamic_size Operation.encoding))))))) + RPC_path.(block_path / "operations") + + let protocol = + RPC_service.post_service + ~description:"List the block protocol." + ~query: RPC_query.empty + ~input: empty + ~output: (obj1 (req "protocol" Protocol_hash.encoding)) + RPC_path.(block_path / "protocol") + + let test_network = + RPC_service.post_service + ~description:"Returns the status of the associated test network." + ~query: RPC_query.empty + ~input: empty + ~output: Test_network_status.encoding + RPC_path.(block_path / "test_network") + + let pending_operations = + let operation_encoding = + merge_objs + (obj1 (req "hash" Operation_hash.encoding)) + Operation.encoding in + (* TODO: branch_delayed/... *) + RPC_service.post_service + ~description: + "List the not-yet-prevalidated operations." + ~query: RPC_query.empty + ~input: empty + ~output: + (conv + (fun (preapplied, unprocessed) -> + ({ preapplied with + Preapply_result.refused = Operation_hash.Map.empty }, + Operation_hash.Map.bindings unprocessed)) + (fun (preapplied, unprocessed) -> + (preapplied, + List.fold_right + (fun (h, op) m -> Operation_hash.Map.add h op m) + unprocessed Operation_hash.Map.empty)) + (merge_objs + (dynamic_size + (Preapply_result.encoding RPC_error.encoding)) + (obj1 (req "unprocessed" (list (dynamic_size operation_encoding)))))) + RPC_path.(block_path / "pending_operations") + + let proto_path = + RPC_path.(block_path / "proto") + + type preapply_param = { + timestamp: Time.t ; + proto_header: MBytes.t ; + operations: Operation.t list list ; + sort_operations: bool ; + } + + let preapply_param_encoding = + (conv + (fun { timestamp ; proto_header ; operations ; sort_operations } -> + (timestamp, proto_header, operations, sort_operations)) + (fun (timestamp, proto_header, operations, sort_operations) -> + { timestamp ; proto_header ; operations ; sort_operations }) + (obj4 + (req "timestamp" Time.encoding) + (req "proto_header" bytes) + (req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding))))) + (dft "sort_operations" bool false))) + + let preapply = + RPC_service.post_service + ~description: + "Simulate the validation of a block that would contain \ + the given operations and return the resulting fitness." + ~query: RPC_query.empty + ~input: preapply_param_encoding + ~output: (RPC_error.wrap preapply_result_encoding) + RPC_path.(block_path / "preapply") + + let complete = + let prefix_arg = + let destruct s = Ok s + and construct s = s in + RPC_arg.make ~name:"prefix" ~destruct ~construct () in + RPC_service.post_service + ~description: "Try to complete a prefix of a Base58Check-encoded data. \ + This RPC is actually able to complete hashes of \ + block, operations, public_keys and contracts." + ~query: RPC_query.empty + ~input: empty + ~output: (list string) + RPC_path.(block_path / "complete" /: prefix_arg ) + + type list_param = { + include_ops: bool ; + length: int option ; + heads: Block_hash.t list option ; + monitor: bool option ; + delay: int option ; + min_date: Time.t option; + min_heads: int option; + } + let list_param_encoding = + conv + (fun { include_ops ; length ; heads ; monitor ; + delay ; min_date ; min_heads } -> + (include_ops, length, heads, monitor, delay, min_date, min_heads)) + (fun (include_ops, length, heads, monitor, + delay, min_date, min_heads) -> + { include_ops ; length ; heads ; monitor ; + delay ; min_date ; min_heads }) + (obj7 + (dft "include_ops" + (Data_encoding.describe + ~description: + "Whether the resulting block informations should include the \ + list of operations' hashes. Default false." + bool) false) + (opt "length" + (Data_encoding.describe + ~description: + "The requested number of predecessors to returns (per \ + requested head)." + int31)) + (opt "heads" + (Data_encoding.describe + ~description: + "An empty argument requests blocks from the current heads. \ + A non empty list allow to request specific fragment \ + of the chain." + (list Block_hash.encoding))) + (opt "monitor" + (Data_encoding.describe + ~description: + "When true, the socket is \"kept alive\" after the first \ + answer and new heads are streamed when discovered." + bool)) + (opt "delay" + (Data_encoding.describe + ~description: + "By default only the blocks that were validated by the node \ + are considered. \ + When this optional argument is 0, only blocks with a \ + timestamp in the past are considered. Other values allows to \ + adjust the current time." + int31)) + (opt "min_date" + (Data_encoding.describe + ~description: "When `min_date` is provided, heads with a \ + timestamp before `min_date` are filtered ouf" + Time.encoding)) + (opt "min_heads" + (Data_encoding.describe + ~description:"When `min_date` is provided, returns at least \ + `min_heads` even when their timestamp is before \ + `min_date`." + int31))) + + let list = + RPC_service.post_service + ~description: + "Lists known heads of the blockchain sorted with decreasing fitness. \ + Optional arguments allows to returns the list of predecessors for \ + known heads or the list of predecessors for a given list of blocks." + ~query: RPC_query.empty + ~input: list_param_encoding + ~output: (obj1 (req "blocks" (list (list block_info_encoding)))) + RPC_path.(root / "blocks") + + let list_invalid = + RPC_service.post_service + ~description: + "Lists blocks that have been declared invalid along with the errors\ + that led to them being declared invalid" + ~query: RPC_query.empty + ~input:empty + ~output:(Data_encoding.list + (obj3 + (req "block" Block_hash.encoding) + (req "level" int32) + (req "errors" RPC_error.encoding))) + RPC_path.(root / "invalid_blocks") + + let unmark_invalid = + RPC_service.post_service + ~description: + "Unmark an invalid block" + ~query: RPC_query.empty + ~input: Data_encoding.empty + ~output:(RPC_error.wrap Data_encoding.empty) + RPC_path.(root / "invalid_blocks" /: Block_hash.rpc_arg / "unmark" ) + +end + +open RPC_context + +let monitor_prevalidated_operations ?(contents = false) ctxt = + make_streamed_call S.operations ctxt + ((), `Prevalidation) () + { contents ; monitor = true } + +let net_id ctxt b = make_call1 S.net_id ctxt b () () +let level ctxt b = make_call1 S.level ctxt b () () +let predecessor ctxt b = make_call1 S.predecessor ctxt b () () +let predecessors ctxt b n = make_call1 S.predecessors ctxt b () n +let hash ctxt b = make_call1 S.hash ctxt b () () +let timestamp ctxt b = make_call1 S.timestamp ctxt b () () +let fitness ctxt b = make_call1 S.fitness ctxt b () () +let operations ctxt ?(contents = false) h = + make_call1 S.operations ctxt h () { contents ; monitor = false } +let protocol ctxt b = make_call1 S.protocol ctxt b () () +let test_network ctxt b = make_call1 S.test_network ctxt b () () +let pending_operations ctxt b = make_call1 S.pending_operations ctxt b () () +let info ctxt ?(include_ops = true) h = + make_call1 S.info ctxt h () include_ops +let monitor ?(include_ops = false) + ?length ?heads ?delay ?min_date ?min_heads ctxt = + make_streamed_call S.list ctxt () () + { include_ops ; length ; heads ; + monitor = Some true ; delay ; + min_date ; min_heads } +let list ?(include_ops = false) + ?length ?heads ?delay ?min_date ?min_heads ctxt = + make_call S.list ctxt () () + { include_ops ; length ; heads ; + monitor = Some false ; delay ; + min_date ; min_heads } +let complete ctxt b s = + make_call2 S.complete ctxt b s () () +let preapply ctxt h + ?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations = + make_err_call1 S.preapply ctxt h () + { timestamp ; proto_header ; sort_operations = sort ; operations } + +let unmark_invalid ctxt h = + make_err_call1 S.unmark_invalid ctxt h () () + +let list_invalid ctxt = + make_call S.list_invalid ctxt () () () diff --git a/src/lib_shell_services/block_services.mli b/src/lib_shell_services/block_services.mli index 970e95917..5b2ce037b 100644 --- a/src/lib_shell_services/block_services.mli +++ b/src/lib_shell_services/block_services.mli @@ -13,7 +13,6 @@ type block = [ | `Test_head of int | `Test_prevalidation | `Hash of Block_hash.t ] -val blocks_arg : block RPC_arg.arg val parse_block: string -> (block, string) result val to_string: block -> string @@ -35,106 +34,180 @@ type block_info = { test_network: Test_network_status.t ; } -val info: - ([ `POST ], unit, - unit * block, unit, bool, - block_info) RPC_service.t -val net_id: - ([ `POST ], unit, - unit * block, unit, unit, - Net_id.t) RPC_service.t -val level: - ([ `POST ], unit, - unit * block, unit, unit, - Int32.t) RPC_service.t -val predecessor: - ([ `POST ], unit, - unit * block, unit, unit, - Block_hash.t) RPC_service.t -val predecessors: - ([ `POST ], unit, - unit * block , unit, int, - Block_hash.t list) RPC_service.t -val hash: - ([ `POST ], unit, - unit * block, unit, unit, - Block_hash.t) RPC_service.t -val timestamp: - ([ `POST ], unit, - unit * block, unit, unit, - Time.t) RPC_service.t -val fitness: - ([ `POST ], unit, - unit * block, unit, unit, - MBytes.t list) RPC_service.t -val context: - ([ `POST ], unit, - unit * block, unit, unit, - Context_hash.t) RPC_service.t - -type operations_param = { - contents: bool ; - monitor: bool ; -} -val operations: - ([ `POST ], unit, - unit * block, unit, operations_param, - (Operation_hash.t * Operation.t option) list list) RPC_service.t - -val protocol: - ([ `POST ], unit, - unit * block, unit, unit, - Protocol_hash.t) RPC_service.t -val test_network: - ([ `POST ], unit, - unit * block, unit, unit, - Test_network_status.t) RPC_service.t -val pending_operations: - ([ `POST ], unit, - unit * block, unit, unit, - error Preapply_result.t * Operation.t Operation_hash.Map.t) RPC_service.t - -type list_param = { - include_ops: bool ; - length: int option ; - heads: Block_hash.t list option ; - monitor: bool option ; - delay: int option ; - min_date: Time.t option; - min_heads: int option; -} -val list: - ([ `POST ], unit, - unit, unit, list_param, - block_info list list) RPC_service.t - -val list_invalid: - ([ `POST ], unit, - unit, unit, unit, - (Block_hash.t * int32 * error list) list) RPC_service.t - -val unmark_invalid: - ([ `POST ], unit, unit, unit, Block_hash.t, unit tzresult) RPC_service.t - -type preapply_param = { - timestamp: Time.t ; - proto_header: MBytes.t ; - operations: Operation.t list list ; - sort_operations: bool ; -} - type preapply_result = { shell_header: Block_header.shell_header ; operations: error Preapply_result.t list ; } + +open RPC_context + +val net_id: + #simple -> block -> Net_id.t tzresult Lwt.t +val level: + #simple -> block -> Int32.t tzresult Lwt.t +val predecessor: + #simple -> block -> Block_hash.t tzresult Lwt.t +val predecessors: + #simple -> block -> int -> Block_hash.t list tzresult Lwt.t +val hash: + #simple -> block -> Block_hash.t tzresult Lwt.t +val timestamp: + #simple -> block -> Time.t tzresult Lwt.t +val fitness: + #simple -> block -> MBytes.t list tzresult Lwt.t +val operations: + #simple -> ?contents:bool -> + block -> (Operation_hash.t * Operation.t option) list list tzresult Lwt.t +val protocol: + #simple -> block -> Protocol_hash.t tzresult Lwt.t +val test_network: + #simple -> block -> Test_network_status.t tzresult Lwt.t + +val pending_operations: + #simple -> block -> + (error Preapply_result.t * Operation.t Operation_hash.Map.t) tzresult Lwt.t + +val info: + #simple -> + ?include_ops:bool -> block -> block_info tzresult Lwt.t + +val list: + ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list -> + ?delay:int -> ?min_date:Time.t -> ?min_heads:int -> + #simple -> + block_info list list tzresult Lwt.t + +val monitor: + ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list -> + ?delay:int -> ?min_date:Time.t -> ?min_heads:int -> + #streamed -> + (block_info list list Lwt_stream.t * stopper) tzresult Lwt.t + val preapply: - ([ `POST ], unit, - unit * block, unit, preapply_param, - preapply_result tzresult) RPC_service.t + #simple -> block -> + ?timestamp:Time.t -> + ?sort:bool -> + proto_header:MBytes.t -> + Operation.t list list -> preapply_result tzresult Lwt.t val complete: - ([ `POST ], unit, - (unit * block) * string, unit, unit, - string list) RPC_service.t + #simple -> block -> string -> string list tzresult Lwt.t -val proto_path: (unit, unit * block) RPC_path.path +val monitor_prevalidated_operations: + ?contents:bool -> + #streamed -> + ((Operation_hash.t * Operation.t option) list list Lwt_stream.t * stopper) tzresult Lwt.t + +val unmark_invalid: + #simple -> Block_hash.t -> unit Error_monad.tzresult Lwt.t +val list_invalid: + #simple -> (Block_hash.t * int32 * error list) list tzresult Lwt.t + + +module S : sig + + val blocks_arg : block RPC_arg.arg + + val info: + ([ `POST ], unit, + unit * block, unit, bool, + block_info) RPC_service.t + val net_id: + ([ `POST ], unit, + unit * block, unit, unit, + Net_id.t) RPC_service.t + val level: + ([ `POST ], unit, + unit * block, unit, unit, + Int32.t) RPC_service.t + val predecessor: + ([ `POST ], unit, + unit * block, unit, unit, + Block_hash.t) RPC_service.t + val predecessors: + ([ `POST ], unit, + unit * block , unit, int, + Block_hash.t list) RPC_service.t + val hash: + ([ `POST ], unit, + unit * block, unit, unit, + Block_hash.t) RPC_service.t + val timestamp: + ([ `POST ], unit, + unit * block, unit, unit, + Time.t) RPC_service.t + val fitness: + ([ `POST ], unit, + unit * block, unit, unit, + MBytes.t list) RPC_service.t + val context: + ([ `POST ], unit, + unit * block, unit, unit, + Context_hash.t) RPC_service.t + + type operations_param = { + contents: bool ; + monitor: bool ; + } + val operations: + ([ `POST ], unit, + unit * block, unit, operations_param, + (Operation_hash.t * Operation.t option) list list) RPC_service.t + + val protocol: + ([ `POST ], unit, + unit * block, unit, unit, + Protocol_hash.t) RPC_service.t + val test_network: + ([ `POST ], unit, + unit * block, unit, unit, + Test_network_status.t) RPC_service.t + val pending_operations: + ([ `POST ], unit, + unit * block, unit, unit, + error Preapply_result.t * Operation.t Operation_hash.Map.t) RPC_service.t + + type list_param = { + include_ops: bool ; + length: int option ; + heads: Block_hash.t list option ; + monitor: bool option ; + delay: int option ; + min_date: Time.t option; + min_heads: int option; + } + val list: + ([ `POST ], unit, + unit, unit, list_param, + block_info list list) RPC_service.t + + val list_invalid: + ([ `POST ], unit, + unit, unit, unit, + (Block_hash.t * int32 * error list) list) RPC_service.t + + val unmark_invalid: + ([ `POST ], unit, + unit * Block_hash.t, unit, unit, + unit tzresult) RPC_service.t + + type preapply_param = { + timestamp: Time.t ; + proto_header: MBytes.t ; + operations: Operation.t list list ; + sort_operations: bool ; + } + + val preapply: + ([ `POST ], unit, + unit * block, unit, preapply_param, + preapply_result tzresult) RPC_service.t + + val complete: + ([ `POST ], unit, + (unit * block) * string, unit, unit, + string list) RPC_service.t + + val proto_path: (unit, unit * block) RPC_path.path + +end diff --git a/src/proto_alpha/lib_client/client_baking_blocks.ml b/src/proto_alpha/lib_client/client_baking_blocks.ml index b912c5a49..8d03d2412 100644 --- a/src/proto_alpha/lib_client/client_baking_blocks.ml +++ b/src/proto_alpha/lib_client/client_baking_blocks.ml @@ -22,7 +22,7 @@ type block_info = { let convert_block_info cctxt ( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol } - : Client_node_rpcs.Blocks.block_info ) = + : Block_services.block_info ) = Client_proto_rpcs.Context.level cctxt (`Hash hash) >>= function | Ok level -> Lwt.return @@ -34,12 +34,12 @@ let convert_block_info cctxt let convert_block_info_err cctxt ( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol } - : Client_node_rpcs.Blocks.block_info ) = + : Block_services.block_info ) = Client_proto_rpcs.Context.level cctxt (`Hash hash) >>=? fun level -> return { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol ; level } let info cctxt ?include_ops block = - Client_node_rpcs.Blocks.info cctxt ?include_ops block >>=? fun block -> + Block_services.info cctxt ?include_ops block >>=? fun block -> convert_block_info_err cctxt block let compare (bi1 : block_info) (bi2 : block_info) = @@ -62,9 +62,9 @@ let sort_blocks cctxt ?(compare = compare) blocks = let monitor cctxt ?include_ops ?length ?heads ?delay ?min_date ?min_heads ?compare () = - Client_node_rpcs.Blocks.monitor cctxt + Block_services.monitor ?include_ops ?length ?heads ?delay ?min_date ?min_heads - () >>=? fun block_stream -> + cctxt >>=? fun (block_stream, _stop) -> let convert blocks = sort_blocks cctxt ?compare (List.flatten blocks) >>= return in return (Lwt_stream.map_s convert block_stream) @@ -74,12 +74,12 @@ let blocks_from_cycle cctxt block cycle = 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 - Client_node_rpcs.Blocks.predecessors cctxt block length >>=? fun blocks -> + Block_services.predecessors cctxt block length >>=? fun blocks -> let blocks = List.remove (length - (1 + Int32.to_int (Raw_level.diff last first))) blocks in if Raw_level.(level.level = last) then - Client_node_rpcs.Blocks.hash cctxt block >>=? fun last -> + Block_services.hash cctxt block >>=? fun last -> return (last :: blocks) else return blocks diff --git a/src/proto_alpha/lib_client/client_baking_blocks.mli b/src/proto_alpha/lib_client/client_baking_blocks.mli index 4a45ab657..6032781d2 100644 --- a/src/proto_alpha/lib_client/client_baking_blocks.mli +++ b/src/proto_alpha/lib_client/client_baking_blocks.mli @@ -22,7 +22,7 @@ type block_info = { val info: #Client_rpcs.ctxt -> - ?include_ops:bool -> Client_node_rpcs.Blocks.block -> block_info tzresult Lwt.t + ?include_ops:bool -> Block_services.block -> block_info tzresult Lwt.t val compare: block_info -> block_info -> int @@ -36,6 +36,6 @@ val monitor: val blocks_from_cycle: #Client_rpcs.ctxt -> - Client_node_rpcs.Blocks.block -> + 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 15974a128..afe9f34b8 100644 --- a/src/proto_alpha/lib_client/client_baking_endorsement.ml +++ b/src/proto_alpha/lib_client/client_baking_endorsement.ml @@ -95,7 +95,7 @@ let inject_endorsement (cctxt : Client_commands.full_context) block level ?async src_sk source slot = let block = Client_rpcs.last_baked_block block in - Client_node_rpcs.Blocks.info cctxt block >>=? fun bi -> + Block_services.info cctxt block >>=? fun bi -> Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt block ~branch:bi.hash diff --git a/src/proto_alpha/lib_client/client_baking_forge.ml b/src/proto_alpha/lib_client/client_baking_forge.ml index eb9f09594..5489dc600 100644 --- a/src/proto_alpha/lib_client/client_baking_forge.ml +++ b/src/proto_alpha/lib_client/client_baking_forge.ml @@ -118,7 +118,7 @@ let forge_block cctxt block begin match operations with | None -> - Client_node_rpcs.Blocks.pending_operations + Block_services.pending_operations cctxt block >>=? fun (ops, pendings) -> let ops = List.map snd @@ @@ -175,7 +175,7 @@ let forge_block cctxt block let request = List.length operations in let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in let operations = classify_operations operations in - Client_node_rpcs.Blocks.preapply + Block_services.preapply cctxt block ~timestamp ~sort ~proto_header operations >>=? fun { operations = result ; shell_header } -> let valid = List.fold_left (fun acc r -> acc + List.length r.Preapply_result.applied) 0 result in @@ -194,7 +194,7 @@ let forge_block cctxt block let operations = if not best_effort then operations else List.map (fun l -> List.map snd l.Preapply_result.applied) result in - Client_node_rpcs.Blocks.info cctxt block >>=? fun {net_id} -> + Block_services.info cctxt block >>=? fun {net_id} -> inject_block cctxt ?force ~net_id ~shell_header ~priority ~seed_nonce_hash ~src_sk operations @@ -477,7 +477,7 @@ let bake (cctxt : Client_commands.full_context) state = lwt_debug "Try baking after %a (slot %d) for %s (%a)" Block_hash.pp_short bi.hash priority name Time.pp_hum timestamp >>= fun () -> - Client_node_rpcs.Blocks.pending_operations cctxt + Block_services.pending_operations cctxt block >>=? fun (res, ops) -> let operations = List.map snd @@ @@ -487,7 +487,7 @@ let bake (cctxt : Client_commands.full_context) state = let request = List.length operations in let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in - Client_node_rpcs.Blocks.preapply cctxt block + Block_services.preapply cctxt block ~timestamp ~sort:true ~proto_header [operations] >>= function | Error errs -> lwt_log_error "Error while prevalidating operations:\n%a" @@ -559,7 +559,7 @@ let create | None | Some (Ok [] | Error _) -> cctxt#error "Can't fetch the current block head." | Some (Ok (bi :: _ as initial_heads)) -> - Client_node_rpcs.Blocks.hash cctxt `Genesis >>=? fun genesis_hash -> + Block_services.hash cctxt `Genesis >>=? fun genesis_hash -> let last_get_block = ref None in let get_block () = match !last_get_block with diff --git a/src/proto_alpha/lib_client/client_baking_operations.ml b/src/proto_alpha/lib_client/client_baking_operations.ml index 5f8709c2e..ac41c6bdc 100644 --- a/src/proto_alpha/lib_client/client_baking_operations.ml +++ b/src/proto_alpha/lib_client/client_baking_operations.ml @@ -16,7 +16,8 @@ type operation = { } let monitor cctxt ?contents ?check () = - Client_node_rpcs.Operations.monitor cctxt ?contents () >>=? fun ops_stream -> + Block_services.monitor_prevalidated_operations + ?contents cctxt >>=? fun (ops_stream, _) -> let convert ops = map_s (fun (hash, op) -> diff --git a/src/proto_alpha/lib_client/client_baking_revelation.ml b/src/proto_alpha/lib_client/client_baking_revelation.ml index f8713e25e..f5a46ed20 100644 --- a/src/proto_alpha/lib_client/client_baking_revelation.ml +++ b/src/proto_alpha/lib_client/client_baking_revelation.ml @@ -16,7 +16,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces = (fun (level, nonce) -> Seed_nonce_revelation { level ; nonce }) nonces in let block = Client_rpcs.last_baked_block block in - Client_node_rpcs.Blocks.info rpc_config block >>=? fun bi -> + Block_services.info rpc_config block >>=? fun bi -> Client_proto_rpcs.Helpers.Forge.Anonymous.operations rpc_config block ~branch:bi.hash operations >>=? fun bytes -> Client_node_rpcs.inject_operation @@ -27,7 +27,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces = let forge_seed_nonce_revelation (cctxt: Client_commands.full_context) block nonces = - Client_node_rpcs.Blocks.hash cctxt block >>=? fun hash -> + Block_services.hash cctxt block >>=? fun hash -> match nonces with | [] -> cctxt#message "No nonce to reveal for block %a" diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 288b4fa87..351a8aada 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -23,7 +23,7 @@ let rec find_predecessor rpc_config h n = if n <= 0 then return (`Hash h) else - Client_node_rpcs.Blocks.predecessor rpc_config (`Hash h) >>=? fun h -> + Block_services.predecessor rpc_config (`Hash h) >>=? fun h -> find_predecessor rpc_config h (n-1) let get_branch rpc_config block branch = @@ -36,7 +36,7 @@ let get_branch rpc_config block branch = | `Hash h -> find_predecessor rpc_config h branch | `Genesis -> return `Genesis end >>=? fun block -> - Client_node_rpcs.Blocks.info rpc_config block >>=? fun { net_id ; hash } -> + Block_services.info rpc_config block >>=? fun { net_id ; hash } -> return (net_id, hash) let parse_expression arg = @@ -61,7 +61,7 @@ let transfer rpc_config rpc_config block ~branch ~source ~sourcePubKey:src_pk ~counter ~amount ~destination ?parameters ~fee () >>=? fun bytes -> - Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor -> + Block_services.predecessor rpc_config block >>=? fun predecessor -> Client_keys.sign src_sk bytes >>=? fun signature -> let signed_bytes = MBytes.concat bytes (Ed25519.Signature.to_bytes signature) in @@ -78,7 +78,7 @@ let originate rpc_config ?net_id ~block ?signature bytes = match signature with | None -> bytes | Some signature -> Ed25519.Signature.concat bytes signature in - Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor -> + Block_services.predecessor rpc_config block >>=? fun predecessor -> let oph = Operation_hash.hash_bytes [ signed_bytes ] in Client_proto_rpcs.Helpers.apply_operation rpc_config block predecessor oph bytes signature >>=? function @@ -178,7 +178,7 @@ let get_manager (cctxt : Client_commands.full_context) block source = let dictate rpc_config block command seckey = let block = Client_rpcs.last_baked_block block in - Client_node_rpcs.Blocks.info + Block_services.info rpc_config block >>=? fun { net_id ; hash = branch } -> Client_proto_rpcs.Helpers.Forge.Dictator.operation rpc_config block ~branch command >>=? fun bytes -> diff --git a/src/proto_alpha/lib_client/client_proto_context_commands.ml b/src/proto_alpha/lib_client/client_proto_context_commands.ml index a9ce7a2e3..9897adb42 100644 --- a/src/proto_alpha/lib_client/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client/client_proto_context_commands.ml @@ -48,7 +48,7 @@ let commands () = no_options (fixed [ "get" ; "timestamp" ]) begin fun () (cctxt : Client_commands.full_context) -> - Client_node_rpcs.Blocks.timestamp + Block_services.timestamp cctxt cctxt#block >>=? fun v -> cctxt#message "%s" (Time.to_notation v) >>= fun () -> return () diff --git a/src/proto_alpha/lib_client/client_proto_rpcs.ml b/src/proto_alpha/lib_client/client_proto_rpcs.ml index 036bd50d5..bd71143f7 100644 --- a/src/proto_alpha/lib_client/client_proto_rpcs.ml +++ b/src/proto_alpha/lib_client/client_proto_rpcs.ml @@ -21,10 +21,10 @@ let handle_error (cctxt : #Client_commands.logger) = function let call_service0 cctxt s block = Client_rpcs.call_service0 cctxt - (s Block_services.proto_path) block + (s Block_services.S.proto_path) block let call_service1 cctxt s block a1 = Client_rpcs.call_service1 cctxt - (s Block_services.proto_path) block a1 + (s Block_services.S.proto_path) block a1 let call_error_service1 cctxt s block a1 = call_service1 cctxt s block a1 >>= function | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) @@ -32,7 +32,7 @@ let call_error_service1 cctxt s block a1 = | Error _ as err -> Lwt.return err let call_service2 cctxt s block a1 a2 = Client_rpcs.call_service2 cctxt - (s Block_services.proto_path) block a1 a2 + (s Block_services.S.proto_path) block a1 a2 let call_error_service2 cctxt s block a1 a2 = call_service2 cctxt s block a1 a2 >>= function | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) diff --git a/src/proto_alpha/lib_client/test/jbuild b/src/proto_alpha/lib_client/test/jbuild index e22f527eb..dc83034b4 100644 --- a/src/proto_alpha/lib_client/test/jbuild +++ b/src/proto_alpha/lib_client/test/jbuild @@ -8,6 +8,7 @@ test_vote)) (libraries (tezos-base tezos-rpc-http + tezos-shell-services tezos-client-base tezos-client-genesis tezos-client-alpha @@ -16,6 +17,7 @@ -open Tezos_base__TzPervasives -open Tezos_test_helpers -open Tezos_rpc_http + -open Tezos_shell_services -open Tezos_client_base -open Tezos_client_genesis -open Tezos_client_alpha)))) 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 1a002a473..9569d0f7c 100644 --- a/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_client/test/proto_alpha_helpers.ml @@ -235,7 +235,7 @@ module Protocol = struct Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals = - Client_node_rpcs.Blocks.info (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_info -> + 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 ~branch:block_info.hash @@ -248,7 +248,7 @@ module Protocol = struct let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot = let rpc = new Client_rpcs.http_ctxt !rpc_config in - Client_node_rpcs.Blocks.info rpc block >>=? fun block_info -> + 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 ~branch:block_info.hash @@ -388,7 +388,7 @@ module Assert = struct end let check_protocol ?msg ~block h = - Client_node_rpcs.Blocks.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto -> + Block_services.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto -> return @@ Assert.equal ?msg:(Assert.format_msg msg) ~prn:Protocol_hash.to_b58check @@ -445,7 +445,7 @@ module Endorse = struct slot = let block = Client_rpcs.last_baked_block block in let rpc = new Client_rpcs.http_ctxt !rpc_config in - Client_node_rpcs.Blocks.info rpc block >>=? fun { hash ; _ } -> + Block_services.info rpc block >>=? fun { hash ; _ } -> Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc block ~branch:hash diff --git a/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli b/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli index 38807e16c..56b254473 100644 --- a/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli +++ b/src/proto_alpha/lib_client/test/proto_alpha_helpers.mli @@ -97,13 +97,13 @@ end module Baking : sig val bake: - Client_node_rpcs.Blocks.block -> + Block_services.block -> Account.t -> Operation.raw list -> Block_hash.t tzresult Lwt.t val endorsement_reward: - Client_node_rpcs.Blocks.block -> int64 tzresult Lwt.t + Block_services.block -> int64 tzresult Lwt.t end @@ -130,13 +130,13 @@ end module Protocol : sig val proposals : - ?block:Client_node_rpcs.Blocks.block -> + ?block:Block_services.block -> src:Account.t -> Protocol_hash.t list -> Operation.raw tzresult Lwt.t val ballot : - ?block:Client_node_rpcs.Blocks.block -> + ?block:Block_services.block -> src:Account.t -> proposal:Protocol_hash.t -> Vote.ballot -> @@ -149,10 +149,10 @@ module Assert : sig include module type of Assert val balance_equal: - ?block:Client_node_rpcs.Blocks.block -> + ?block:Block_services.block -> msg:string -> Account.t -> int64 -> unit tzresult Lwt.t val delegate_equal: - ?block:Client_node_rpcs.Blocks.block -> + ?block:Block_services.block -> msg:string -> Contract.t -> public_key_hash option -> unit tzresult Lwt.t val failed_to_preapply: @@ -191,11 +191,11 @@ module Assert : sig val wrong_delegate : msg:string -> 'a tzresult -> unit val check_protocol : - ?msg:string -> block:Client_node_rpcs.Blocks.block -> + ?msg:string -> block:Block_services.block -> Protocol_hash.t -> unit tzresult Lwt.t val check_voting_period_kind : - ?msg:string -> block:Client_node_rpcs.Blocks.block -> + ?msg:string -> block:Block_services.block -> Voting_period.kind -> unit tzresult Lwt.t end diff --git a/src/proto_genesis/lib_client/client_proto_main.ml b/src/proto_genesis/lib_client/client_proto_main.ml index 0ab65e57c..ebe93e536 100644 --- a/src/proto_genesis/lib_client/client_proto_main.ml +++ b/src/proto_genesis/lib_client/client_proto_main.ml @@ -15,7 +15,7 @@ let protocol = let call_service1 rpc_config s block a1 = Client_rpcs.call_service1 rpc_config - (s Block_services.proto_path) block a1 + (s Block_services.S.proto_path) block a1 let call_error_service1 rpc_config s block a1 = call_service1 rpc_config s block a1 >>= function @@ -26,7 +26,7 @@ let call_error_service1 rpc_config s block a1 = let bake rpc_config ?(timestamp = Time.now ()) block command sk = let block = Client_rpcs.last_baked_block block in let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in - Client_node_rpcs.Blocks.preapply + Block_services.preapply rpc_config block ~timestamp ~proto_header [] >>=? fun { shell_header } -> let blk = Data_encoding.Binary.to_bytes Block_header.encoding diff --git a/src/proto_genesis/lib_client/client_proto_main.mli b/src/proto_genesis/lib_client/client_proto_main.mli index be9a6b577..fc6ba06af 100644 --- a/src/proto_genesis/lib_client/client_proto_main.mli +++ b/src/proto_genesis/lib_client/client_proto_main.mli @@ -12,7 +12,7 @@ open Proto_genesis val bake: #Client_rpcs.ctxt -> ?timestamp: Time.t -> - Client_node_rpcs.Blocks.block -> + Block_services.block -> Data.Command.t -> Client_keys.sk_locator -> Block_hash.t tzresult Lwt.t