From 087191192078bee7c19372b934132a74e5db57b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sat, 9 Dec 2017 03:51:58 +0100 Subject: [PATCH] RPC: split modules `RPC/RPC_server` --- bin_client/main.ml | 3 +- lib_client_base/client_generic_rpcs.ml | 40 +-- lib_client_base/client_node_rpcs.ml | 8 +- lib_client_base/client_node_rpcs.mli | 2 +- lib_client_base/client_rpcs.ml | 34 +- lib_client_base/client_rpcs.mli | 26 +- lib_client_base/jbuild | 2 + lib_client_base/tezos-client-base.opam | 6 + .../src/contract_repr.ml | 2 +- .../src/contract_repr.mli | 2 +- lib_embedded_protocol_alpha/src/cycle_repr.ml | 2 +- .../src/cycle_repr.mli | 2 +- .../src/raw_level_repr.ml | 2 +- .../src/raw_level_repr.mli | 2 +- lib_embedded_protocol_alpha/src/services.ml | 332 +++++++++--------- .../src/services_registration.ml | 22 +- .../src/tezos_context.mli | 8 +- .../src/voting_period_repr.ml | 2 +- .../src/voting_period_repr.mli | 2 +- lib_embedded_protocol_demo/src/services.ml | 26 +- lib_embedded_protocol_genesis/src/services.ml | 16 +- lib_node_http/RPC_answer.ml | 10 + lib_node_http/RPC_answer.mli | 10 + lib_node_http/RPC_client.ml | 24 +- lib_node_http/RPC_client.mli | 12 +- lib_node_http/RPC_directory.ml | 10 + lib_node_http/RPC_directory.mli | 10 + lib_node_http/RPC_server.ml | 5 +- lib_node_http/RPC_server.mli | 7 +- lib_node_http/media_type.ml | 2 +- lib_node_http/media_type.mli | 2 +- lib_node_services/RPC.ml | 160 --------- lib_node_services/RPC_arg.ml | 10 + lib_node_services/RPC_arg.mli | 10 + lib_node_services/RPC_description.ml | 11 + lib_node_services/RPC_description.mli | 10 + lib_node_services/RPC_encoding.ml | 158 +++++++++ lib_node_services/RPC_encoding.mli | 12 + lib_node_services/RPC_path.ml | 10 + lib_node_services/RPC_path.mli | 10 + lib_node_services/RPC_query.ml | 10 + lib_node_services/RPC_query.mli | 10 + lib_node_services/RPC_service.ml | 27 ++ .../{RPC.mli => RPC_service.mli} | 14 +- lib_node_services/node_rpc_services.ml | 256 +++++++------- lib_node_services/node_rpc_services.mli | 82 ++--- lib_node_shell/node.ml | 6 +- lib_node_shell/node.mli | 6 +- lib_node_shell/node_rpc.ml | 176 +++++----- lib_node_shell/node_rpc.mli | 2 +- .../tezos_protocol_environment.ml | 10 +- lib_node_updater/updater.ml | 4 +- lib_node_updater/updater.mli | 4 +- lib_protocol_environment_sigs/jbuild | 7 +- lib_protocol_environment_sigs/v1/RPC.mli | 290 --------------- .../v1/RPC_answer.mli | 29 ++ lib_protocol_environment_sigs/v1/RPC_arg.mli | 28 ++ .../v1/RPC_directory.mli | 77 ++++ lib_protocol_environment_sigs/v1/RPC_path.mli | 36 ++ .../v1/RPC_query.mli | 38 ++ .../v1/RPC_service.mli | 100 ++++++ lib_protocol_environment_sigs/v1/updater.mli | 2 +- vendors/ocplib-resto/lib_resto/resto.mli | 3 +- 63 files changed, 1213 insertions(+), 1028 deletions(-) create mode 100644 lib_node_http/RPC_answer.ml create mode 100644 lib_node_http/RPC_answer.mli create mode 100644 lib_node_http/RPC_directory.ml create mode 100644 lib_node_http/RPC_directory.mli delete mode 100644 lib_node_services/RPC.ml create mode 100644 lib_node_services/RPC_arg.ml create mode 100644 lib_node_services/RPC_arg.mli create mode 100644 lib_node_services/RPC_description.ml create mode 100644 lib_node_services/RPC_description.mli create mode 100644 lib_node_services/RPC_encoding.ml create mode 100644 lib_node_services/RPC_encoding.mli create mode 100644 lib_node_services/RPC_path.ml create mode 100644 lib_node_services/RPC_path.mli create mode 100644 lib_node_services/RPC_query.ml create mode 100644 lib_node_services/RPC_query.mli create mode 100644 lib_node_services/RPC_service.ml rename lib_node_services/{RPC.mli => RPC_service.mli} (66%) delete mode 100644 lib_protocol_environment_sigs/v1/RPC.mli create mode 100644 lib_protocol_environment_sigs/v1/RPC_answer.mli create mode 100644 lib_protocol_environment_sigs/v1/RPC_arg.mli create mode 100644 lib_protocol_environment_sigs/v1/RPC_directory.mli create mode 100644 lib_protocol_environment_sigs/v1/RPC_path.mli create mode 100644 lib_protocol_environment_sigs/v1/RPC_query.mli create mode 100644 lib_protocol_environment_sigs/v1/RPC_service.mli diff --git a/bin_client/main.ml b/bin_client/main.ml index de668a3d9..3f16d1a58 100644 --- a/bin_client/main.ml +++ b/bin_client/main.ml @@ -31,8 +31,9 @@ let main () = port = parsed_config_file.node_port ; tls = parsed_config_file.tls ; } in + let ctxt = new Client_rpcs.rpc rpc_config in begin - Client_node_rpcs.Blocks.protocol (new Client_rpcs.rpc rpc_config) parsed_args.block >>= function + Client_node_rpcs.Blocks.protocol ctxt parsed_args.block >>= function | Ok version -> begin match parsed_args.protocol with | None -> diff --git a/lib_client_base/client_generic_rpcs.ml b/lib_client_base/client_generic_rpcs.ml index 51a6851cc..770d5de45 100644 --- a/lib_client_base/client_generic_rpcs.ml +++ b/lib_client_base/client_generic_rpcs.ml @@ -171,17 +171,17 @@ let editor_fill_in schema = (*-- Nice list display ------------------------------------------------------*) let rec count = - let open RPC.Description in + let open RPC_description in function | Empty -> 0 | Dynamic _ -> 1 | Static { services ; subdirs } -> - let service = RPC.MethMap.cardinal services in + let service = RPC_service.MethMap.cardinal services in let subdirs = match subdirs with | None -> 0 | Some (Suffixes subdirs) -> - RPC.StringMap.fold (fun _ t r -> r + count t) subdirs 0 + Resto.StringMap.fold (fun _ t r -> r + count t) subdirs 0 | Some (Arg (_, subdir)) -> count subdir in service + subdirs @@ -191,10 +191,10 @@ let list url (cctxt : Client_commands.full_context) = let args = String.split '/' url in Client_node_rpcs.describe cctxt ~recurse:true args >>=? fun tree -> - let open RPC.Description in + let open RPC_description in let collected_args = ref [] in let collect arg = - if not (arg.RPC.Arg.descr <> None && List.mem arg !collected_args) then + if not (arg.RPC_arg.descr <> None && List.mem arg !collected_args) then collected_args := arg :: !collected_args in let display_paragraph ppf description = Format.fprintf ppf "@, @[%a@]" @@ -202,14 +202,14 @@ let list url (cctxt : Client_commands.full_context) = (String.split ' ' description) in let display_arg ppf arg = - match arg.RPC.Arg.descr with - | None -> Format.fprintf ppf "%s" arg.RPC.Arg.name + match arg.RPC_arg.descr with + | None -> Format.fprintf ppf "%s" arg.RPC_arg.name | Some descr -> - Format.fprintf ppf "<%s>%a" arg.RPC.Arg.name display_paragraph descr + Format.fprintf ppf "<%s>%a" arg.RPC_arg.name display_paragraph descr in let display_service ppf (_path, tpath, service) = Format.fprintf ppf "- %s /%s" - (RPC.string_of_meth service.meth) + (RPC_service.string_of_meth service.meth) (String.concat "/" tpath) ; match service.description with | None | Some "" -> () @@ -219,7 +219,7 @@ let list url (cctxt : Client_commands.full_context) = Format.pp_print_list (fun ppf (_,s) -> display_service ppf (_path, tpath, s)) ppf - (RPC.MethMap.bindings services) + (RPC_service.MethMap.bindings services) in let rec display ppf (path, tpath, tree) = match tree with @@ -233,7 +233,7 @@ let list url (cctxt : Client_commands.full_context) = | Static { services ; subdirs = None } -> display_services ppf (path, tpath, services) | Static { services ; subdirs = Some (Suffixes subdirs) } -> begin - match RPC.MethMap.cardinal services, RPC.StringMap.bindings subdirs with + match RPC_service.MethMap.cardinal services, Resto.StringMap.bindings subdirs with | 0, [] -> () | 0, [ n, solo ] -> display ppf (path @ [ n ], tpath @ [ n ], solo) @@ -262,16 +262,16 @@ let list url (cctxt : Client_commands.full_context) = items end | Static { services ; subdirs = Some (Arg (arg, solo)) } - when RPC.MethMap.cardinal services = 0 -> + when RPC_service.MethMap.cardinal services = 0 -> collect arg ; - let name = Printf.sprintf "<%s>" arg.RPC.Arg.name in + let name = Printf.sprintf "<%s>" arg.RPC_arg.name in display ppf (path @ [ name ], tpath @ [ name ], solo) | Static { services; subdirs = Some (Arg (arg, solo)) } -> collect arg ; display_services ppf (path, tpath, services) ; Format.fprintf ppf "@," ; - let name = Printf.sprintf "<%s>" arg.RPC.Arg.name in + let name = Printf.sprintf "<%s>" arg.RPC_arg.name in display ppf (path @ [ name ], tpath @ [ name ], solo) and display_list tpath = Format.pp_print_list @@ -288,10 +288,10 @@ let list url (cctxt : Client_commands.full_context) = let schema url (cctxt : Client_commands.full_context) = let args = String.split '/' url in - let open RPC.Description in + let open RPC_description in Client_node_rpcs.describe cctxt ~recurse:false args >>=? function | Static { services } -> begin - match RPC.MethMap.find `POST services with + match RPC_service.MethMap.find `POST services with | exception Not_found -> cctxt#message "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> @@ -313,10 +313,10 @@ let schema url (cctxt : Client_commands.full_context) = let format url (cctxt : #Client_commands.logging_rpcs) = let args = String.split '/' url in - let open RPC.Description in + let open RPC_description in Client_node_rpcs.describe cctxt ~recurse:false args >>=? function | Static { services } -> begin - match RPC.MethMap.find `POST services with + match RPC_service.MethMap.find `POST services with | exception Not_found -> cctxt#message "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> @@ -352,10 +352,10 @@ let fill_in schema = let call url (cctxt : Client_commands.full_context) = let args = String.split '/' url in - let open RPC.Description in + let open RPC_description in Client_node_rpcs.describe cctxt ~recurse:false args >>=? function | Static { services } -> begin - match RPC.MethMap.find `POST services with + match RPC_service.MethMap.find `POST services with | exception Not_found -> cctxt#message "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> diff --git a/lib_client_base/client_node_rpcs.ml b/lib_client_base/client_node_rpcs.ml index 6c38aefba..116255004 100644 --- a/lib_client_base/client_node_rpcs.ml +++ b/lib_client_base/client_node_rpcs.ml @@ -43,12 +43,12 @@ let complete cctxt ?block prefix = call_service2 cctxt Services.Blocks.complete block prefix () let describe config ?(recurse = true) path = - let { RPC.Service.meth ; uri } = - RPC.Service.forge_request Node_rpc_services.describe - ((), path) { RPC.Description.recurse } in + let { RPC_service.meth ; uri } = + RPC_service.forge_request Node_rpc_services.describe + ((), path) { RPC_description.recurse } in let path = String.split_path (Uri.path uri) in (* Temporary *) config#get_json meth path (`O []) >>=? fun json -> - match Data_encoding.Json.destruct (RPC.Service.output_encoding Node_rpc_services.describe) json with + match Data_encoding.Json.destruct (RPC_service.output_encoding Node_rpc_services.describe) json with | exception msg -> let msg = Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in diff --git a/lib_client_base/client_node_rpcs.mli b/lib_client_base/client_node_rpcs.mli index 5f49bb22e..19806489f 100644 --- a/lib_client_base/client_node_rpcs.mli +++ b/lib_client_base/client_node_rpcs.mli @@ -177,4 +177,4 @@ val complete: val describe: #Client_rpcs.ctxt -> ?recurse:bool -> string list -> - Data_encoding.json_schema RPC.Description.directory tzresult Lwt.t + Data_encoding.json_schema RPC_description.directory tzresult Lwt.t diff --git a/lib_client_base/client_rpcs.ml b/lib_client_base/client_rpcs.ml index 994a8d15f..63ef56f72 100644 --- a/lib_client_base/client_rpcs.ml +++ b/lib_client_base/client_rpcs.ml @@ -188,27 +188,27 @@ let fail config err = fail (RPC_error (config, err)) class type ctxt = object method get_json : - RPC.meth -> + RPC_service.meth -> string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t method get_streamed_json : - RPC.meth -> + RPC_service.meth -> string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t method make_request : (Uri.t -> Data_encoding.json -> 'a Lwt.t) -> - RPC.meth -> + RPC_service.meth -> string list -> Data_encoding.json -> ('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t method parse_answer : 'meth 'params 'input 'output. - ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC.Service.t -> + ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC_service.t -> string list -> Data_encoding.json -> 'output tzresult Lwt.t method parse_err_answer : 'meth 'params 'input 'output. - ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC.Service.t -> + ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC_service.t -> string list -> Data_encoding.json -> 'output tzresult Lwt.t end @@ -217,7 +217,7 @@ class rpc config : ctxt = object (self) val config = config method make_request : type a. (Uri.t -> Data_encoding.json -> a Lwt.t) -> - RPC.meth -> + RPC_service.meth -> string list -> Data_encoding.json -> (a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t = @@ -276,11 +276,11 @@ class rpc config : ctxt = object (self) method parse_answer : 'm 'p 'i 'o. - ([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o, unit) RPC.Service.t -> + ([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o, unit) RPC_service.t -> string list -> Data_encoding.json -> 'o tzresult Lwt.t = fun service path json -> - match Data_encoding.Json.destruct (RPC.Service.output_encoding service) json with + match Data_encoding.Json.destruct (RPC_service.output_encoding service) json with | exception msg -> let msg = Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in @@ -288,7 +288,7 @@ class rpc config : ctxt = object (self) | v -> return v - method get_json : RPC.meth -> + method get_json : RPC_service.meth -> string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t = fun meth service json -> let Logger logger = config.logger in @@ -314,11 +314,11 @@ class rpc config : ctxt = object (self) method parse_err_answer : 'm 'p 'i 'o. - ([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o tzresult, unit) RPC.Service.t -> + ([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o tzresult, unit) RPC_service.t -> string list -> Data_encoding.json -> 'o tzresult Lwt.t = fun service path json -> - match Data_encoding.Json.destruct (RPC.Service.output_encoding service) json with + match Data_encoding.Json.destruct (RPC_service.output_encoding service) json with | exception msg -> (* TODO print_error *) let msg = Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in @@ -346,13 +346,13 @@ let make_request config log_request meth service json = fail config (Connection_failed msg) end -let forge_request (type i) (service: (_,_,_,_,i,_,_) RPC.Service.t) params body = - let { RPC.Service.meth ; uri } = - RPC.Service.forge_request service params () in +let forge_request (type i) (service: (_,_,_,_,i,_,_) RPC_service.t) params body = + let { RPC_service.meth ; uri } = + RPC_service.forge_request service params () in let json = - match RPC.Service.input_encoding service with - | RPC.Service.No_input -> assert false (* TODO *) - | RPC.Service.Input input -> Data_encoding.Json.construct input body in + match RPC_service.input_encoding service with + | RPC_service.No_input -> assert false (* TODO *) + | RPC_service.Input input -> Data_encoding.Json.construct input body in let path = String.split_path (Uri.path uri) in (* Temporary *) meth, path, json diff --git a/lib_client_base/client_rpcs.mli b/lib_client_base/client_rpcs.mli index 470803f3e..5e7032bf7 100644 --- a/lib_client_base/client_rpcs.mli +++ b/lib_client_base/client_rpcs.mli @@ -25,28 +25,28 @@ and logger = class type ctxt = object method get_json : - RPC.meth -> + RPC_service.meth -> string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t method get_streamed_json : - RPC.meth -> + RPC_service.meth -> string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t method make_request : (Uri.t -> Data_encoding.json -> 'a Lwt.t) -> - RPC.meth -> + RPC_service.meth -> string list -> Data_encoding.json -> ('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t method parse_answer : 'meth 'params 'input 'output. - ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC.Service.t -> + ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC_service.t -> string list -> Data_encoding.json -> 'output tzresult Lwt.t method parse_err_answer : 'meth 'params 'input 'output. - ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC.Service.t -> + ([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC_service.t -> string list -> Data_encoding.json -> 'output tzresult Lwt.t end @@ -62,56 +62,56 @@ val call_service0: #ctxt -> ([ `POST ], unit, unit, unit, 'i, - 'o, unit) RPC.Service.t -> + 'o, unit) RPC_service.t -> 'i -> 'o tzresult Lwt.t val call_service1: #ctxt -> ([ `POST ], unit, unit * 'a, unit, 'i, - 'o, unit) RPC.Service.t -> + 'o, unit) RPC_service.t -> 'a -> 'i -> 'o tzresult Lwt.t val call_service2: #ctxt -> ([ `POST ], unit, (unit * 'a) * 'b, unit, 'i, - 'o, unit) RPC.Service.t -> + 'o, unit) RPC_service.t -> 'a -> 'b -> 'i -> 'o tzresult Lwt.t val call_streamed_service0: #ctxt -> ([ `POST ], unit, unit, unit, 'a, - 'b, unit) RPC.Service.t -> + 'b, unit) RPC_service.t -> 'a -> 'b tzresult Lwt_stream.t tzresult Lwt.t val call_streamed_service1: #ctxt -> ([ `POST ], unit, unit * 'a, unit, 'b, - 'c, unit) RPC.Service.t -> + 'c, unit) RPC_service.t -> 'a -> 'b -> 'c tzresult Lwt_stream.t tzresult Lwt.t val call_err_service0: #ctxt -> ([ `POST ], unit, unit, unit, 'i, - 'o tzresult, unit) RPC.Service.t -> + 'o tzresult, unit) RPC_service.t -> 'i -> 'o tzresult Lwt.t val call_err_service1: #ctxt -> ([ `POST ], unit, unit * 'a, unit, 'i, - 'o tzresult, unit) RPC.Service.t -> + 'o tzresult, unit) RPC_service.t -> 'a -> 'i -> 'o tzresult Lwt.t val call_err_service2: #ctxt -> ([ `POST ], unit, (unit * 'a) * 'b, unit, 'i, - 'o tzresult, unit) RPC.Service.t -> + 'o tzresult, unit) RPC_service.t -> 'a -> 'b -> 'i -> 'o tzresult Lwt.t type block = Node_rpc_services.Blocks.block diff --git a/lib_client_base/jbuild b/lib_client_base/jbuild index ac1eb7a60..ea5d25b86 100644 --- a/lib_client_base/jbuild +++ b/lib_client_base/jbuild @@ -7,6 +7,7 @@ tezos-storage tezos-node-p2p-base tezos-node-services + tezos-node-http tezos-node-updater tezos-protocol-compiler)) (flags (:standard -w -9+27-30-32-40@8 @@ -15,6 +16,7 @@ -open Tezos_storage -open Tezos_node_p2p_base -open Tezos_node_services + -open Tezos_node_http -open Tezos_node_updater)))) (alias diff --git a/lib_client_base/tezos-client-base.opam b/lib_client_base/tezos-client-base.opam index 604c6a661..21476eef3 100644 --- a/lib_client_base/tezos-client-base.opam +++ b/lib_client_base/tezos-client-base.opam @@ -10,6 +10,12 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta15" } "tezos-base" + "tezos-storage" + "tezos-node-p2p-base" + "tezos-node-services" + "tezos-node-http" + "tezos-node-updater" + "tezos-protocol-compiler" "tezos-embedded-protocol-genesis" "tezos-embedded-protocol-demo" "tezos-embedded-protocol-alpha" diff --git a/lib_embedded_protocol_alpha/src/contract_repr.ml b/lib_embedded_protocol_alpha/src/contract_repr.ml index fdbe32b87..450c64f6c 100644 --- a/lib_embedded_protocol_alpha/src/contract_repr.ml +++ b/lib_embedded_protocol_alpha/src/contract_repr.ml @@ -125,7 +125,7 @@ let arg = match of_b58check hash with | Error _ -> Error "Cannot parse contract id" | Ok contract -> Ok contract in - RPC.Arg.make + RPC_arg.make ~descr: "A contract identifier encoded in b58check." ~name: "contract_id" ~construct diff --git a/lib_embedded_protocol_alpha/src/contract_repr.mli b/lib_embedded_protocol_alpha/src/contract_repr.mli index 8dd71330b..0de80bdeb 100644 --- a/lib_embedded_protocol_alpha/src/contract_repr.mli +++ b/lib_embedded_protocol_alpha/src/contract_repr.mli @@ -58,7 +58,7 @@ val encoding : contract Data_encoding.t val origination_nonce_encoding : origination_nonce Data_encoding.t -val arg : contract RPC.Arg.arg +val arg : contract RPC_arg.arg module Index : sig type t = contract diff --git a/lib_embedded_protocol_alpha/src/cycle_repr.ml b/lib_embedded_protocol_alpha/src/cycle_repr.ml index 603515fa7..5c78977e7 100644 --- a/lib_embedded_protocol_alpha/src/cycle_repr.ml +++ b/lib_embedded_protocol_alpha/src/cycle_repr.ml @@ -17,7 +17,7 @@ let arg = match Int32.of_string str with | exception _ -> Error "Cannot parse cycle" | cycle -> Ok cycle in - RPC.Arg.make + RPC_arg.make ~descr:"A cycle integer" ~name: "block_cycle" ~construct diff --git a/lib_embedded_protocol_alpha/src/cycle_repr.mli b/lib_embedded_protocol_alpha/src/cycle_repr.mli index 6cbbd5a3e..8b35ca311 100644 --- a/lib_embedded_protocol_alpha/src/cycle_repr.mli +++ b/lib_embedded_protocol_alpha/src/cycle_repr.mli @@ -11,7 +11,7 @@ type t type cycle = t include Compare.S with type t := t val encoding: cycle Data_encoding.t -val arg: cycle RPC.Arg.arg +val arg: cycle RPC_arg.arg val pp: Format.formatter -> cycle -> unit val root: cycle diff --git a/lib_embedded_protocol_alpha/src/raw_level_repr.ml b/lib_embedded_protocol_alpha/src/raw_level_repr.ml index 655165699..7d2f086f6 100644 --- a/lib_embedded_protocol_alpha/src/raw_level_repr.ml +++ b/lib_embedded_protocol_alpha/src/raw_level_repr.ml @@ -18,7 +18,7 @@ let arg = match Int32.of_string str with | exception _ -> Error "Cannot parse level" | raw_level -> Ok raw_level in - RPC.Arg.make + RPC_arg.make ~descr:"A level integer" ~name: "block_level" ~construct diff --git a/lib_embedded_protocol_alpha/src/raw_level_repr.mli b/lib_embedded_protocol_alpha/src/raw_level_repr.mli index edb395d7f..86f4bdba4 100644 --- a/lib_embedded_protocol_alpha/src/raw_level_repr.mli +++ b/lib_embedded_protocol_alpha/src/raw_level_repr.mli @@ -10,7 +10,7 @@ type t type raw_level = t val encoding: raw_level Data_encoding.t -val arg: raw_level RPC.Arg.arg +val arg: raw_level RPC_arg.arg val pp: Format.formatter -> raw_level -> unit include Compare.S with type t := raw_level diff --git a/lib_embedded_protocol_alpha/src/services.ml b/lib_embedded_protocol_alpha/src/services.ml index ff015f419..78ed962eb 100644 --- a/lib_embedded_protocol_alpha/src/services.ml +++ b/lib_embedded_protocol_alpha/src/services.ml @@ -36,188 +36,188 @@ let wrap_tzerror encoding = let operations custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "All the operations of the block (fully decoded)." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ (list (list (dynamic_size Operation.encoding)))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "operations") + RPC_path.(custom_root / "operations") let header custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "The header of the block (fully decoded)." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror Block_header.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "header") + RPC_path.(custom_root / "header") module Header = struct let priority custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Baking priority of the block." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror uint16) ~error: Data_encoding.empty - RPC.Path.(custom_root / "header" / "priority") + RPC_path.(custom_root / "header" / "priority") let seed_nonce_hash custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Hash of the seed nonce of the block." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror Nonce_hash.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "header" / "seed_nonce_hash") + RPC_path.(custom_root / "header" / "seed_nonce_hash") end module Constants = struct let cycle_length custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Cycle length" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "cycle length" int32) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "cycle_length") + RPC_path.(custom_root / "constants" / "cycle_length") let voting_period_length custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Length of the voting period" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "voting period length" int32) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "voting_period_length") + RPC_path.(custom_root / "constants" / "voting_period_length") let time_before_reward custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Time before reward" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "time before reward" Period.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "time_before_reward") + RPC_path.(custom_root / "constants" / "time_before_reward") let slot_durations custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Slot durations" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "time between slots" (list Period.encoding)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "time_between_slots") + RPC_path.(custom_root / "constants" / "time_between_slots") let first_free_baking_slot custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "First free baking slot" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "first free baking slot" uint16) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "first_free_baking_slot") + RPC_path.(custom_root / "constants" / "first_free_baking_slot") let max_signing_slot custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Max signing slot" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "max signing slot" uint16) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "max_signing_slot") + RPC_path.(custom_root / "constants" / "max_signing_slot") let instructions_per_transaction custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Instructions per transaction" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "instructions per transaction" int31) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "instructions_per_transaction") + RPC_path.(custom_root / "constants" / "instructions_per_transaction") let proof_of_work_threshold custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Stamp threshold" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "proof_of_work threshold" int64) ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "proof_of_work_threshold") + RPC_path.(custom_root / "constants" / "proof_of_work_threshold") let errors custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Schema for all the RPC errors from this protocol version" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: json_schema ~error: Data_encoding.empty - RPC.Path.(custom_root / "constants" / "errors") + RPC_path.(custom_root / "constants" / "errors") end module Context = struct let level custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Detailled level information for the current block" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "detailled level info" Level.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "level") + RPC_path.(custom_root / "context" / "level") let next_level custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Detailled level information for the next block" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "detailled level info" Level.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "next_level") + RPC_path.(custom_root / "context" / "next_level") let roll_value custom_root = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror Tez.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "roll_value") + RPC_path.(custom_root / "context" / "roll_value") let next_roll custom_root = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror int32) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "next_roll") + RPC_path.(custom_root / "context" / "next_roll") let voting_period_kind custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Voting period kind for the current block" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ (obj1 (req "voting_period_kind" Voting_period.kind_encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "voting_period_kind") + RPC_path.(custom_root / "context" / "voting_period_kind") module Nonce = struct @@ -244,23 +244,23 @@ module Context = struct ] let get custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Info about the nonce of a previous block." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror nonce_encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "nonce" /: Raw_level.arg) + RPC_path.(custom_root / "context" / "nonce" /: Raw_level.arg) let hash custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Hash of the current block's nonce." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "nonce hash" Nonce_hash.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "nonce") + RPC_path.(custom_root / "context" / "nonce") end @@ -272,7 +272,7 @@ module Context = struct match Ed25519.Public_key_hash.of_b58check_opt hash with | None -> Error "Cannot parse public key hash" | Some public_key_hash -> Ok public_key_hash in - RPC.Arg.make + RPC_arg.make ~descr:"A public key hash" ~name: "public_key_hash" ~construct @@ -285,22 +285,22 @@ module Context = struct (req "public_key" Ed25519.Public_key.encoding)) let list custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List the known public keys" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ list pk_encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "keys") + RPC_path.(custom_root / "context" / "keys") let get custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Fetch the stored public key" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ pk_encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "keys" /: public_key_hash_arg ) + RPC_path.(custom_root / "context" / "keys" /: public_key_hash_arg ) end @@ -309,76 +309,76 @@ module Context = struct module Contract = struct let balance custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Access the balance of a contract." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror Tez.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "balance") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "balance") let manager custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Access the manager of a contract." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror Ed25519.Public_key_hash.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "manager") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "manager") let delegate custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Access the delegate of a contract, if any." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror (option Ed25519.Public_key_hash.encoding)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "delegate") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "delegate") let counter custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Access the counter of a contract, if any." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror int32) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "counter") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "counter") let spendable custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Tells if the contract tokens can be spent by the manager." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror bool) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "spendable") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "spendable") let delegatable custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Tells if the contract delegate can be changed." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror bool) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "delegatable") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "delegatable") let script custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Access the code and data of the contract." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror (option Script.encoding)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "script") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "script") let storage custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Access the data of the contract." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror (option Script.expr_encoding)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "storage") + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "storage") type info = { manager: public_key_hash ; @@ -390,9 +390,9 @@ module Context = struct } let get custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Access the complete status of a contract." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ @@ -411,17 +411,17 @@ module Context = struct (opt "script" Script.encoding) (req "counter" int32)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg) + RPC_path.(custom_root / "context" / "contracts" /: Contract.arg) let list custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "All existing contracts (including non-empty default contracts)." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ list Contract.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "context" / "contracts") + RPC_path.(custom_root / "context" / "contracts") end @@ -432,14 +432,14 @@ end module Helpers = struct let minimal_timestamp custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Minimal timestamp for the next block." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (opt "priority" int31)) ~output: (wrap_tzerror @@ obj1 (req "timestamp" Timestamp.encoding)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "minimal_timestamp") + RPC_path.(custom_root / "helpers" / "minimal_timestamp") let run_code_input_encoding = (obj6 @@ -451,21 +451,21 @@ module Helpers = struct (opt "origination_nonce" Contract.origination_nonce_encoding)) let run_code custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Run a piece of code in the current context" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: run_code_input_encoding ~output: (wrap_tzerror (obj2 (req "storage" Script.expr_encoding) (req "output" Script.expr_encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "run_code") + RPC_path.(custom_root / "helpers" / "run_code") let apply_operation custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Applies an operation in the current context" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj4 (req "pred_block" Block_hash.encoding) (req "operation_hash" Operation_hash.encoding) @@ -474,14 +474,14 @@ module Helpers = struct ~output: (wrap_tzerror (obj1 (req "contracts" (list Contract.encoding)))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "apply_operation") + RPC_path.(custom_root / "helpers" / "apply_operation") let trace_code custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Run a piece of code in the current context, \ keeping a trace" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: run_code_input_encoding ~output: (wrap_tzerror (obj3 @@ -493,55 +493,55 @@ module Helpers = struct (req "gas" int31) (req "stack" (list (Script.expr_encoding))))))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "trace_code") + RPC_path.(custom_root / "helpers" / "trace_code") let typecheck_code custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Typecheck a piece of code in the current context" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: Script.expr_encoding ~output: (wrap_tzerror Script_ir_translator.type_map_enc) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "typecheck_code") + RPC_path.(custom_root / "helpers" / "typecheck_code") let typecheck_data custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Check that some data expression is well formed \ and of a given type in the current context" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj2 (req "data" Script.expr_encoding) (req "type" Script.expr_encoding)) ~output: (wrap_tzerror empty) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "typecheck_data") + RPC_path.(custom_root / "helpers" / "typecheck_data") let hash_data custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Computes the hash of some data expression \ using the same algorithm as script instruction H" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (req "data" Script.expr_encoding)) ~output: (wrap_tzerror @@ obj1 (req "hash" string)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "hash_data") + RPC_path.(custom_root / "helpers" / "hash_data") let level custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "..." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (opt "offset" int32)) ~output: (wrap_tzerror @@ describe ~title: "block level and cycle information" Level.encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "level" /: Raw_level.arg) + RPC_path.(custom_root / "helpers" / "level" /: Raw_level.arg) let levels custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Levels of a cycle" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ describe ~title: "levels of a cycle" @@ -549,7 +549,7 @@ module Helpers = struct (req "first" Raw_level.encoding) (req "last" Raw_level.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "levels" /: Cycle.arg) + RPC_path.(custom_root / "helpers" / "levels" /: Cycle.arg) module Rights = struct @@ -571,11 +571,11 @@ module Helpers = struct (req "timestamp" Timestamp.encoding)) let baking_rights custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List gelegates allowed to bake for the next level, \ ordered by priority." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) ~output: (wrap_tzerror @@ obj2 @@ -586,14 +586,14 @@ module Helpers = struct (req "delegate" Ed25519.Public_key_hash.encoding) (req "timestamp" Timestamp.encoding))))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" / "baking") + RPC_path.(custom_root / "helpers" / "rights" / "baking") let baking_rights_for_level custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List delegate allowed to bake for a given level, \ ordered by priority." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) ~output: (wrap_tzerror @@ obj2 @@ -601,49 +601,49 @@ module Helpers = struct (req "delegates" (list Ed25519.Public_key_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "baking" / "level" /: Raw_level.arg ) let baking_levels custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List level for which we might computed baking rights." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ obj1 (req "levels" (list Raw_level.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "baking" / "level" ) let baking_rights_for_delegate custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Future baking rights for a given delegate." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: slots_range_encoding ~output: (wrap_tzerror (Data_encoding.list baking_slot_encoding)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "baking" / "delegate" /: Context.Key.public_key_hash_arg ) let baking_delegates custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List delegates with baking rights." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ obj1 (req "delegates" (list Ed25519.Public_key_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "baking" / "delegate" ) let endorsement_rights custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List delegates allowed to endorse for the current block." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) ~output: (wrap_tzerror @@ obj2 @@ -651,13 +651,13 @@ module Helpers = struct (req "delegates" (list Ed25519.Public_key_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" / "endorsement") + RPC_path.(custom_root / "helpers" / "rights" / "endorsement") let endorsement_rights_for_level custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List delegates allowed to endorse blocks for a given level." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (opt "max_priority" int31)) ~output: (wrap_tzerror @@ obj2 @@ -665,42 +665,42 @@ module Helpers = struct (req "delegates" (list Ed25519.Public_key_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "endorsement" / "level" /: Raw_level.arg ) let endorsement_levels custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List level for which we might computed endorsement rights." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ obj1 (req "levels" (list Raw_level.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "endorsement" / "level" ) let endorsement_rights_for_delegate custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Compute endorsement rights for a given delegate." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: slots_range_encoding ~output: (wrap_tzerror @@ Data_encoding.list endorsement_slot_encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "endorsement" / "delegate" /: Context.Key.public_key_hash_arg ) let endorsement_delegates custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "List delegates with endorsement rights." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (wrap_tzerror @@ obj1 (req "delegates" (list Ed25519.Public_key_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "rights" + RPC_path.(custom_root / "helpers" / "rights" / "endorsement" / "delegate" ) end @@ -708,9 +708,9 @@ module Helpers = struct module Forge = struct let operations custom_root = - RPC.Service.post_service + RPC_service.post_service ~description:"Forge an operation" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: Operation.unsigned_operation_encoding ~output: (wrap_tzerror @@ @@ -718,16 +718,16 @@ module Helpers = struct (req "operation" @@ describe ~title: "hex encoded operation" bytes))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "forge" / "operations" ) + RPC_path.(custom_root / "helpers" / "forge" / "operations" ) let empty_proof_of_work_nonce = MBytes.of_string (String.make Constants_repr.proof_of_work_nonce_size '\000') let block_proto_header custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "Forge the protocol-specific part of a block header" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj3 (req "priority" uint16) @@ -738,16 +738,16 @@ module Helpers = struct empty_proof_of_work_nonce)) ~output: (wrap_tzerror bytes) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "forge" / "block_proto_header") + RPC_path.(custom_root / "helpers" / "forge" / "block_proto_header") end module Parse = struct let operations custom_root = - RPC.Service.post_service + RPC_service.post_service ~description:"Parse operations" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj2 (req "operations" (list (dynamic_size Operation.raw_encoding))) @@ -755,16 +755,16 @@ module Helpers = struct ~output: (wrap_tzerror (list (dynamic_size Operation.encoding))) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "parse" / "operations" ) + RPC_path.(custom_root / "helpers" / "parse" / "operations" ) let block custom_root = - RPC.Service.post_service + RPC_service.post_service ~description:"Parse a block" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: Block_header.raw_encoding ~output: (wrap_tzerror Block_header.proto_header_encoding) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "parse" / "block" ) + RPC_path.(custom_root / "helpers" / "parse" / "block" ) end diff --git a/lib_embedded_protocol_alpha/src/services_registration.ml b/lib_embedded_protocol_alpha/src/services_registration.ml index 502c9c309..926668c61 100644 --- a/lib_embedded_protocol_alpha/src/services_registration.ml +++ b/lib_embedded_protocol_alpha/src/services_registration.ml @@ -26,34 +26,34 @@ let rpc_init Tezos_context.init ~level ~timestamp ~fitness context >>=? fun context -> return { block_hash ; block_header ; operation_hashes ; operations ; context } -let rpc_services = ref (RPC.Directory.empty : Updater.rpc_context RPC.Directory.t) +let rpc_services = ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t) let register0_fullctxt s f = rpc_services := - RPC.Directory.register !rpc_services (s RPC.Path.open_root) + RPC_directory.register !rpc_services (s RPC_path.open_root) (fun ctxt q () -> ( rpc_init ctxt >>=? fun ctxt -> - f ctxt q) >>= RPC.Answer.return) + f ctxt q) >>= RPC_answer.return) let register0 s f = register0_fullctxt s (fun { context ; _ } -> f context) let register1_fullctxt s f = rpc_services := - RPC.Directory.register !rpc_services (s RPC.Path.open_root) + RPC_directory.register !rpc_services (s RPC_path.open_root) (fun ctxt q arg -> ( rpc_init ctxt >>=? fun ctxt -> - f ctxt q arg ) >>= RPC.Answer.return) + f ctxt q arg ) >>= RPC_answer.return) let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x) let register1_noctxt s f = rpc_services := - RPC.Directory.register !rpc_services (s RPC.Path.open_root) - (fun _ q arg -> f q arg >>= RPC.Answer.return) + RPC_directory.register !rpc_services (s RPC_path.open_root) + (fun _ q arg -> f q arg >>= RPC_answer.return) let register2_fullctxt s f = rpc_services := - RPC.Directory.register !rpc_services (s RPC.Path.open_root) + RPC_directory.register !rpc_services (s RPC_path.open_root) (fun (ctxt, arg1) q arg2 -> ( rpc_init ctxt >>=? fun ctxt -> - f ctxt q arg1 arg2 ) >>= RPC.Answer.return) + f ctxt q arg1 arg2 ) >>= RPC_answer.return) let register2 s f = register2_fullctxt s (fun { context ; _ } q x y -> f context q x y) @@ -214,12 +214,12 @@ let () = let () = let register2 s f = rpc_services := - RPC.Directory.register !rpc_services (s RPC.Path.open_root) + RPC_directory.register !rpc_services (s RPC_path.open_root) (fun (ctxt, contract) () arg -> ( rpc_init ctxt >>=? fun { context = ctxt ; _ } -> Contract.exists ctxt contract >>=? function | true -> f ctxt contract arg - | false -> raise Not_found ) >>= RPC.Answer.return) in + | false -> raise Not_found ) >>= RPC_answer.return) in let register2' s f = register2 s (fun ctxt a1 () -> f ctxt a1) in register2' Services.Context.Contract.balance Contract.get_balance ; register2' Services.Context.Contract.manager Contract.get_manager ; diff --git a/lib_embedded_protocol_alpha/src/tezos_context.mli b/lib_embedded_protocol_alpha/src/tezos_context.mli index bd6f4fdc4..028dbc591 100644 --- a/lib_embedded_protocol_alpha/src/tezos_context.mli +++ b/lib_embedded_protocol_alpha/src/tezos_context.mli @@ -83,7 +83,7 @@ module Raw_level : sig include BASIC_DATA type raw_level = t - val arg: raw_level RPC.Arg.arg + val arg: raw_level RPC_arg.arg val diff: raw_level -> raw_level -> int32 @@ -98,7 +98,7 @@ module Cycle : sig include BASIC_DATA type cycle = t - val arg: cycle RPC.Arg.arg + val arg: cycle RPC_arg.arg val root: cycle val succ: cycle -> cycle @@ -304,7 +304,7 @@ module Voting_period : sig include BASIC_DATA type voting_period = t - val arg: voting_period RPC.Arg.arg + val arg: voting_period RPC_arg.arg val root: voting_period val succ: voting_period -> voting_period @@ -403,7 +403,7 @@ module Contract : sig include BASIC_DATA type contract = t - val arg: contract RPC.Arg.arg + val arg: contract RPC_arg.arg val to_b58check: contract -> string val of_b58check: string -> contract tzresult diff --git a/lib_embedded_protocol_alpha/src/voting_period_repr.ml b/lib_embedded_protocol_alpha/src/voting_period_repr.ml index f10716ac7..56e10491a 100644 --- a/lib_embedded_protocol_alpha/src/voting_period_repr.ml +++ b/lib_embedded_protocol_alpha/src/voting_period_repr.ml @@ -18,7 +18,7 @@ let arg = match Int32.of_string str with | exception _ -> Error "Cannot parse voting period" | voting_period -> Ok voting_period in - RPC.Arg.make + RPC_arg.make ~descr:"A voting period" ~name: "voting_period" ~construct diff --git a/lib_embedded_protocol_alpha/src/voting_period_repr.mli b/lib_embedded_protocol_alpha/src/voting_period_repr.mli index 24d81d5cc..4b2f786c0 100644 --- a/lib_embedded_protocol_alpha/src/voting_period_repr.mli +++ b/lib_embedded_protocol_alpha/src/voting_period_repr.mli @@ -10,7 +10,7 @@ type t type voting_period = t val encoding: voting_period Data_encoding.t -val arg: voting_period RPC.Arg.arg +val arg: voting_period RPC_arg.arg val pp: Format.formatter -> voting_period -> unit include Compare.S with type t := voting_period diff --git a/lib_embedded_protocol_demo/src/services.ml b/lib_embedded_protocol_demo/src/services.ml index a4a6702c6..5d1f28514 100644 --- a/lib_embedded_protocol_demo/src/services.ml +++ b/lib_embedded_protocol_demo/src/services.ml @@ -32,34 +32,34 @@ let wrap_tzerror encoding = ] let echo_service custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "An dummy echo service" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: Data_encoding.(obj1 (req "msg" string)) ~output: Data_encoding.(obj1 (req "msg" string)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "echo") + RPC_path.(custom_root / "echo") let failing_service custom_root = - RPC.Service.post_service + RPC_service.post_service ~description: "A failing service" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: Data_encoding.(obj1 (req "arg" int31)) ~output: (wrap_tzerror Data_encoding.empty) ~error: Data_encoding.empty - RPC.Path.(custom_root / "failing") + RPC_path.(custom_root / "failing") -let rpc_services : Updater.rpc_context RPC.Directory.t = let dir = RPC.Directory.empty in +let rpc_services : Updater.rpc_context RPC_directory.t = let dir = RPC_directory.empty in let dir = - RPC.Directory.register + RPC_directory.register dir - (failing_service RPC.Path.open_root) - (fun _ctxt () x -> Error.demo_error x >>= RPC.Answer.return) + (failing_service RPC_path.open_root) + (fun _ctxt () x -> Error.demo_error x >>= RPC_answer.return) in let dir = - RPC.Directory.register + RPC_directory.register dir - (echo_service RPC.Path.open_root) - (fun _ctxt () x -> RPC.Answer.return x) + (echo_service RPC_path.open_root) + (fun _ctxt () x -> RPC_answer.return x) in dir diff --git a/lib_embedded_protocol_genesis/src/services.ml b/lib_embedded_protocol_genesis/src/services.ml index 821634f0e..bc54c5b0b 100644 --- a/lib_embedded_protocol_genesis/src/services.ml +++ b/lib_embedded_protocol_genesis/src/services.ml @@ -34,9 +34,9 @@ let wrap_tzerror encoding = module Forge = struct let block custom_root = let open Data_encoding in - RPC.Service.post_service + RPC_service.post_service ~description: "Forge a block" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (merge_objs (obj6 @@ -49,7 +49,7 @@ module Forge = struct Data.Command.encoding) ~output: (obj1 (req "payload" bytes)) ~error: Data_encoding.empty - RPC.Path.(custom_root / "helpers" / "forge" / "block") + RPC_path.(custom_root / "helpers" / "forge" / "block") end let int64_to_bytes i = @@ -60,16 +60,16 @@ let int64_to_bytes i = let operations_hash = Operation_list_list_hash.compute [] -let rpc_services : Updater.rpc_context RPC.Directory.t = - let dir = RPC.Directory.empty in +let rpc_services : Updater.rpc_context RPC_directory.t = + let dir = RPC_directory.empty in let dir = - RPC.Directory.register + RPC_directory.register dir - (Forge.block RPC.Path.open_root) + (Forge.block RPC_path.open_root) (fun _ctxt () ((_net_id, level, proto_level, predecessor, timestamp, fitness), command) -> let shell = { Block_header.level ; proto_level ; predecessor ; timestamp ; fitness ; validation_passes = 0 ; operations_hash } in let bytes = Data.Command.forge shell command in - RPC.Answer.return bytes) in + RPC_answer.return bytes) in dir diff --git a/lib_node_http/RPC_answer.ml b/lib_node_http/RPC_answer.ml new file mode 100644 index 000000000..6fe3754d5 --- /dev/null +++ b/lib_node_http/RPC_answer.ml @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include Resto_directory.Answer diff --git a/lib_node_http/RPC_answer.mli b/lib_node_http/RPC_answer.mli new file mode 100644 index 000000000..276284f44 --- /dev/null +++ b/lib_node_http/RPC_answer.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include module type of (struct include Resto_directory.Answer end) diff --git a/lib_node_http/RPC_client.ml b/lib_node_http/RPC_client.ml index d3472c2d2..6e245c34c 100644 --- a/lib_node_http/RPC_client.ml +++ b/lib_node_http/RPC_client.ml @@ -7,7 +7,7 @@ (* *) (**************************************************************************) -module Client = Resto_cohttp.Client.Make(RPC.Data) +module Client = Resto_cohttp.Client.Make(RPC_encoding) module type LOGGER = Client.LOGGER type logger = (module LOGGER) @@ -32,7 +32,7 @@ type rest_error = | Connection_failed of string | Not_found | Bad_request of string - | Method_not_allowed of RPC.meth list + | Method_not_allowed of RPC_service.meth list | Unsupported_media_type of string option | Not_acceptable of { proposed: string ; acceptable: string } | Unexpected_status_code of { code: Cohttp.Code.status_code ; @@ -68,7 +68,7 @@ let rest_error_encoding = case ~tag: 3 (obj2 (req "kind" (constant "method_not_allowed")) - (req "allowed" (list RPC.meth_encoding))) + (req "allowed" (list RPC_service.meth_encoding))) (function Method_not_allowed meths -> Some ((), meths) | _ -> None) (function ((), meths) -> Method_not_allowed meths) ; case ~tag: 4 @@ -145,7 +145,7 @@ let pp_rest_error ppf err = Format.fprintf ppf "@[The requested service only accepts the following method:@ %a@]" (Format.pp_print_list - (fun ppf m -> Format.pp_print_string ppf (RPC.string_of_meth m))) + (fun ppf m -> Format.pp_print_string ppf (RPC_service.string_of_meth m))) meths | Unsupported_media_type None -> Format.fprintf ppf @@ -177,7 +177,7 @@ let pp_rest_error ppf err = "Generic error" type error += - | Request_failed of { meth: RPC.meth ; + | Request_failed of { meth: RPC_service.meth ; uri: Uri.t ; error: rest_error } @@ -199,11 +199,11 @@ let () = \ - meth: %s@ \ \ - uri: %s@ \ \ - error: %a@]" - (RPC.string_of_meth meth) + (RPC_service.string_of_meth meth) (Uri.to_string uri) pp_rest_error error) Data_encoding.(obj3 - (req "meth" RPC.meth_encoding) + (req "meth" RPC_service.meth_encoding) (req "uri" uri_encoding) (req "error" rest_error_encoding)) (function @@ -212,7 +212,7 @@ let () = (fun (meth, uri, error) -> Request_failed { uri ; meth ; error }) let request_failed meth uri error = - let meth = ( meth : [< RPC.meth ] :> RPC.meth) in + let meth = ( meth : [< RPC_service.meth ] :> RPC_service.meth) in fail (Request_failed { meth ; uri ; error }) let generic_call ?logger ?accept ?body ?media meth uri : (content, content) rest_result Lwt.t = @@ -230,7 +230,7 @@ let generic_call ?logger ?accept ?body ?media meth uri : (content, content) rest request_failed meth uri (Unexpected_status_code { code ; content ; media_type }) | `Method_not_allowed allowed -> - let allowed = List.filter_map RPC.meth_of_string allowed in + let allowed = List.filter_map RPC_service.meth_of_string allowed in request_failed meth uri (Method_not_allowed allowed) | `Unsupported_media_type -> let media = Option.map media ~f:Media_type.name in @@ -310,7 +310,7 @@ let handle accept (meth, uri, ans) = Cohttp_lwt.Body.to_string content >>= fun content -> request_failed meth uri (Unexpected_status_code { code ; content ; media_type }) | `Method_not_allowed allowed -> - let allowed = List.filter_map RPC.meth_of_string allowed in + let allowed = List.filter_map RPC_service.meth_of_string allowed in request_failed meth uri (Method_not_allowed allowed) | `Unsupported_media_type -> let name = @@ -340,7 +340,7 @@ let handle accept (meth, uri, ans) = let call_streamed_service (type p q i o ) - accept ?logger ~base (service : (_,_,p,q,i,o,_) RPC.Service.t) + accept ?logger ~base (service : (_,_,p,q,i,o,_) RPC_service.t) ~on_chunk ~on_close (params : p) (query : q) (body : i) : (unit -> unit) tzresult Lwt.t = Client.call_streamed_service @@ -350,7 +350,7 @@ let call_streamed_service let call_service (type p q i o ) - accept ?logger ~base (service : (_,_,p,q,i,o,_) RPC.Service.t) + accept ?logger ~base (service : (_,_,p,q,i,o,_) RPC_service.t) (params : p) (query : q) (body : i) : o tzresult Lwt.t = Client.call_service diff --git a/lib_node_http/RPC_client.mli b/lib_node_http/RPC_client.mli index d0f79f9ed..9929355e0 100644 --- a/lib_node_http/RPC_client.mli +++ b/lib_node_http/RPC_client.mli @@ -41,7 +41,7 @@ type rest_error = | Connection_failed of string | Not_found | Bad_request of string - | Method_not_allowed of RPC.meth list + | Method_not_allowed of RPC_service.meth list | Unsupported_media_type of string option | Not_acceptable of { proposed: string ; acceptable: string } | Unexpected_status_code of { code: Cohttp.Code.status_code ; @@ -55,7 +55,7 @@ type rest_error = | Generic_error (* temporary *) type error += - | Request_failed of { meth: RPC.meth ; + | Request_failed of { meth: RPC_service.meth ; uri: Uri.t ; error: rest_error } @@ -64,27 +64,27 @@ val generic_call : ?accept:Media_type.t list -> ?body:Cohttp_lwt.Body.t -> ?media:Media_type.t -> - [< RPC.meth ] -> + [< RPC_service.meth ] -> Uri.t -> (content, content) rest_result Lwt.t val generic_json_call : ?logger:logger -> ?body:Data_encoding.json -> - [< RPC.meth ] -> Uri.t -> + [< RPC_service.meth ] -> Uri.t -> (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t val call_service : Media_type.t list -> ?logger:logger -> base:Uri.t -> - ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) RPC.Service.t -> + ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t val call_streamed_service : Media_type.t list -> ?logger:logger -> base:Uri.t -> - ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) RPC.Service.t -> + ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t -> on_chunk: ('o -> unit) -> on_close: (unit -> unit) -> 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t diff --git a/lib_node_http/RPC_directory.ml b/lib_node_http/RPC_directory.ml new file mode 100644 index 000000000..cf02eb8e1 --- /dev/null +++ b/lib_node_http/RPC_directory.ml @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include Resto_directory.Make(RPC_encoding) diff --git a/lib_node_http/RPC_directory.mli b/lib_node_http/RPC_directory.mli new file mode 100644 index 000000000..f04b2f73f --- /dev/null +++ b/lib_node_http/RPC_directory.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include module type of (struct include Resto_directory.Make(RPC_encoding) end) diff --git a/lib_node_http/RPC_server.ml b/lib_node_http/RPC_server.ml index c8a033ae8..4e3b3adca 100644 --- a/lib_node_http/RPC_server.ml +++ b/lib_node_http/RPC_server.ml @@ -12,7 +12,4 @@ type cors = Resto_cohttp.Cors.t = { allowed_origins : string list ; } -include Resto_directory -module Directory = Resto_directory.Make(RPC.Data) - -include Resto_cohttp.Server.Make(RPC.Data)(Logging.RPC) +include Resto_cohttp.Server.Make(RPC_encoding)(Logging.RPC) diff --git a/lib_node_http/RPC_server.mli b/lib_node_http/RPC_server.mli index c632fb5fa..664e67ba2 100644 --- a/lib_node_http/RPC_server.mli +++ b/lib_node_http/RPC_server.mli @@ -7,11 +7,6 @@ (* *) (**************************************************************************) - -module Directory : - (module type of struct include Resto_directory.Make(RPC.Data) end) -include (module type of struct include Resto_directory end) - (** Typed RPC services: server implementation. *) type cors = { @@ -28,7 +23,7 @@ val launch : ?cors:cors -> media_types:Media_type.t list -> Conduit_lwt_unix.server -> - unit Directory.t -> + unit RPC_directory.t -> server Lwt.t (** Kill an RPC server. *) diff --git a/lib_node_http/media_type.ml b/lib_node_http/media_type.ml index 17de025dc..0c8e1260f 100644 --- a/lib_node_http/media_type.ml +++ b/lib_node_http/media_type.ml @@ -7,7 +7,7 @@ (* *) (**************************************************************************) -include Resto_cohttp.Media_type.Make(RPC.Data) +include Resto_cohttp.Media_type.Make(RPC_encoding) let json = { name = Cohttp.Accept.MediaType ("application", "json") ; diff --git a/lib_node_http/media_type.mli b/lib_node_http/media_type.mli index 1b84e846c..10a557bd8 100644 --- a/lib_node_http/media_type.mli +++ b/lib_node_http/media_type.mli @@ -7,7 +7,7 @@ (* *) (**************************************************************************) -type t = Resto_cohttp.Media_type.Make(RPC.Data).t = { +type t = Resto_cohttp.Media_type.Make(RPC_encoding).t = { name: Cohttp.Accept.media_range ; q: int option ; pp: 'a. 'a Data_encoding.t -> Format.formatter -> string -> unit ; diff --git a/lib_node_services/RPC.ml b/lib_node_services/RPC.ml deleted file mode 100644 index 168ce971d..000000000 --- a/lib_node_services/RPC.ml +++ /dev/null @@ -1,160 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2017. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -let meth_encoding = - Data_encoding.string_enum - [ "GET", `GET ; - "POST", `POST ; - "DELETE", `DELETE ; - "PUT", `PUT ; - "PATCH", `PATCH ] - -module Data = struct - type 'a t = 'a Data_encoding.t - type schema = Data_encoding.json_schema - let unit = Data_encoding.empty - let untyped = Data_encoding.(obj1 (req "untyped" string)) - let conv f g t = Data_encoding.conv ~schema:(Data_encoding.Json.schema t) f g t - let schema = Data_encoding.Json.schema - - module StringMap = Resto.StringMap - - let arg_encoding = - let open Data_encoding in - conv - (fun {Resto.Arg.name; descr} -> (name, descr)) - (fun (name, descr) -> {name; descr}) - (obj2 (req "name" string) (opt "descr" string)) - - open Resto.Description - - let path_item_encoding = - let open Data_encoding in - union [ - case ~tag:0 string - (function PStatic s -> Some s | _ -> None) - (fun s -> PStatic s) ; - case ~tag:1 arg_encoding - (function PDynamic s -> Some s | _ -> None) - (fun s -> PDynamic s) ; - ] - - let query_kind_encoding = - let open Data_encoding in - union [ - case ~tag:0 (obj1 (req "single" arg_encoding)) - (function Single s -> Some s | _ -> None) - (fun s -> Single s) ; - case ~tag:1 (obj1 (req "optional" arg_encoding)) - (function Optional s -> Some s | _ -> None) - (fun s -> Optional s) ; - case ~tag:2 (obj1 (req "flag" unit)) - (function Flag -> Some () | _ -> None) - (fun () -> Flag) ; - case ~tag:3 (obj1 (req "multi" arg_encoding)) - (function Multi s -> Some s | _ -> None) - (fun s -> Multi s) ; - ] - - let query_item_encoding = - let open Data_encoding in - conv - (fun { name ; description ; kind } -> (name, description, kind)) - (fun (name, description, kind) -> { name ; description ; kind }) - (obj3 - (req "name" string) - (opt "description" string) - (req "kind" query_kind_encoding)) - - let service_descr_encoding = - let open Data_encoding in - conv - (fun { meth ; path ; description ; query ; input ; output ; error } -> - (meth, path, description, query, input, output, error)) - (fun (meth, path, description, query, input, output, error) -> - { meth ; path ; description ; query ; input ; output ; error }) - (obj7 - (req "meth" meth_encoding) - (req "path" (list path_item_encoding)) - (opt "description" string) - (req "query" (list (dynamic_size query_item_encoding))) - (opt "input" json_schema) - (req "output" json_schema) - (req "erro" json_schema)) - - let directory_descr_encoding = - let open Data_encoding in - mu "service_tree" @@ fun directory_descr_encoding -> - let static_subdirectories_descr_encoding = - union [ - case ~tag:0 (obj1 (req "suffixes" - (list (obj2 (req "name" string) - (req "tree" directory_descr_encoding))))) - (function Suffixes map -> - Some (StringMap.bindings map) | _ -> None) - (fun m -> - let add acc (n,t) = StringMap.add n t acc in - Suffixes (List.fold_left add StringMap.empty m)) ; - case ~tag:1 (obj1 (req "dynamic_dispatch" - (obj2 - (req "arg" arg_encoding) - (req "tree" directory_descr_encoding)))) - (function Arg (ty, tree) -> Some (ty, tree) | _ -> None) - (fun (ty, tree) -> Arg (ty, tree)) - ] in - - let static_directory_descr_encoding = - conv - (fun { services ; subdirs } -> - let find s = - try Some (Resto.MethMap.find s services) with Not_found -> None in - (find `GET, find `POST, find `DELETE, - find `PUT, find `PATCH, subdirs)) - (fun (get, post, delete, put, patch, subdirs) -> - let add meth s services = - match s with - | None -> services - | Some s -> Resto.MethMap.add meth s services in - let services = - Resto.MethMap.empty - |> add `GET get - |> add `POST post - |> add `DELETE delete - |> add `PUT put - |> add `PATCH patch in - { services ; subdirs }) - (obj6 - (opt "get_service" service_descr_encoding) - (opt "post_service" service_descr_encoding) - (opt "delete_service" service_descr_encoding) - (opt "put_service" service_descr_encoding) - (opt "patch_service" service_descr_encoding) - (opt "subdirs" static_subdirectories_descr_encoding)) in - union [ - case ~tag:0 (obj1 (req "static" static_directory_descr_encoding)) - (function Static descr -> Some descr | _ -> None) - (fun descr -> Static descr) ; - case ~tag:1 (obj1 (req "dynamic" (option string))) - (function Dynamic descr -> Some descr | _ -> None) - (fun descr -> Dynamic descr) ; - ] - - let description_request_encoding = - let open Data_encoding in - conv - (fun { recurse } -> recurse) - (function recurse -> { recurse }) - (obj1 (dft "recursive" bool false)) - - let description_answer_encoding = directory_descr_encoding - -end - -include Resto -module Service = Resto.MakeService(Data) diff --git a/lib_node_services/RPC_arg.ml b/lib_node_services/RPC_arg.ml new file mode 100644 index 000000000..e057902b5 --- /dev/null +++ b/lib_node_services/RPC_arg.ml @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include Resto.Arg diff --git a/lib_node_services/RPC_arg.mli b/lib_node_services/RPC_arg.mli new file mode 100644 index 000000000..97c6c60cb --- /dev/null +++ b/lib_node_services/RPC_arg.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include (module type of struct include Resto.Arg end) diff --git a/lib_node_services/RPC_description.ml b/lib_node_services/RPC_description.ml new file mode 100644 index 000000000..cdbd47b6e --- /dev/null +++ b/lib_node_services/RPC_description.ml @@ -0,0 +1,11 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include Resto.Description + diff --git a/lib_node_services/RPC_description.mli b/lib_node_services/RPC_description.mli new file mode 100644 index 000000000..79a4d8b57 --- /dev/null +++ b/lib_node_services/RPC_description.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include (module type of struct include Resto.Description end) diff --git a/lib_node_services/RPC_encoding.ml b/lib_node_services/RPC_encoding.ml new file mode 100644 index 000000000..07ce96ca0 --- /dev/null +++ b/lib_node_services/RPC_encoding.ml @@ -0,0 +1,158 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type 'a t = 'a Data_encoding.t +type schema = Data_encoding.json_schema +let unit = Data_encoding.empty +let untyped = Data_encoding.(obj1 (req "untyped" string)) +let conv f g t = Data_encoding.conv ~schema:(Data_encoding.Json.schema t) f g t +let schema = Data_encoding.Json.schema + +module StringMap = Resto.StringMap + +let arg_encoding = + let open Data_encoding in + conv + (fun {Resto.Arg.name; descr} -> (name, descr)) + (fun (name, descr) -> {name; descr}) + (obj2 (req "name" string) (opt "descr" string)) + +open Resto.Description + +let meth_encoding = + Data_encoding.string_enum + [ "GET", `GET ; + "POST", `POST ; + "DELETE", `DELETE ; + "PUT", `PUT ; + "PATCH", `PATCH ] + +let path_item_encoding = + let open Data_encoding in + union [ + case ~tag:0 string + (function PStatic s -> Some s | _ -> None) + (fun s -> PStatic s) ; + case ~tag:1 arg_encoding + (function PDynamic s -> Some s | _ -> None) + (fun s -> PDynamic s) ; + ] + +let query_kind_encoding = + let open Data_encoding in + union [ + case ~tag:0 + (obj1 (req "single" arg_encoding)) + (function Single s -> Some s | _ -> None) + (fun s -> Single s) ; + case ~tag:1 + (obj1 (req "optional" arg_encoding)) + (function Optional s -> Some s | _ -> None) + (fun s -> Optional s) ; + case ~tag:2 + (obj1 (req "flag" empty)) + (function Flag -> Some () | _ -> None) + (fun () -> Flag) ; + case ~tag:3 + (obj1 (req "multi" arg_encoding)) + (function Multi s -> Some s | _ -> None) + (fun s -> Multi s) ; + ] + +let query_item_encoding = + let open Data_encoding in + conv + (fun { name ; description ; kind } -> (name, description, kind)) + (fun (name, description, kind) -> { name ; description ; kind }) + (obj3 + (req "name" string) + (opt "description" string) + (req "kind" query_kind_encoding)) + +let service_descr_encoding = + let open Data_encoding in + conv + (fun { meth ; path ; description ; query ; input ; output ; error } -> + (meth, path, description, query, input, output, error)) + (fun (meth, path, description, query, input, output, error) -> + { meth ; path ; description ; query ; input ; output ; error }) + (obj7 + (req "meth" meth_encoding) + (req "path" (list path_item_encoding)) + (opt "description" string) + (req "query" (list query_item_encoding)) + (opt "input" json_schema) + (req "output" json_schema) + (req "erro" json_schema)) + +let directory_descr_encoding = + let open Data_encoding in + mu "service_tree" @@ fun directory_descr_encoding -> + let static_subdirectories_descr_encoding = + union [ + case ~tag:0 (obj1 (req "suffixes" + (list (obj2 (req "name" string) + (req "tree" directory_descr_encoding))))) + (function Suffixes map -> + Some (StringMap.bindings map) | _ -> None) + (fun m -> + let add acc (n,t) = StringMap.add n t acc in + Suffixes (List.fold_left add StringMap.empty m)) ; + case ~tag:1 (obj1 (req "dynamic_dispatch" + (obj2 + (req "arg" arg_encoding) + (req "tree" directory_descr_encoding)))) + (function Arg (ty, tree) -> Some (ty, tree) | _ -> None) + (fun (ty, tree) -> Arg (ty, tree)) + ] in + + let static_directory_descr_encoding = + conv + (fun { services ; subdirs } -> + let find s = + try Some (Resto.MethMap.find s services) with Not_found -> None in + (find `GET, find `POST, find `DELETE, + find `PUT, find `PATCH, subdirs)) + (fun (get, post, delete, put, patch, subdirs) -> + let add meth s services = + match s with + | None -> services + | Some s -> Resto.MethMap.add meth s services in + let services = + Resto.MethMap.empty + |> add `GET get + |> add `POST post + |> add `DELETE delete + |> add `PUT put + |> add `PATCH patch in + { services ; subdirs }) + (obj6 + (opt "get_service" service_descr_encoding) + (opt "post_service" service_descr_encoding) + (opt "delete_service" service_descr_encoding) + (opt "put_service" service_descr_encoding) + (opt "patch_service" service_descr_encoding) + (opt "subdirs" static_subdirectories_descr_encoding)) in + union [ + case ~tag:0 (obj1 (req "static" static_directory_descr_encoding)) + (function Static descr -> Some descr | _ -> None) + (fun descr -> Static descr) ; + case ~tag:1 (obj1 (req "dynamic" (option string))) + (function Dynamic descr -> Some descr | _ -> None) + (fun descr -> Dynamic descr) ; + ] + +let description_request_encoding = + let open Data_encoding in + conv + (fun { recurse } -> recurse) + (function recurse -> { recurse }) + (obj1 (dft "recursive" bool false)) + +let description_answer_encoding = directory_descr_encoding diff --git a/lib_node_services/RPC_encoding.mli b/lib_node_services/RPC_encoding.mli new file mode 100644 index 000000000..9129d9a38 --- /dev/null +++ b/lib_node_services/RPC_encoding.mli @@ -0,0 +1,12 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include Resto.ENCODING with type 'a t = 'a Data_encoding.t + and type schema = Data_encoding.json_schema + diff --git a/lib_node_services/RPC_path.ml b/lib_node_services/RPC_path.ml new file mode 100644 index 000000000..a2506fd82 --- /dev/null +++ b/lib_node_services/RPC_path.ml @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include Resto.Path diff --git a/lib_node_services/RPC_path.mli b/lib_node_services/RPC_path.mli new file mode 100644 index 000000000..1e0ceb540 --- /dev/null +++ b/lib_node_services/RPC_path.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include (module type of struct include Resto.Path end) diff --git a/lib_node_services/RPC_query.ml b/lib_node_services/RPC_query.ml new file mode 100644 index 000000000..683383e84 --- /dev/null +++ b/lib_node_services/RPC_query.ml @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include Resto.Query diff --git a/lib_node_services/RPC_query.mli b/lib_node_services/RPC_query.mli new file mode 100644 index 000000000..4b12aad08 --- /dev/null +++ b/lib_node_services/RPC_query.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +include (module type of struct include Resto.Query end) diff --git a/lib_node_services/RPC_service.ml b/lib_node_services/RPC_service.ml new file mode 100644 index 000000000..01b047821 --- /dev/null +++ b/lib_node_services/RPC_service.ml @@ -0,0 +1,27 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ] + +let string_of_meth = Resto.string_of_meth +let meth_of_string = Resto.meth_of_string + +let meth_encoding = + let open Data_encoding in + conv + string_of_meth + (fun m -> + match meth_of_string m with + | None -> Pervasives.failwith "Cannot parse methods" + | Some s -> s) + string + +module MethMap = Resto.MethMap + +include Resto.MakeService(RPC_encoding) diff --git a/lib_node_services/RPC.mli b/lib_node_services/RPC_service.mli similarity index 66% rename from lib_node_services/RPC.mli rename to lib_node_services/RPC_service.mli index a7df996fc..788f83236 100644 --- a/lib_node_services/RPC.mli +++ b/lib_node_services/RPC_service.mli @@ -7,12 +7,12 @@ (* *) (**************************************************************************) -(** Typed RPC services: definition, binding and dispatch. *) - -module Data : Resto.ENCODING with type 'a t = 'a Data_encoding.t - and type schema = Data_encoding.json_schema - -include (module type of struct include Resto end) -module Service : (module type of struct include Resto.MakeService(Data) end) +type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ] +val string_of_meth: [< meth ] -> string +val meth_of_string: string -> [> meth ] option val meth_encoding: meth Data_encoding.t + +module MethMap = Resto.MethMap + +include (module type of struct include Resto.MakeService(RPC_encoding) end) diff --git a/lib_node_services/node_rpc_services.ml b/lib_node_services/node_rpc_services.ml index d263e29bc..3c89deada 100644 --- a/lib_node_services/node_rpc_services.ml +++ b/lib_node_services/node_rpc_services.ml @@ -12,23 +12,23 @@ open Data_encoding module Error = struct let service = - RPC.Service.post_service + RPC_service.post_service ~description: "Schema for all the RPC errors from the shell" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: Data_encoding.empty ~output: Data_encoding.json_schema ~error: Data_encoding.empty - RPC.Path.(root / "errors") + RPC_path.(root / "errors") let encoding = - let { RPC.Service.meth ; uri ; _ } = - RPC.Service.forge_request service () () in + let { RPC_service.meth ; uri ; _ } = + RPC_service.forge_request service () () in describe ~description: (Printf.sprintf "The full list of error is available with \ the global RPC `%s %s`" - (RPC.string_of_meth meth) (Uri.path_and_query uri)) + (RPC_service.string_of_meth meth) (Uri.path_and_query uri)) (conv ~schema:Json_schema.any (fun exn -> `A (List.map json_of_error exn)) @@ -144,84 +144,84 @@ module Blocks = struct of 'head' or 'test_head'." in let construct = to_string in let destruct = parse_block in - RPC.Arg.make ~name ~descr ~construct ~destruct () + RPC_arg.make ~name ~descr ~construct ~destruct () - let block_path : (unit, unit * block) RPC.Path.path = - RPC.Path.(root / "blocks" /: blocks_arg ) + let block_path : (unit, unit * block) RPC_path.path = + RPC_path.(root / "blocks" /: blocks_arg ) let info = - RPC.Service.post_service + RPC_service.post_service ~description:"All the information about a block." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (dft "operations" bool true)) ~output: block_info_encoding ~error: Data_encoding.empty block_path let net_id = - RPC.Service.post_service + RPC_service.post_service ~description:"Returns the net of the chain in which the block belongs." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "net_id" Net_id.encoding)) ~error: Data_encoding.empty - RPC.Path.(block_path / "net_id") + RPC_path.(block_path / "net_id") let level = - RPC.Service.post_service + RPC_service.post_service ~description:"Returns the block's level." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "level" int32)) ~error: Data_encoding.empty - RPC.Path.(block_path / "level") + RPC_path.(block_path / "level") let predecessor = - RPC.Service.post_service + RPC_service.post_service ~description:"Returns the previous block's id." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "predecessor" Block_hash.encoding)) ~error: Data_encoding.empty - RPC.Path.(block_path / "predecessor") + RPC_path.(block_path / "predecessor") let predecessors = - RPC.Service.post_service + RPC_service.post_service ~description: "...." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (req "length" Data_encoding.uint16)) ~output: (obj1 (req "blocks" (Data_encoding.list Block_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(block_path / "predecessors") + RPC_path.(block_path / "predecessors") let hash = - RPC.Service.post_service + RPC_service.post_service ~description:"Returns the block's id." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "hash" Block_hash.encoding)) ~error: Data_encoding.empty - RPC.Path.(block_path / "hash") + RPC_path.(block_path / "hash") let fitness = - RPC.Service.post_service + RPC_service.post_service ~description:"Returns the block's fitness." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "fitness" Fitness.encoding)) ~error: Data_encoding.empty - RPC.Path.(block_path / "fitness") + RPC_path.(block_path / "fitness") let timestamp = - RPC.Service.post_service + RPC_service.post_service ~description:"Returns the block's timestamp." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "timestamp" Time.encoding)) ~error: Data_encoding.empty - RPC.Path.(block_path / "timestamp") + RPC_path.(block_path / "timestamp") type operations_param = { contents: bool ; @@ -238,9 +238,9 @@ module Blocks = struct (dft "monitor" bool false)) let operations = - RPC.Service.post_service + RPC_service.post_service ~description:"List the block operations." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: operations_param_encoding ~output: (obj1 (req "operations" @@ -250,25 +250,25 @@ module Blocks = struct (opt "contents" (dynamic_size Operation.encoding))))))) ~error: Data_encoding.empty - RPC.Path.(block_path / "operations") + RPC_path.(block_path / "operations") let protocol = - RPC.Service.post_service + RPC_service.post_service ~description:"List the block protocol." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "protocol" Protocol_hash.encoding)) ~error: Data_encoding.empty - RPC.Path.(block_path / "protocol") + RPC_path.(block_path / "protocol") let test_network = - RPC.Service.post_service + RPC_service.post_service ~description:"Returns the status of the associated test network." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: Test_network_status.encoding ~error: Data_encoding.empty - RPC.Path.(block_path / "test_network") + RPC_path.(block_path / "test_network") let pending_operations = let operation_encoding = @@ -276,10 +276,10 @@ module Blocks = struct (obj1 (req "hash" Operation_hash.encoding)) Operation.encoding in (* TODO: branch_delayed/... *) - RPC.Service.post_service + RPC_service.post_service ~description: "List the not-yet-prevalidated operations." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (conv @@ -297,10 +297,10 @@ module Blocks = struct (Preapply_result.encoding Error.encoding)) (obj1 (req "unprocessed" (list (dynamic_size operation_encoding)))))) ~error: Data_encoding.empty - RPC.Path.(block_path / "pending_operations") + RPC_path.(block_path / "pending_operations") let proto_path = - RPC.Path.(block_path / "proto") + RPC_path.(block_path / "proto") type preapply_param = { timestamp: Time.t ; @@ -338,30 +338,30 @@ module Blocks = struct (Preapply_result.encoding Error.encoding)))) let preapply = - RPC.Service.post_service + 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 + ~query: RPC_query.empty ~input: preapply_param_encoding ~output: (Error.wrap preapply_result_encoding) ~error: Data_encoding.empty - RPC.Path.(block_path / "preapply") + 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 + 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 + ~query: RPC_query.empty ~input: empty ~output: (list string) ~error: Data_encoding.empty - RPC.Path.(block_path / "complete" /: prefix_arg ) + RPC_path.(block_path / "complete" /: prefix_arg ) type list_param = { include_ops: bool ; @@ -429,23 +429,23 @@ module Blocks = struct int31))) let list = - RPC.Service.post_service + 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 + ~query: RPC_query.empty ~input: list_param_encoding ~output: (obj1 (req "blocks" (list (list block_info_encoding)))) ~error: Data_encoding.empty - RPC.Path.(root / "blocks") + RPC_path.(root / "blocks") let list_invalid = - RPC.Service.post_service + 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 + ~query: RPC_query.empty ~input:empty ~output:(Data_encoding.list (obj3 @@ -453,7 +453,7 @@ module Blocks = struct (req "level" int32) (req "errors" Error.encoding))) ~error: Data_encoding.empty - RPC.Path.(root / "invalid_blocks") + RPC_path.(root / "invalid_blocks") end @@ -467,18 +467,18 @@ module Protocols = struct let destruct h = try Ok (Protocol_hash.of_b58check_exn h) with _ -> Error "Can't parse hash" in - RPC.Arg.make ~name ~descr ~construct ~destruct () + RPC_arg.make ~name ~descr ~construct ~destruct () let contents = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: empty ~output: (obj1 (req "data" (describe ~title: "Tezos protocol" (Protocol.encoding)))) ~error: Data_encoding.empty - RPC.Path.(root / "protocols" /: protocols_arg) + RPC_path.(root / "protocols" /: protocols_arg) type list_param = { contents: bool option ; @@ -494,8 +494,8 @@ module Protocols = struct (opt "monitor" bool)) let list = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: list_param_encoding ~output: (obj1 @@ -507,7 +507,7 @@ module Protocols = struct (dynamic_size Protocol.encoding))) ))) ~error: Data_encoding.empty - RPC.Path.(root / "protocols") + RPC_path.(root / "protocols") end @@ -515,8 +515,8 @@ module Network = struct open P2p_types - let (peer_id_arg : P2p_types.Peer_id.t RPC.Arg.arg) = - RPC.Arg.make + let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.arg) = + RPC_arg.make ~name:"peer_id" ~descr:"A network global identifier, also known as an identity." ~destruct:(fun s -> try @@ -526,7 +526,7 @@ module Network = struct () let point_arg = - RPC.Arg.make + RPC_arg.make ~name:"point" ~descr:"A network point (ipv4:port or [ipv6]:port)." ~destruct:Point.of_string @@ -534,99 +534,99 @@ module Network = struct () let versions = - RPC.Service.post_service + RPC_service.post_service ~description:"Supported network layer versions." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (list P2p_types.Version.encoding) ~error: Data_encoding.empty - RPC.Path.(root / "network" / "versions") + RPC_path.(root / "network" / "versions") let stat = - RPC.Service.post_service + RPC_service.post_service ~description:"Global network bandwidth statistics in B/s." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: P2p_types.Stat.encoding ~error: Data_encoding.empty - RPC.Path.(root / "network" / "stat") + RPC_path.(root / "network" / "stat") let events = - RPC.Service.post_service + RPC_service.post_service ~description:"Stream of all network events" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: P2p_types.Connection_pool_log_event.encoding ~error: Data_encoding.empty - RPC.Path.(root / "network" / "log") + RPC_path.(root / "network" / "log") let connect = - RPC.Service.post_service + RPC_service.post_service ~description:"Connect to a peer" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj1 (dft "timeout" float 5.)) ~output: (Error.wrap @@ empty) ~error: Data_encoding.empty - RPC.Path.(root / "network" / "connect" /: point_arg) + RPC_path.(root / "network" / "connect" /: point_arg) let monitor_encoding = obj1 (dft "monitor" bool false) module Connection = struct let list = - RPC.Service.post_service + RPC_service.post_service ~description:"List the running P2P connection." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (list P2p_types.Connection_info.encoding) ~error: Data_encoding.empty - RPC.Path.(root / "network" / "connection") + RPC_path.(root / "network" / "connection") let info = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: empty ~output: (option P2p_types.Connection_info.encoding) ~error: Data_encoding.empty ~description:"Details about the current P2P connection to the given peer." - RPC.Path.(root / "network" / "connection" /: peer_id_arg) + RPC_path.(root / "network" / "connection" /: peer_id_arg) let kick = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: (obj1 (req "wait" bool)) ~output: empty ~error: Data_encoding.empty ~description:"Forced close of the current P2P connection to the given peer." - RPC.Path.(root / "network" / "connection" /: peer_id_arg / "kick") + RPC_path.(root / "network" / "connection" /: peer_id_arg / "kick") end module Point = struct let info = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: empty ~output: (option P2p_types.Point_info.encoding) ~error: Data_encoding.empty ~description: "Details about a given `IP:addr`." - RPC.Path.(root / "network" / "point" /: point_arg) + RPC_path.(root / "network" / "point" /: point_arg) let events = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: monitor_encoding ~output: (list P2p_connection_pool_types.Point_info.Event.encoding) ~error: Data_encoding.empty ~description: "Monitor network events related to an `IP:addr`." - RPC.Path.(root / "network" / "point" /: point_arg / "log") + RPC_path.(root / "network" / "point" /: point_arg / "log") let list = let filter = obj1 (dft "filter" (list P2p_types.Point_state.encoding) []) in - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: filter ~output: (list (tup2 @@ -635,35 +635,35 @@ module Network = struct ~error: Data_encoding.empty ~description:"List the pool of known `IP:port` \ used for establishing P2P connections ." - RPC.Path.(root / "network" / "point") + RPC_path.(root / "network" / "point") end module Peer_id = struct let info = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: empty ~output: (option P2p_types.Peer_info.encoding) ~error: Data_encoding.empty ~description:"Details about a given peer." - RPC.Path.(root / "network" / "peer_id" /: peer_id_arg) + RPC_path.(root / "network" / "peer_id" /: peer_id_arg) let events = - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: monitor_encoding ~output: (list P2p_connection_pool_types.Peer_info.Event.encoding) ~error: Data_encoding.empty ~description:"Monitor network events related to a given peer." - RPC.Path.(root / "network" / "peer_id" /: peer_id_arg / "log") + RPC_path.(root / "network" / "peer_id" /: peer_id_arg / "log") let list = let filter = obj1 (dft "filter" (list P2p_types.Peer_state.encoding) []) in - RPC.Service.post_service - ~query: RPC.Query.empty + RPC_service.post_service + ~query: RPC_query.empty ~input: filter ~output: (list (tup2 @@ -671,20 +671,20 @@ module Network = struct P2p_types.Peer_info.encoding)) ~error: Data_encoding.empty ~description:"List the peers the node ever met." - RPC.Path.(root / "network" / "peer_id") + RPC_path.(root / "network" / "peer_id") end end let forge_block_header = - RPC.Service.post_service + RPC_service.post_service ~description: "Forge a block header" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: Block_header.encoding ~output: (obj1 (req "block" bytes)) ~error: Data_encoding.empty - RPC.Path.(root / "forge_block_header") + RPC_path.(root / "forge_block_header") type inject_block_param = { raw: MBytes.t ; @@ -723,7 +723,7 @@ let inject_block_param = (list (list (dynamic_size Operation.encoding)))))) let inject_block = - RPC.Service.post_service + RPC_service.post_service ~description: "Inject a block in the node and broadcast it. The `operations` \ embedded in `blockHeader` might be pre-validated using a \ @@ -731,16 +731,16 @@ let inject_block = (e.g. '/blocks/head/context/preapply'). Returns the ID of the \ block. By default, the RPC will wait for the block to be \ validated before answering." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: inject_block_param ~output: (Error.wrap @@ (obj1 (req "block_hash" Block_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(root / "inject_block") + RPC_path.(root / "inject_block") let inject_operation = - RPC.Service.post_service + RPC_service.post_service ~description: "Inject an operation in node and broadcast it. Returns the \ ID of the operation. The `signedOperationContents` should be \ @@ -749,7 +749,7 @@ let inject_operation = the operation to be (pre-)validated before answering. See \ RPCs under /blocks/prevalidation for more details on the \ prevalidation context." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj4 (req "signedOperationContents" @@ -775,13 +775,13 @@ let inject_operation = ~title: "Hash of the injected operation" @@ (obj1 (req "injectedOperation" Operation_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(root / "inject_operation") + RPC_path.(root / "inject_operation") let inject_protocol = - RPC.Service.post_service + RPC_service.post_service ~description: "Inject a protocol in node. Returns the ID of the protocol." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: (obj3 (req "protocol" @@ -804,35 +804,35 @@ let inject_protocol = ~title: "Hash of the injected protocol" @@ (obj1 (req "injectedProtocol" Protocol_hash.encoding))) ~error: Data_encoding.empty - RPC.Path.(root / "inject_protocol") + RPC_path.(root / "inject_protocol") let bootstrapped = - RPC.Service.post_service + RPC_service.post_service ~description:"" - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (obj2 (req "block" Block_hash.encoding) (req "timestamp" Time.encoding)) ~error: Data_encoding.empty - RPC.Path.(root / "bootstrapped") + RPC_path.(root / "bootstrapped") 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 + 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 and hashes of operations." - ~query: RPC.Query.empty + ~query: RPC_query.empty ~input: empty ~output: (list string) ~error: Data_encoding.empty - RPC.Path.(root / "complete" /: prefix_arg ) + RPC_path.(root / "complete" /: prefix_arg ) let describe = - RPC.Service.description_service + RPC_service.description_service ~description: "RPCs documentation and input/output schema" - RPC.Path.(root / "describe") + RPC_path.(root / "describe") diff --git a/lib_node_services/node_rpc_services.mli b/lib_node_services/node_rpc_services.mli index 89bae3610..f3a538fba 100644 --- a/lib_node_services/node_rpc_services.mli +++ b/lib_node_services/node_rpc_services.mli @@ -9,7 +9,7 @@ module Error : sig val service: - ([ `POST ], unit, unit, unit, unit, Json_schema.schema, unit) RPC.Service.t + ([ `POST ], unit, unit, unit, unit, Json_schema.schema, unit) RPC_service.t val encoding: error list Data_encoding.t val wrap: 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding end @@ -22,7 +22,7 @@ module Blocks : sig | `Test_head of int | `Test_prevalidation | `Hash of Block_hash.t ] - val blocks_arg : block RPC.Arg.arg + val blocks_arg : block RPC_arg.arg val parse_block: string -> (block, string) result val to_string: block -> string @@ -46,35 +46,35 @@ module Blocks : sig val info: ([ `POST ], unit, unit * block, unit, bool, - block_info, unit) RPC.Service.t + block_info, unit) RPC_service.t val net_id: ([ `POST ], unit, unit * block, unit, unit, - Net_id.t, unit) RPC.Service.t + Net_id.t, unit) RPC_service.t val level: ([ `POST ], unit, unit * block, unit, unit, - Int32.t, unit) RPC.Service.t + Int32.t, unit) RPC_service.t val predecessor: ([ `POST ], unit, unit * block, unit, unit, - Block_hash.t, unit) RPC.Service.t + Block_hash.t, unit) RPC_service.t val predecessors: ([ `POST ], unit, unit * block , unit, int, - Block_hash.t list, unit) RPC.Service.t + Block_hash.t list, unit) RPC_service.t val hash: ([ `POST ], unit, unit * block, unit, unit, - Block_hash.t, unit) RPC.Service.t + Block_hash.t, unit) RPC_service.t val timestamp: ([ `POST ], unit, unit * block, unit, unit, - Time.t, unit) RPC.Service.t + Time.t, unit) RPC_service.t val fitness: ([ `POST ], unit, unit * block, unit, unit, - MBytes.t list, unit) RPC.Service.t + MBytes.t list, unit) RPC_service.t type operations_param = { contents: bool ; @@ -83,20 +83,20 @@ module Blocks : sig val operations: ([ `POST ], unit, unit * block, unit, operations_param, - (Operation_hash.t * Operation.t option) list list, unit) RPC.Service.t + (Operation_hash.t * Operation.t option) list list, unit) RPC_service.t val protocol: ([ `POST ], unit, unit * block, unit, unit, - Protocol_hash.t, unit) RPC.Service.t + Protocol_hash.t, unit) RPC_service.t val test_network: ([ `POST ], unit, unit * block, unit, unit, - Test_network_status.t, unit) RPC.Service.t + Test_network_status.t, unit) RPC_service.t val pending_operations: ([ `POST ], unit, unit * block, unit, unit, - error Preapply_result.t * Operation.t Operation_hash.Map.t, unit) RPC.Service.t + error Preapply_result.t * Operation.t Operation_hash.Map.t, unit) RPC_service.t type list_param = { include_ops: bool ; @@ -110,12 +110,12 @@ module Blocks : sig val list: ([ `POST ], unit, unit, unit, list_param, - block_info list list, unit) RPC.Service.t + block_info list list, unit) RPC_service.t val list_invalid: ([ `POST ], unit, unit, unit, unit, - (Block_hash.t * int32 * error list) list, unit) RPC.Service.t + (Block_hash.t * int32 * error list) list, unit) RPC_service.t type preapply_param = { timestamp: Time.t ; @@ -131,14 +131,14 @@ module Blocks : sig val preapply: ([ `POST ], unit, unit * block, unit, preapply_param, - preapply_result tzresult, unit) RPC.Service.t + preapply_result tzresult, unit) RPC_service.t val complete: ([ `POST ], unit, (unit * block) * string, unit, unit, - string list, unit) RPC.Service.t + string list, unit) RPC_service.t - val proto_path: (unit, unit * block) RPC.Path.path + val proto_path: (unit, unit * block) RPC_path.path end @@ -148,7 +148,7 @@ module Protocols : sig val contents: ([ `POST ], unit, unit * Protocol_hash.t, unit, unit, - Protocol.t, unit) RPC.Service.t + Protocol.t, unit) RPC_service.t type list_param = { contents: bool option ; @@ -158,7 +158,7 @@ module Protocols : sig val list: ([ `POST ], unit, unit, unit, list_param, - (Protocol_hash.t * Protocol.t option) list, unit) RPC.Service.t + (Protocol_hash.t * Protocol.t option) list, unit) RPC_service.t end @@ -167,39 +167,39 @@ module Network : sig val stat : ([ `POST ], unit, unit, unit, unit, - P2p_types.Stat.t, unit) RPC.Service.t + P2p_types.Stat.t, unit) RPC_service.t val versions : ([ `POST ], unit, unit, unit, unit, - P2p_types.Version.t list, unit) RPC.Service.t + P2p_types.Version.t list, unit) RPC_service.t val events : ([ `POST ], unit, unit, unit, unit, - P2p_types.Connection_pool_log_event.t, unit) RPC.Service.t + P2p_types.Connection_pool_log_event.t, unit) RPC_service.t val connect : ([ `POST ], unit, unit * P2p_types.Point.t, unit, float, - unit tzresult, unit) RPC.Service.t + unit tzresult, unit) RPC_service.t module Connection : sig val list : ([ `POST ], unit, unit, unit, unit, - P2p_types.Connection_info.t list, unit) RPC.Service.t + P2p_types.Connection_info.t list, unit) RPC_service.t val info : ([ `POST ], unit, unit * P2p_types.Peer_id.t, unit, unit, - P2p_types.Connection_info.t option, unit) RPC.Service.t + P2p_types.Connection_info.t option, unit) RPC_service.t val kick : ([ `POST ], unit, unit * P2p_types.Peer_id.t, unit, bool, - unit, unit) RPC.Service.t + unit, unit) RPC_service.t end @@ -207,15 +207,15 @@ module Network : sig val list : ([ `POST ], unit, unit, unit, P2p_types.Point_state.t list, - (P2p_types.Point.t * P2p_types.Point_info.t) list, unit) RPC.Service.t + (P2p_types.Point.t * P2p_types.Point_info.t) list, unit) RPC_service.t val info : ([ `POST ], unit, unit * P2p_types.Point.t, unit, unit, - P2p_types.Point_info.t option, unit) RPC.Service.t + P2p_types.Point_info.t option, unit) RPC_service.t val events : ([ `POST ], unit, unit * P2p_types.Point.t, unit, bool, - P2p_connection_pool_types.Point_info.Event.t list, unit) RPC.Service.t + P2p_connection_pool_types.Point_info.Event.t list, unit) RPC_service.t end module Peer_id : sig @@ -223,17 +223,17 @@ module Network : sig val list : ([ `POST ], unit, unit, unit, P2p_types.Peer_state.t list, - (P2p_types.Peer_id.t * P2p_types.Peer_info.t) list, unit) RPC.Service.t + (P2p_types.Peer_id.t * P2p_types.Peer_info.t) list, unit) RPC_service.t val info : ([ `POST ], unit, unit * P2p_types.Peer_id.t, unit, unit, - P2p_types.Peer_info.t option, unit) RPC.Service.t + P2p_types.Peer_info.t option, unit) RPC_service.t val events : ([ `POST ], unit, unit * P2p_types.Peer_id.t, unit, bool, - P2p_connection_pool_types.Peer_info.Event.t list, unit) RPC.Service.t + P2p_connection_pool_types.Peer_info.Event.t list, unit) RPC_service.t end @@ -242,7 +242,7 @@ end val forge_block_header: ([ `POST ], unit, unit, unit, Block_header.t, - MBytes.t, unit) RPC.Service.t + MBytes.t, unit) RPC_service.t type inject_block_param = { raw: MBytes.t ; @@ -255,26 +255,26 @@ type inject_block_param = { val inject_block: ([ `POST ], unit, unit, unit, inject_block_param, - Block_hash.t tzresult, unit) RPC.Service.t + Block_hash.t tzresult, unit) RPC_service.t val inject_operation: ([ `POST ], unit, unit, unit, (MBytes.t * bool * Net_id.t option * bool option), - Operation_hash.t tzresult, unit) RPC.Service.t + Operation_hash.t tzresult, unit) RPC_service.t val inject_protocol: ([ `POST ], unit, unit, unit, (Protocol.t * bool * bool option), - Protocol_hash.t tzresult, unit) RPC.Service.t + Protocol_hash.t tzresult, unit) RPC_service.t val bootstrapped: ([ `POST ], unit, unit, unit, unit, - Block_hash.t * Time.t, unit) RPC.Service.t + Block_hash.t * Time.t, unit) RPC_service.t val complete: ([ `POST ], unit, unit * string, unit, unit, - string list, unit) RPC.Service.t + string list, unit) RPC_service.t -val describe: (unit, unit) RPC.Service.description_service +val describe: (unit, unit) RPC_service.description_service diff --git a/lib_node_shell/node.ml b/lib_node_shell/node.ml index 9ac59d7ae..e1f2816af 100644 --- a/lib_node_shell/node.ml +++ b/lib_node_shell/node.ml @@ -522,8 +522,8 @@ module RPC = struct | Some rpc_context -> Context.get_protocol rpc_context.context >>= fun protocol_hash -> let (module Proto) = State.Registred_protocol.get_exn protocol_hash in - let dir = RPC_server.Directory.map (fun () -> rpc_context) Proto.rpc_services in - Lwt.return (Some (RPC_server.Directory.map (fun _ -> ()) dir)) + let dir = RPC_directory.map (fun () -> rpc_context) Proto.rpc_services in + Lwt.return (Some (RPC_directory.map (fun _ -> ()) dir)) let heads node = let net_state = Net_validator.net_state node.mainnet_validator in @@ -627,7 +627,7 @@ module RPC = struct ] end in let shutdown () = Lwt_watcher.shutdown stopper in - RPC_server.Answer.{ next ; shutdown } + RPC_answer.{ next ; shutdown } module Network = struct diff --git a/lib_node_shell/node.mli b/lib_node_shell/node.mli index 84abacb42..2d49779c3 100644 --- a/lib_node_shell/node.mli +++ b/lib_node_shell/node.mli @@ -89,7 +89,7 @@ module RPC : sig t -> (Protocol_hash.t * Protocol.t) Lwt_stream.t * Lwt_watcher.stopper val context_dir: - t -> block -> 'a RPC_server.Directory.t option Lwt.t + t -> block -> 'a RPC_directory.t option Lwt.t val preapply: t -> block -> @@ -98,13 +98,13 @@ module RPC : sig (Block_header.shell_header * error Preapply_result.t) tzresult Lwt.t val context_dir: - t -> block -> 'a RPC_server.Directory.t option Lwt.t + t -> block -> 'a RPC_directory.t option Lwt.t val complete: t -> ?block:block -> string -> string list Lwt.t val bootstrapped: - t -> (Block_hash.t * Time.t) RPC_server.Answer.stream + t -> (Block_hash.t * Time.t) RPC_answer.stream module Network : sig diff --git a/lib_node_shell/node_rpc.ml b/lib_node_shell/node_rpc.ml index 6b69bc8bc..33d78a310 100644 --- a/lib_node_shell/node_rpc.ml +++ b/lib_node_shell/node_rpc.ml @@ -36,70 +36,70 @@ let monitor_operations node contents = Lwt.return_some @@ List.map (List.map (fun h -> h, None)) hashes end in - RPC_server.Answer.return_stream { next ; shutdown } + RPC_answer.return_stream { next ; shutdown } let register_bi_dir node dir = let dir = let implementation b () include_ops = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return (filter_bi include_ops bi) in - RPC_server.Directory.register1 dir + RPC_answer.return (filter_bi include_ops bi) in + RPC_directory.register1 dir Services.Blocks.info implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.hash in - RPC_server.Directory.register1 dir + RPC_answer.return bi.hash in + RPC_directory.register1 dir Services.Blocks.hash implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.net_id in - RPC_server.Directory.register1 dir + RPC_answer.return bi.net_id in + RPC_directory.register1 dir Services.Blocks.net_id implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.level in - RPC_server.Directory.register1 dir + RPC_answer.return bi.level in + RPC_directory.register1 dir Services.Blocks.level implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.predecessor in - RPC_server.Directory.register1 dir + RPC_answer.return bi.predecessor in + RPC_directory.register1 dir Services.Blocks.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_server.Answer.return hashes in - RPC_server.Directory.register1 dir + RPC_answer.return hashes in + RPC_directory.register1 dir Services.Blocks.predecessors implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.fitness in - RPC_server.Directory.register1 dir + RPC_answer.return bi.fitness in + RPC_directory.register1 dir Services.Blocks.fitness implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.timestamp in - RPC_server.Directory.register1 dir + RPC_answer.return bi.timestamp in + RPC_directory.register1 dir Services.Blocks.timestamp implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.protocol in - RPC_server.Directory.register1 dir + RPC_answer.return bi.protocol in + RPC_directory.register1 dir Services.Blocks.protocol implementation in let dir = let implementation b () () = Node.RPC.block_info node b >>= fun bi -> - RPC_server.Answer.return bi.test_network in - RPC_server.Directory.register1 dir + RPC_answer.return bi.test_network in + RPC_directory.register1 dir Services.Blocks.test_network implementation in let dir = let implementation b () { Node_rpc_services.Blocks.contents ; monitor } = @@ -110,19 +110,19 @@ let register_bi_dir node dir = Node.RPC.operation_hashes node b >>= fun hashes -> if contents then Node.RPC.operations node b >>= fun ops -> - RPC_server.Answer.return @@ + RPC_answer.return @@ List.map2 (List.map2 (fun h op -> h, Some op)) hashes ops else - RPC_server.Answer.return @@ + RPC_answer.return @@ List.map (List.map (fun h -> h, None)) hashes in - RPC_server.Directory.register1 dir + RPC_directory.register1 dir Services.Blocks.operations implementation in let dir = let implementation b () () = Node.RPC.pending_operations node b >>= fun res -> - RPC_server.Answer.return res in - RPC_server.Directory.register1 dir + RPC_answer.return res in + RPC_directory.register1 dir Services.Blocks.pending_operations implementation in let dir = @@ -133,15 +133,15 @@ let register_bi_dir node dir = Node.RPC.preapply node b ~timestamp ~proto_header ~sort_operations operations >>= function | Ok (shell_header, operations) -> - RPC_server.Answer.return + RPC_answer.return (Ok { Services.Blocks.shell_header ; operations }) - | Error _ as err -> RPC_server.Answer.return err in - RPC_server.Directory.register1 dir + | Error _ as err -> RPC_answer.return err in + RPC_directory.register1 dir Services.Blocks.preapply implementation in dir let ops_dir _node = - let ops_dir = RPC_server.Directory.empty in + let ops_dir = RPC_directory.empty in ops_dir let rec insert_future_block (bi: Services.Blocks.block_info) = function @@ -304,7 +304,7 @@ let list_blocks List.map (List.map (filter_bi include_ops)) requested_blocks in - RPC_server.Answer.return infos + RPC_answer.return infos else begin let (bi_stream, stopper) = Node.RPC.block_watcher node in let stream = @@ -326,12 +326,12 @@ let list_blocks List.map (List.map (filter_bi include_ops)) requested_blocks in Lwt.return (Some infos) end in - RPC_server.Answer.return_stream { next ; shutdown } + RPC_answer.return_stream { next ; shutdown } end let list_invalid node () () = Node.RPC.list_invalid node >>= fun l -> - RPC_server.Answer.return l + RPC_answer.return l let list_protocols node () {Services.Protocols.monitor; contents} = let monitor = match monitor with None -> false | Some x -> x in @@ -347,7 +347,7 @@ let list_protocols node () {Services.Protocols.monitor; contents} = Lwt.return (hash, None)) protocols >>= fun protocols -> if not monitor then - RPC_server.Answer.return protocols + RPC_answer.return protocols else let stream, stopper = Node.RPC.protocol_watcher node in let shutdown () = Lwt_watcher.shutdown stopper in @@ -362,20 +362,20 @@ let list_protocols node () {Services.Protocols.monitor; contents} = first_request := false ; Lwt.return (Some protocols) end in - RPC_server.Answer.return_stream { next ; shutdown } + RPC_answer.return_stream { next ; shutdown } let get_protocols node hash () () = Node.RPC.protocol_content node hash >>= function - | Ok bytes -> RPC_server.Answer.return bytes + | Ok bytes -> RPC_answer.return bytes | Error _ -> raise Not_found let build_rpc_directory node = - let dir = RPC_server.Directory.empty in + let dir = RPC_directory.empty in let dir = - RPC_server.Directory.register0 dir Services.Blocks.list + RPC_directory.register0 dir Services.Blocks.list (list_blocks node) in let dir = - RPC_server.Directory.register0 dir Services.Blocks.list_invalid + RPC_directory.register0 dir Services.Blocks.list_invalid (list_invalid node) in let dir = register_bi_dir node dir in let dir = @@ -384,23 +384,23 @@ let build_rpc_directory node = Node.RPC.context_dir node block >>= function | None -> Lwt.fail Not_found | Some context_dir -> Lwt.return context_dir) - (fun _ -> Lwt.return RPC_server.Directory.empty) in - RPC_server.Directory.register_dynamic_directory1 + (fun _ -> Lwt.return RPC_directory.empty) in + RPC_directory.register_dynamic_directory1 ~descr: "All the RPCs which are specific to the protocol version." dir Services.Blocks.proto_path implementation in let dir = - RPC_server.Directory.register0 dir Services.Protocols.list + RPC_directory.register0 dir Services.Protocols.list (list_protocols node) in let dir = - RPC_server.Directory.register1 dir Services.Protocols.contents + RPC_directory.register1 dir Services.Protocols.contents (get_protocols node) in let dir = let implementation () header = let res = Data_encoding.Binary.to_bytes Block_header.encoding header in - RPC_server.Answer.return res in - RPC_server.Directory.register0 dir Services.forge_block_header + RPC_answer.return res in + RPC_directory.register0 dir Services.forge_block_header implementation in let dir = let implementation () @@ -410,88 +410,88 @@ let build_rpc_directory node = node ~force raw operations >>=? fun (hash, wait) -> (if blocking then wait else return ()) >>=? fun () -> return hash - end >>= RPC_server.Answer.return in - RPC_server.Directory.register0 dir Services.inject_block implementation in + end >>= RPC_answer.return in + RPC_directory.register0 dir Services.inject_block implementation in let dir = let implementation () (contents, blocking, net_id, force) = Node.RPC.inject_operation node ?force ?net_id contents >>= fun (hash, wait) -> begin (if blocking then wait else return ()) >>=? fun () -> return hash - end >>= RPC_server.Answer.return in - RPC_server.Directory.register0 dir Services.inject_operation implementation in + end >>= RPC_answer.return in + RPC_directory.register0 dir Services.inject_operation implementation in let dir = let implementation () (proto, blocking, force) = Node.RPC.inject_protocol ?force node proto >>= fun (hash, wait) -> begin (if blocking then wait else return ()) >>=? fun () -> return hash - end >>= RPC_server.Answer.return in - RPC_server.Directory.register0 dir Services.inject_protocol implementation in + end >>= RPC_answer.return in + RPC_directory.register0 dir Services.inject_protocol implementation in let dir = let implementation () () = - RPC_server.Answer.return_stream (Node.RPC.bootstrapped node) in - RPC_server.Directory.register0 dir Services.bootstrapped implementation in + RPC_answer.return_stream (Node.RPC.bootstrapped node) in + RPC_directory.register0 dir Services.bootstrapped implementation in let dir = let implementation () () = - RPC_server.Answer.return + RPC_answer.return Data_encoding.Json.(schema Error_monad.error_encoding) in - RPC_server.Directory.register0 dir Services.Error.service implementation in + RPC_directory.register0 dir Services.Error.service implementation in let dir = - RPC_server.Directory.register1 dir Services.complete + RPC_directory.register1 dir Services.complete (fun s () () -> - Node.RPC.complete node s >>= RPC_server.Answer.return) in + Node.RPC.complete node s >>= RPC_answer.return) in let dir = - RPC_server.Directory.register2 dir Services.Blocks.complete + RPC_directory.register2 dir Services.Blocks.complete (fun block s () () -> - Node.RPC.complete node ~block s >>= RPC_server.Answer.return) in + Node.RPC.complete node ~block s >>= RPC_answer.return) in (* Network : Global *) let dir = let implementation () () = - Node.RPC.Network.stat node |> RPC_server.Answer.return in - RPC_server.Directory.register0 dir Services.Network.stat implementation in + Node.RPC.Network.stat node |> RPC_answer.return in + RPC_directory.register0 dir Services.Network.stat implementation in let dir = let implementation () () = - RPC_server.Answer.return Distributed_db.Raw.supported_versions in - RPC_server.Directory.register0 dir Services.Network.versions implementation in + RPC_answer.return Distributed_db.Raw.supported_versions in + RPC_directory.register0 dir Services.Network.versions implementation in let dir = let implementation () () = let stream, stopper = Node.RPC.Network.watch node in let shutdown () = Lwt_watcher.shutdown stopper in let next () = Lwt_stream.get stream in - RPC_server.Answer.return_stream { next ; shutdown } in - RPC_server.Directory.register0 dir Services.Network.events implementation in + RPC_answer.return_stream { next ; shutdown } in + RPC_directory.register0 dir Services.Network.events implementation in let dir = let implementation point () timeout = - Node.RPC.Network.connect node point timeout >>= RPC_server.Answer.return in - RPC_server.Directory.register1 dir Services.Network.connect implementation in + Node.RPC.Network.connect node point timeout >>= RPC_answer.return in + RPC_directory.register1 dir Services.Network.connect implementation in (* Network : Connection *) let dir = let implementation peer_id () () = - Node.RPC.Network.Connection.info node peer_id |> RPC_server.Answer.return in - RPC_server.Directory.register1 dir Services.Network.Connection.info implementation in + Node.RPC.Network.Connection.info node peer_id |> RPC_answer.return in + RPC_directory.register1 dir Services.Network.Connection.info implementation in let dir = let implementation peer_id () wait = - Node.RPC.Network.Connection.kick node peer_id wait >>= RPC_server.Answer.return in - RPC_server.Directory.register1 dir Services.Network.Connection.kick implementation in + Node.RPC.Network.Connection.kick node peer_id wait >>= RPC_answer.return in + RPC_directory.register1 dir Services.Network.Connection.kick implementation in let dir = let implementation () () = - Node.RPC.Network.Connection.list node |> RPC_server.Answer.return in - RPC_server.Directory.register0 dir Services.Network.Connection.list implementation in + Node.RPC.Network.Connection.list node |> RPC_answer.return in + RPC_directory.register0 dir Services.Network.Connection.list implementation in (* Network : Peer_id *) let dir = let implementation () state = - Node.RPC.Network.Peer_id.list node ~restrict:state |> RPC_server.Answer.return in - RPC_server.Directory.register0 dir Services.Network.Peer_id.list implementation in + Node.RPC.Network.Peer_id.list node ~restrict:state |> RPC_answer.return in + RPC_directory.register0 dir Services.Network.Peer_id.list implementation in let dir = let implementation peer_id () () = - Node.RPC.Network.Peer_id.info node peer_id |> RPC_server.Answer.return in - RPC_server.Directory.register1 dir Services.Network.Peer_id.info implementation in + Node.RPC.Network.Peer_id.info node peer_id |> RPC_answer.return in + RPC_directory.register1 dir Services.Network.Peer_id.info implementation in let dir = let implementation peer_id () monitor = if monitor then @@ -505,21 +505,21 @@ let build_rpc_directory node = first_request := false ; Lwt.return_some @@ Node.RPC.Network.Peer_id.events node peer_id end in - RPC_server.Answer.return_stream { next ; shutdown } + RPC_answer.return_stream { next ; shutdown } else - Node.RPC.Network.Peer_id.events node peer_id |> RPC_server.Answer.return in - RPC_server.Directory.register1 dir Services.Network.Peer_id.events implementation in + Node.RPC.Network.Peer_id.events node peer_id |> RPC_answer.return in + RPC_directory.register1 dir Services.Network.Peer_id.events implementation in (* Network : Point *) let dir = let implementation () state = - Node.RPC.Network.Point.list node ~restrict:state |> RPC_server.Answer.return in - RPC_server.Directory.register0 dir Services.Network.Point.list implementation in + Node.RPC.Network.Point.list node ~restrict:state |> RPC_answer.return in + RPC_directory.register0 dir Services.Network.Point.list implementation in let dir = let implementation point () () = - Node.RPC.Network.Point.info node point |> RPC_server.Answer.return in - RPC_server.Directory.register1 dir Services.Network.Point.info implementation in + Node.RPC.Network.Point.info node point |> RPC_answer.return in + RPC_directory.register1 dir Services.Network.Point.info implementation in let dir = let implementation point () monitor = if monitor then @@ -533,10 +533,10 @@ let build_rpc_directory node = first_request := false ; Lwt.return_some @@ Node.RPC.Network.Point.events node point end in - RPC_server.Answer.return_stream { next ; shutdown } + RPC_answer.return_stream { next ; shutdown } else - Node.RPC.Network.Point.events node point |> RPC_server.Answer.return in - RPC_server.Directory.register1 dir Services.Network.Point.events implementation in + Node.RPC.Network.Point.events node point |> RPC_answer.return in + RPC_directory.register1 dir Services.Network.Point.events implementation in let dir = - RPC_server.Directory.register_describe_directory_service dir Services.describe in + RPC_directory.register_describe_directory_service dir Services.describe in dir diff --git a/lib_node_shell/node_rpc.mli b/lib_node_shell/node_rpc.mli index 46b9904ed..505334ab6 100644 --- a/lib_node_shell/node_rpc.mli +++ b/lib_node_shell/node_rpc.mli @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -val build_rpc_directory: Node.t -> unit RPC_server.Directory.t +val build_rpc_directory: Node.t -> unit RPC_directory.t diff --git a/lib_node_updater/tezos_protocol_environment.ml b/lib_node_updater/tezos_protocol_environment.ml index 327768c02..50450a723 100644 --- a/lib_node_updater/tezos_protocol_environment.ml +++ b/lib_node_updater/tezos_protocol_environment.ml @@ -56,10 +56,12 @@ module Make(Param : sig val name: string end)() = struct module Block_header = Block_header module Protocol = Protocol end - module RPC = struct - include RPC - include RPC_server - end + module RPC_arg = RPC_arg + module RPC_path = RPC_path + module RPC_query = RPC_query + module RPC_service = RPC_service + module RPC_answer = RPC_answer + module RPC_directory = RPC_directory module Micheline = Tezos_micheline.Micheline module Fitness = Fitness module Error_monad = struct diff --git a/lib_node_updater/updater.ml b/lib_node_updater/updater.ml index a34908ec6..4a9764c8f 100644 --- a/lib_node_updater/updater.ml +++ b/lib_node_updater/updater.ml @@ -108,7 +108,7 @@ module Node_protocol_environment_sigs = struct and type Tezos_data.Operation.t = Operation.t and type Tezos_data.Block_header.shell_header = Block_header.shell_header and type Tezos_data.Block_header.t = Block_header.t - and type 'a RPC.Directory.t = 'a RPC_server.Directory.t + and type 'a RPC_directory.t = 'a RPC_directory.t and type Updater.validation_result = validation_result and type Updater.rpc_context = rpc_context @@ -153,7 +153,7 @@ module type RAW_PROTOCOL = sig validation_state -> operation -> validation_state tzresult Lwt.t val finalize_block: validation_state -> validation_result tzresult Lwt.t - val rpc_services: rpc_context RPC_server.Directory.t + val rpc_services: rpc_context RPC_directory.t val configure_sandbox: Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t end diff --git a/lib_node_updater/updater.mli b/lib_node_updater/updater.mli index be5536dc2..63c452cdc 100644 --- a/lib_node_updater/updater.mli +++ b/lib_node_updater/updater.mli @@ -67,7 +67,7 @@ module type RAW_PROTOCOL = sig validation_state -> operation -> validation_state tzresult Lwt.t val finalize_block: validation_state -> validation_result tzresult Lwt.t - val rpc_services: rpc_context RPC_server.Directory.t + val rpc_services: rpc_context RPC_directory.t val configure_sandbox: Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t end @@ -98,7 +98,7 @@ module Node_protocol_environment_sigs : sig and type Tezos_data.Operation.t = Operation.t and type Tezos_data.Block_header.shell_header = Block_header.shell_header and type Tezos_data.Block_header.t = Block_header.t - and type 'a RPC.Directory.t = 'a RPC_server.Directory.t + and type 'a RPC_directory.t = 'a RPC_directory.t and type Updater.validation_result = validation_result and type Updater.rpc_context = rpc_context diff --git a/lib_protocol_environment_sigs/jbuild b/lib_protocol_environment_sigs/jbuild index 2b4c0c8fd..2dda4d5cf 100644 --- a/lib_protocol_environment_sigs/jbuild +++ b/lib_protocol_environment_sigs/jbuild @@ -40,7 +40,12 @@ ;; Tezos specifics v1/tezos_data.mli v1/context.mli - v1/RPC.mli + v1/RPC_arg.mli + v1/RPC_path.mli + v1/RPC_query.mli + v1/RPC_service.mli + v1/RPC_answer.mli + v1/RPC_directory.mli v1/updater.mli )) diff --git a/lib_protocol_environment_sigs/v1/RPC.mli b/lib_protocol_environment_sigs/v1/RPC.mli deleted file mode 100644 index 3cdc8a2ca..000000000 --- a/lib_protocol_environment_sigs/v1/RPC.mli +++ /dev/null @@ -1,290 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2017. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -(** View over the RPC service, restricted to types. A protocol - implementation can define a set of remote procedures which are - registered when the protocol is activated via its [rpcs] - function. However, it cannot register new or update existing - procedures afterwards, neither can it see other procedures. *) - -(** HTTP methods. *) -type meth = [ - | `GET - | `POST - | `DELETE - | `PUT - | `PATCH -] - -(** Typed path argument. *) -module Arg : sig - - type 'a t - type 'a arg = 'a t - val make: - ?descr:string -> - name:string -> - destruct:(string -> ('a, string) result) -> - construct:('a -> string) -> - unit -> 'a arg - - type descr = { - name: string ; - descr: string option ; - } - val descr: 'a arg -> descr - - val int: int arg - val int32: int32 arg - val int64: int64 arg - val float: float arg - -end - -(** Parametrized path to services. *) -module Path : sig - - type ('prefix, 'params) t - type ('prefix, 'params) path = ('prefix, 'params) t - type 'prefix context = ('prefix, 'prefix) path - - val root: unit context - val open_root: 'a context - - val add_suffix: - ('prefix, 'params) path -> string -> ('prefix, 'params) path - val (/): - ('prefix, 'params) path -> string -> ('prefix, 'params) path - - val add_arg: - ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a) path - val (/:): - ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a) path - - val add_final_args: - ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a list) path - val (/:*): - ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a list) path - - val prefix: - ('prefix, 'a) path -> ('a, 'params) path -> ('prefix, 'params) path - - val map: - ('a -> 'b) -> ('b -> 'a) -> ('prefix, 'a) path -> ('prefix, 'b) path - -end - -module Query : sig - - type 'a t - type 'a query = 'a t - - val empty: unit query - - type ('a, 'b) field - val field: - ?descr: string -> - string -> 'a Arg.t -> 'a -> ('b -> 'a) -> ('b, 'a) field - - type ('a, 'b, 'c) open_query - val query: 'b -> ('a, 'b, 'b) open_query - val (|+): - ('a, 'b, 'c -> 'd) open_query -> - ('a, 'c) field -> ('a, 'b, 'd) open_query - val seal: ('a, 'b, 'a) open_query -> 'a t - - type untyped = (string * string) list - exception Invalid of string - val parse: 'a query -> untyped -> 'a - -end - -(** Services. *) -module Service : sig - - type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t - constraint 'meth = [< meth ] - type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service = - ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t - - val query: - ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> - 'query Query.t - - type _ input = - | No_input : unit input - | Input : 'input Data_encoding.t -> 'input input - - val input_encoding: - ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> - 'input input - - val output_encoding: - ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> - 'output Data_encoding.t - - val error_encoding: - ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> - 'error Data_encoding.t - - val prefix: - ('prefix, 'inner_prefix) Path.t -> - ('meth, 'inner_prefix, 'params, 'query, - 'input, 'output, 'error) service -> - ('meth, 'prefix, 'params, - 'query, 'input, 'output, 'error) service - - val map: - ('a -> 'b) -> - ('b -> 'a) -> - ('meth, 'pr, 'a, 'q, 'i, 'o, 'e) service -> - ('meth, 'pr, 'b, 'q, 'i, 'o, 'e) service - - val get_service: - ?description: string -> - query: 'query Query.t -> - output: 'output Data_encoding.t -> - error: 'error Data_encoding.t -> - ('prefix, 'params) Path.t -> - ([ `GET ], 'prefix, 'params, 'query, unit, 'output, 'error) service - - val post_service: - ?description: string -> - query:'query Query.t -> - input: 'input Data_encoding.t -> - output: 'output Data_encoding.t -> - error: 'error Data_encoding.t -> - ('prefix, 'params) Path.t -> - ([ `POST ], 'prefix, 'params, 'query, 'input, 'output, 'error) service - - val delete_service: - ?description: string -> - query:'query Query.t -> - output: 'output Data_encoding.t -> - error: 'error Data_encoding.t -> - ('prefix, 'params) Path.t -> - ([ `DELETE ], 'prefix, 'params, 'query, unit, 'output, 'error) service - - val patch_service: - ?description: string -> - query:'query Query.t -> - input: 'input Data_encoding.t -> - output: 'output Data_encoding.t -> - error: 'error Data_encoding.t -> - ('prefix, 'params) Path.t -> - ([ `PATCH ], 'prefix, 'params, 'query, 'input, 'output, 'error) service - - val put_service: - ?description: string -> - query:'query Query.t -> - input: 'input Data_encoding.t -> - output: 'output Data_encoding.t -> - error: 'error Data_encoding.t -> - ('prefix, 'params) Path.t -> - ([ `PUT ], 'prefix, 'params, 'query, 'input, 'output, 'error) service - -end - -module Answer : sig - - (** Return type for service handler *) - type ('o, 'e) t = - [ `Ok of 'o (* 200 *) - | `OkStream of 'o stream (* 200 *) - | `Created of string option (* 201 *) - | `No_content (* 204 *) - | `Unauthorized of 'e option (* 401 *) - | `Forbidden of 'e option (* 403 *) - | `Not_found of 'e option (* 404 *) - | `Conflict of 'e option (* 409 *) - | `Error of 'e option (* 500 *) - ] - - and 'a stream = { - next: unit -> 'a option Lwt.t ; - shutdown: unit -> unit ; - } - - val return: 'o -> ('o, 'e) t Lwt.t - val return_stream: 'o stream -> ('o, 'e) t Lwt.t - -end - -module Directory : sig - - (** Dispatch tree *) - type 'prefix t - type 'prefix directory = 'prefix t - - (** Empty list of dispatch trees *) - val empty: 'prefix directory - - val map: ('a -> 'b) -> 'b directory -> 'a directory - - val prefix: ('pr, 'p) Path.path -> 'p directory -> 'pr directory - val merge: 'a directory -> 'a directory -> 'a directory - - (** Possible error while registring services. *) - type step = - | Static of string - | Dynamic of Arg.descr - | DynamicTail of Arg.descr - - type conflict = - | CService of meth | CDir | CBuilder | CTail - | CTypes of Arg.descr * - Arg.descr - | CType of Arg.descr * string list - exception Conflict of step list * conflict - - (** Registring handler in service tree. *) - val register: - 'prefix directory -> - ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) Service.t -> - ('params -> 'query -> 'input -> [< ('output, 'error) Answer.t ] Lwt.t) -> - 'prefix directory - - (** Registring handler in service tree. Curryfied variant. *) - val register0: - unit directory -> - ('m, unit, unit, 'q, 'i, 'o, 'e) Service.t -> - ('q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) -> - unit directory - - val register1: - 'prefix directory -> - ('m, 'prefix, unit * 'a, 'q , 'i, 'o, 'e) Service.t -> - ('a -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) -> - 'prefix directory - - val register2: - 'prefix directory -> - ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o, 'e) Service.t -> - ('a -> 'b -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) -> - 'prefix directory - - val register3: - 'prefix directory -> - ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o, 'e) Service.t -> - ('a -> 'b -> 'c -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) -> - 'prefix directory - - val register4: - 'prefix directory -> - ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o, 'e) Service.t -> - ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) -> - 'prefix directory - - val register5: - 'prefix directory -> - ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o, 'e) Service.t -> - ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) -> - 'prefix directory - -end diff --git a/lib_protocol_environment_sigs/v1/RPC_answer.mli b/lib_protocol_environment_sigs/v1/RPC_answer.mli new file mode 100644 index 000000000..f796d2b68 --- /dev/null +++ b/lib_protocol_environment_sigs/v1/RPC_answer.mli @@ -0,0 +1,29 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** Return type for service handler *) +type ('o, 'e) t = + [ `Ok of 'o (* 200 *) + | `OkStream of 'o stream (* 200 *) + | `Created of string option (* 201 *) + | `No_content (* 204 *) + | `Unauthorized of 'e option (* 401 *) + | `Forbidden of 'e option (* 403 *) + | `Not_found of 'e option (* 404 *) + | `Conflict of 'e option (* 409 *) + | `Error of 'e option (* 500 *) + ] + +and 'a stream = { + next: unit -> 'a option Lwt.t ; + shutdown: unit -> unit ; +} + +val return: 'o -> ('o, 'e) t Lwt.t +val return_stream: 'o stream -> ('o, 'e) t Lwt.t diff --git a/lib_protocol_environment_sigs/v1/RPC_arg.mli b/lib_protocol_environment_sigs/v1/RPC_arg.mli new file mode 100644 index 000000000..a3316a7bb --- /dev/null +++ b/lib_protocol_environment_sigs/v1/RPC_arg.mli @@ -0,0 +1,28 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type 'a t +type 'a arg = 'a t +val make: + ?descr:string -> + name:string -> + destruct:(string -> ('a, string) result) -> + construct:('a -> string) -> + unit -> 'a arg + +type descr = { + name: string ; + descr: string option ; +} +val descr: 'a arg -> descr + +val int: int arg +val int32: int32 arg +val int64: int64 arg +val float: float arg diff --git a/lib_protocol_environment_sigs/v1/RPC_directory.mli b/lib_protocol_environment_sigs/v1/RPC_directory.mli new file mode 100644 index 000000000..0e654f633 --- /dev/null +++ b/lib_protocol_environment_sigs/v1/RPC_directory.mli @@ -0,0 +1,77 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** Dispatch tree *) +type 'prefix t +type 'prefix directory = 'prefix t + +(** Empty list of dispatch trees *) +val empty: 'prefix directory + +val map: ('a -> 'b) -> 'b directory -> 'a directory + +val prefix: ('pr, 'p) RPC_path.path -> 'p directory -> 'pr directory +val merge: 'a directory -> 'a directory -> 'a directory + +(** Possible error while registring services. *) +type step = + | Static of string + | Dynamic of RPC_arg.descr + | DynamicTail of RPC_arg.descr + +type conflict = + | CService of RPC_service.meth | CDir | CBuilder | CTail + | CTypes of RPC_arg.descr * + RPC_arg.descr + | CType of RPC_arg.descr * string list +exception Conflict of step list * conflict + +(** Registring handler in service tree. *) +val register: + 'prefix directory -> + ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) RPC_service.t -> + ('params -> 'query -> 'input -> [< ('output, 'error) RPC_answer.t ] Lwt.t) -> + 'prefix directory + +(** Registring handler in service tree. Curryfied variant. *) +val register0: + unit directory -> + ('m, unit, unit, 'q, 'i, 'o, 'e) RPC_service.t -> + ('q -> 'i -> [< ('o, 'e) RPC_answer.t ] Lwt.t) -> + unit directory + +val register1: + 'prefix directory -> + ('m, 'prefix, unit * 'a, 'q , 'i, 'o, 'e) RPC_service.t -> + ('a -> 'q -> 'i -> [< ('o, 'e) RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val register2: + 'prefix directory -> + ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o, 'e) RPC_service.t -> + ('a -> 'b -> 'q -> 'i -> [< ('o, 'e) RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val register3: + 'prefix directory -> + ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o, 'e) RPC_service.t -> + ('a -> 'b -> 'c -> 'q -> 'i -> [< ('o, 'e) RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val register4: + 'prefix directory -> + ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o, 'e) RPC_service.t -> + ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< ('o, 'e) RPC_answer.t ] Lwt.t) -> + 'prefix directory + +val register5: + 'prefix directory -> + ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o, 'e) RPC_service.t -> + ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> [< ('o, 'e) RPC_answer.t ] Lwt.t) -> + 'prefix directory diff --git a/lib_protocol_environment_sigs/v1/RPC_path.mli b/lib_protocol_environment_sigs/v1/RPC_path.mli new file mode 100644 index 000000000..2de510d3a --- /dev/null +++ b/lib_protocol_environment_sigs/v1/RPC_path.mli @@ -0,0 +1,36 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type ('prefix, 'params) t +type ('prefix, 'params) path = ('prefix, 'params) t +type 'prefix context = ('prefix, 'prefix) path + +val root: unit context +val open_root: 'a context + +val add_suffix: + ('prefix, 'params) path -> string -> ('prefix, 'params) path +val (/): + ('prefix, 'params) path -> string -> ('prefix, 'params) path + +val add_arg: + ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a) path +val (/:): + ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a) path + +val add_final_args: + ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path +val (/:*): + ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path + +val prefix: + ('prefix, 'a) path -> ('a, 'params) path -> ('prefix, 'params) path + +val map: + ('a -> 'b) -> ('b -> 'a) -> ('prefix, 'a) path -> ('prefix, 'b) path diff --git a/lib_protocol_environment_sigs/v1/RPC_query.mli b/lib_protocol_environment_sigs/v1/RPC_query.mli new file mode 100644 index 000000000..e5fe67bd2 --- /dev/null +++ b/lib_protocol_environment_sigs/v1/RPC_query.mli @@ -0,0 +1,38 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +type 'a t +type 'a query = 'a t + +val empty: unit query + +type ('a, 'b) field +val field: + ?descr: string -> + string -> 'a RPC_arg.t -> 'a -> ('b -> 'a) -> ('b, 'a) field +val opt_field: + ?descr: string -> + string -> 'a RPC_arg.t -> ('b -> 'a option) -> ('b, 'a option) field +val flag: + ?descr: string -> + string -> ('b -> bool) -> ('b, bool) field +val multi_field: + ?descr: string -> + string -> 'a RPC_arg.t -> ('b -> 'a list) -> ('b, 'a list) field + +type ('a, 'b, 'c) open_query +val query: 'b -> ('a, 'b, 'b) open_query +val (|+): + ('a, 'b, 'c -> 'd) open_query -> + ('a, 'c) field -> ('a, 'b, 'd) open_query +val seal: ('a, 'b, 'a) open_query -> 'a t + +type untyped = (string * string) list +exception Invalid of string +val parse: 'a query -> untyped -> 'a diff --git a/lib_protocol_environment_sigs/v1/RPC_service.mli b/lib_protocol_environment_sigs/v1/RPC_service.mli new file mode 100644 index 000000000..e93a9282f --- /dev/null +++ b/lib_protocol_environment_sigs/v1/RPC_service.mli @@ -0,0 +1,100 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** HTTP methods. *) +type meth = [ + | `GET + | `POST + | `DELETE + | `PUT + | `PATCH +] + +module MethMap : Map.S with type key = meth + +type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t + constraint 'meth = [< meth ] +type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service = + ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t + +val query: + ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> + 'query RPC_query.t + +type _ input = + | No_input : unit input + | Input : 'input Data_encoding.t -> 'input input + +val input_encoding: + ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> + 'input input + +val output_encoding: + ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> + 'output Data_encoding.t + +val error_encoding: + ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service -> + 'error Data_encoding.t + +val prefix: + ('prefix, 'inner_prefix) RPC_path.t -> + ('meth, 'inner_prefix, 'params, 'query, + 'input, 'output, 'error) service -> + ('meth, 'prefix, 'params, + 'query, 'input, 'output, 'error) service + +val map: + ('a -> 'b) -> + ('b -> 'a) -> + ('meth, 'pr, 'a, 'q, 'i, 'o, 'e) service -> + ('meth, 'pr, 'b, 'q, 'i, 'o, 'e) service + +val get_service: + ?description: string -> + query: 'query RPC_query.t -> + output: 'output Data_encoding.t -> + error: 'error Data_encoding.t -> + ('prefix, 'params) RPC_path.t -> + ([ `GET ], 'prefix, 'params, 'query, unit, 'output, 'error) service + +val post_service: + ?description: string -> + query:'query RPC_query.t -> + input: 'input Data_encoding.t -> + output: 'output Data_encoding.t -> + error: 'error Data_encoding.t -> + ('prefix, 'params) RPC_path.t -> + ([ `POST ], 'prefix, 'params, 'query, 'input, 'output, 'error) service + +val delete_service: + ?description: string -> + query:'query RPC_query.t -> + output: 'output Data_encoding.t -> + error: 'error Data_encoding.t -> + ('prefix, 'params) RPC_path.t -> + ([ `DELETE ], 'prefix, 'params, 'query, unit, 'output, 'error) service + +val patch_service: + ?description: string -> + query:'query RPC_query.t -> + input: 'input Data_encoding.t -> + output: 'output Data_encoding.t -> + error: 'error Data_encoding.t -> + ('prefix, 'params) RPC_path.t -> + ([ `PATCH ], 'prefix, 'params, 'query, 'input, 'output, 'error) service + +val put_service: + ?description: string -> + query:'query RPC_query.t -> + input: 'input Data_encoding.t -> + output: 'output Data_encoding.t -> + error: 'error Data_encoding.t -> + ('prefix, 'params) RPC_path.t -> + ([ `PUT ], 'prefix, 'params, 'query, 'input, 'output, 'error) service diff --git a/lib_protocol_environment_sigs/v1/updater.mli b/lib_protocol_environment_sigs/v1/updater.mli index d0c5c899d..6f20d8215 100644 --- a/lib_protocol_environment_sigs/v1/updater.mli +++ b/lib_protocol_environment_sigs/v1/updater.mli @@ -132,7 +132,7 @@ module type PROTOCOL = sig validation_state -> validation_result tzresult Lwt.t (** The list of remote procedures exported by this implementation *) - val rpc_services: rpc_context RPC.Directory.t + val rpc_services: rpc_context RPC_directory.t (** An ad-hoc context patcher. It used only for debugging protocol while running in the "sandbox" mode. This function is never used diff --git a/vendors/ocplib-resto/lib_resto/resto.mli b/vendors/ocplib-resto/lib_resto/resto.mli index b0d7e1dfa..9c0c116c3 100644 --- a/vendors/ocplib-resto/lib_resto/resto.mli +++ b/vendors/ocplib-resto/lib_resto/resto.mli @@ -14,7 +14,8 @@ val string_of_meth: [< meth ] -> string val meth_of_string: string -> [> meth ] option module MethMap : Map.S with type key = meth -module StringMap : Map.S with type key = string +module StringMap : Map.S with type 'a t = 'a Map.Make(String).t + and type key = string (** Typed path argument. *) module Arg : sig