balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

RPC: split modules RPC/RPC_server

Browse Source
This commit is contained in:
Grégoire Henry 2017-12-09 03:51:58 +01:00 committed by Benjamin Canou
parent 80b0e8d67a
commit 0871911920
63 changed files with 1213 additions and 1028 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
bin_client/main.ml
View File

@ -31,8 +31,9 @@ let main () =
port = parsed_config_file.node_port ; port = parsed_config_file.node_port ;
tls = parsed_config_file.tls ; tls = parsed_config_file.tls ;
} in } in
let ctxt = new Client_rpcs.rpc rpc_config in
begin 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 | Ok version -> begin
match parsed_args.protocol with match parsed_args.protocol with
| None -> | None ->

40
lib_client_base/client_generic_rpcs.ml
View File

@ -171,17 +171,17 @@ let editor_fill_in schema =
(*-- Nice list display ------------------------------------------------------*) (*-- Nice list display ------------------------------------------------------*)
let rec count = let rec count =
let open RPC.Description in let open RPC_description in
function function
| Empty -> 0 | Empty -> 0
| Dynamic _ -> 1 | Dynamic _ -> 1
| Static { services ; subdirs } -> | Static { services ; subdirs } ->
let service = RPC.MethMap.cardinal services in let service = RPC_service.MethMap.cardinal services in
let subdirs = let subdirs =
match subdirs with match subdirs with
| None -> 0 | None -> 0
| Some (Suffixes subdirs) -> | 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 | Some (Arg (_, subdir)) -> count subdir in
service + subdirs service + subdirs
@ -191,10 +191,10 @@ let list url (cctxt : Client_commands.full_context) =
let args = String.split '/' url in let args = String.split '/' url in
Client_node_rpcs.describe cctxt Client_node_rpcs.describe cctxt
~recurse:true args >>=? fun tree -> ~recurse:true args >>=? fun tree ->
let open RPC.Description in let open RPC_description in
let collected_args = ref [] in let collected_args = ref [] in
let collect arg = 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 collected_args := arg :: !collected_args in
let display_paragraph ppf description = let display_paragraph ppf description =
Format.fprintf ppf "@, @[%a@]" Format.fprintf ppf "@, @[%a@]"
@ -202,14 +202,14 @@ let list url (cctxt : Client_commands.full_context) =
(String.split ' ' description) (String.split ' ' description)
in in
let display_arg ppf arg = let display_arg ppf arg =
match arg.RPC.Arg.descr with match arg.RPC_arg.descr with
| None -> Format.fprintf ppf "%s" arg.RPC.Arg.name | None -> Format.fprintf ppf "%s" arg.RPC_arg.name
| Some descr -> | 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 in
let display_service ppf (_path, tpath, service) = let display_service ppf (_path, tpath, service) =
Format.fprintf ppf "- %s /%s" Format.fprintf ppf "- %s /%s"
(RPC.string_of_meth service.meth) (RPC_service.string_of_meth service.meth)
(String.concat "/" tpath) ; (String.concat "/" tpath) ;
match service.description with match service.description with
| None | Some "" -> () | None | Some "" -> ()
@ -219,7 +219,7 @@ let list url (cctxt : Client_commands.full_context) =
Format.pp_print_list Format.pp_print_list
(fun ppf (_,s) -> display_service ppf (_path, tpath, s)) (fun ppf (_,s) -> display_service ppf (_path, tpath, s))
ppf ppf
(RPC.MethMap.bindings services) (RPC_service.MethMap.bindings services)
in in
let rec display ppf (path, tpath, tree) = let rec display ppf (path, tpath, tree) =
match tree with match tree with
@ -233,7 +233,7 @@ let list url (cctxt : Client_commands.full_context) =
| Static { services ; subdirs = None } -> | Static { services ; subdirs = None } ->
display_services ppf (path, tpath, services) display_services ppf (path, tpath, services)
| Static { services ; subdirs = Some (Suffixes subdirs) } -> begin | 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, [] -> ()
| 0, [ n, solo ] -> | 0, [ n, solo ] ->
display ppf (path @ [ n ], tpath @ [ n ], solo) display ppf (path @ [ n ], tpath @ [ n ], solo)
@ -262,16 +262,16 @@ let list url (cctxt : Client_commands.full_context) =
items items
end end
| Static { services ; subdirs = Some (Arg (arg, solo)) } | Static { services ; subdirs = Some (Arg (arg, solo)) }
when RPC.MethMap.cardinal services = 0 -> when RPC_service.MethMap.cardinal services = 0 ->
collect arg ; 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) display ppf (path @ [ name ], tpath @ [ name ], solo)
| Static { services; | Static { services;
subdirs = Some (Arg (arg, solo)) } -> subdirs = Some (Arg (arg, solo)) } ->
collect arg ; collect arg ;
display_services ppf (path, tpath, services) ; display_services ppf (path, tpath, services) ;
Format.fprintf ppf "@," ; 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) display ppf (path @ [ name ], tpath @ [ name ], solo)
and display_list tpath = and display_list tpath =
Format.pp_print_list 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 schema url (cctxt : Client_commands.full_context) =
let args = String.split '/' url in 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 Client_node_rpcs.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin | Static { services } -> begin
match RPC.MethMap.find `POST services with match RPC_service.MethMap.find `POST services with
| exception Not_found -> | exception Not_found ->
cctxt#message cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> "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 format url (cctxt : #Client_commands.logging_rpcs) =
let args = String.split '/' url in 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 Client_node_rpcs.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin | Static { services } -> begin
match RPC.MethMap.find `POST services with match RPC_service.MethMap.find `POST services with
| exception Not_found -> | exception Not_found ->
cctxt#message cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> "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 call url (cctxt : Client_commands.full_context) =
let args = String.split '/' url in 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 Client_node_rpcs.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin | Static { services } -> begin
match RPC.MethMap.find `POST services with match RPC_service.MethMap.find `POST services with
| exception Not_found -> | exception Not_found ->
cctxt#message cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->

8
lib_client_base/client_node_rpcs.ml
View File

@ -43,12 +43,12 @@ let complete cctxt ?block prefix =
call_service2 cctxt Services.Blocks.complete block prefix () call_service2 cctxt Services.Blocks.complete block prefix ()
let describe config ?(recurse = true) path = let describe config ?(recurse = true) path =
let { RPC.Service.meth ; uri } = let { RPC_service.meth ; uri } =
RPC.Service.forge_request Node_rpc_services.describe RPC_service.forge_request Node_rpc_services.describe
((), path) { RPC.Description.recurse } in ((), path) { RPC_description.recurse } in
let path = String.split_path (Uri.path uri) in (* Temporary *) let path = String.split_path (Uri.path uri) in (* Temporary *)
config#get_json meth path (`O []) >>=? fun json -> 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 -> | exception msg ->
let msg = let msg =
Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in

2
lib_client_base/client_node_rpcs.mli
View File

@ -177,4 +177,4 @@ val complete:
val describe: val describe:
#Client_rpcs.ctxt -> #Client_rpcs.ctxt ->
?recurse:bool -> string list -> ?recurse:bool -> string list ->
Data_encoding.json_schema RPC.Description.directory tzresult Lwt.t Data_encoding.json_schema RPC_description.directory tzresult Lwt.t

34
lib_client_base/client_rpcs.ml
View File

@ -188,27 +188,27 @@ let fail config err = fail (RPC_error (config, err))
class type ctxt = object class type ctxt = object
method get_json : method get_json :
RPC.meth -> RPC_service.meth ->
string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t
method get_streamed_json : method get_streamed_json :
RPC.meth -> RPC_service.meth ->
string list -> string list ->
Data_encoding.json -> Data_encoding.json ->
Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t
method make_request : method make_request :
(Uri.t -> Data_encoding.json -> 'a Lwt.t) -> (Uri.t -> Data_encoding.json -> 'a Lwt.t) ->
RPC.meth -> RPC_service.meth ->
string list -> string list ->
Data_encoding.json -> Data_encoding.json ->
('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t ('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t
method parse_answer : method parse_answer :
'meth 'params 'input 'output. '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 -> string list ->
Data_encoding.json -> 'output tzresult Lwt.t Data_encoding.json -> 'output tzresult Lwt.t
method parse_err_answer : method parse_err_answer :
'meth 'params 'input 'output. '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 -> string list ->
Data_encoding.json -> 'output tzresult Lwt.t Data_encoding.json -> 'output tzresult Lwt.t
end end
@ -217,7 +217,7 @@ class rpc config : ctxt = object (self)
val config = config val config = config
method make_request : method make_request :
type a. (Uri.t -> Data_encoding.json -> a Lwt.t) -> type a. (Uri.t -> Data_encoding.json -> a Lwt.t) ->
RPC.meth -> RPC_service.meth ->
string list -> string list ->
Data_encoding.json -> Data_encoding.json ->
(a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t = (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 method parse_answer
: 'm 'p 'i 'o. : '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 -> string list ->
Data_encoding.json -> 'o tzresult Lwt.t = Data_encoding.json -> 'o tzresult Lwt.t =
fun service path json -> 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 -> | exception msg ->
let msg = let msg =
Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in 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 | 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 = string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t =
fun meth service json -> fun meth service json ->
let Logger logger = config.logger in let Logger logger = config.logger in
@ -314,11 +314,11 @@ class rpc config : ctxt = object (self)
method parse_err_answer method parse_err_answer
: 'm 'p 'i 'o. : '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 -> string list ->
Data_encoding.json -> 'o tzresult Lwt.t = Data_encoding.json -> 'o tzresult Lwt.t =
fun service path json -> 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 *) | exception msg -> (* TODO print_error *)
let msg = let msg =
Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in 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) fail config (Connection_failed msg)
end end
let forge_request (type i) (service: (_,_,_,_,i,_,_) RPC.Service.t) params body = let forge_request (type i) (service: (_,_,_,_,i,_,_) RPC_service.t) params body =
let { RPC.Service.meth ; uri } = let { RPC_service.meth ; uri } =
RPC.Service.forge_request service params () in RPC_service.forge_request service params () in
let json = let json =
match RPC.Service.input_encoding service with match RPC_service.input_encoding service with
| RPC.Service.No_input -> assert false (* TODO *) | RPC_service.No_input -> assert false (* TODO *)
| RPC.Service.Input input -> Data_encoding.Json.construct input body in | RPC_service.Input input -> Data_encoding.Json.construct input body in
let path = String.split_path (Uri.path uri) in (* Temporary *) let path = String.split_path (Uri.path uri) in (* Temporary *)
meth, path, json meth, path, json

26
lib_client_base/client_rpcs.mli
View File

@ -25,28 +25,28 @@ and logger =
class type ctxt = object class type ctxt = object
method get_json : method get_json :
RPC.meth -> RPC_service.meth ->
string list -> Data_encoding.json -> string list -> Data_encoding.json ->
Data_encoding.json tzresult Lwt.t Data_encoding.json tzresult Lwt.t
method get_streamed_json : method get_streamed_json :
RPC.meth -> RPC_service.meth ->
string list -> string list ->
Data_encoding.json -> Data_encoding.json ->
Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t
method make_request : method make_request :
(Uri.t -> Data_encoding.json -> 'a Lwt.t) -> (Uri.t -> Data_encoding.json -> 'a Lwt.t) ->
RPC.meth -> RPC_service.meth ->
string list -> string list ->
Data_encoding.json -> Data_encoding.json ->
('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t ('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t
method parse_answer : method parse_answer :
'meth 'params 'input 'output. '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 -> string list ->
Data_encoding.json -> 'output tzresult Lwt.t Data_encoding.json -> 'output tzresult Lwt.t
method parse_err_answer : method parse_err_answer :
'meth 'params 'input 'output. '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 -> string list ->
Data_encoding.json -> 'output tzresult Lwt.t Data_encoding.json -> 'output tzresult Lwt.t
end end
@ -62,56 +62,56 @@ val call_service0:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
unit, unit, 'i, unit, unit, 'i,
'o, unit) RPC.Service.t -> 'o, unit) RPC_service.t ->
'i -> 'o tzresult Lwt.t 'i -> 'o tzresult Lwt.t
val call_service1: val call_service1:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
unit * 'a, unit, 'i, unit * 'a, unit, 'i,
'o, unit) RPC.Service.t -> 'o, unit) RPC_service.t ->
'a -> 'i -> 'o tzresult Lwt.t 'a -> 'i -> 'o tzresult Lwt.t
val call_service2: val call_service2:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
(unit * 'a) * 'b, unit, 'i, (unit * 'a) * 'b, unit, 'i,
'o, unit) RPC.Service.t -> 'o, unit) RPC_service.t ->
'a -> 'b -> 'i -> 'o tzresult Lwt.t 'a -> 'b -> 'i -> 'o tzresult Lwt.t
val call_streamed_service0: val call_streamed_service0:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
unit, unit, 'a, unit, unit, 'a,
'b, unit) RPC.Service.t -> 'b, unit) RPC_service.t ->
'a -> 'b tzresult Lwt_stream.t tzresult Lwt.t 'a -> 'b tzresult Lwt_stream.t tzresult Lwt.t
val call_streamed_service1: val call_streamed_service1:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
unit * 'a, unit, 'b, unit * 'a, unit, 'b,
'c, unit) RPC.Service.t -> 'c, unit) RPC_service.t ->
'a -> 'b -> 'c tzresult Lwt_stream.t tzresult Lwt.t 'a -> 'b -> 'c tzresult Lwt_stream.t tzresult Lwt.t
val call_err_service0: val call_err_service0:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
unit, unit, 'i, unit, unit, 'i,
'o tzresult, unit) RPC.Service.t -> 'o tzresult, unit) RPC_service.t ->
'i -> 'o tzresult Lwt.t 'i -> 'o tzresult Lwt.t
val call_err_service1: val call_err_service1:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
unit * 'a, unit, 'i, unit * 'a, unit, 'i,
'o tzresult, unit) RPC.Service.t -> 'o tzresult, unit) RPC_service.t ->
'a -> 'i -> 'o tzresult Lwt.t 'a -> 'i -> 'o tzresult Lwt.t
val call_err_service2: val call_err_service2:
#ctxt -> #ctxt ->
([ `POST ], unit, ([ `POST ], unit,
(unit * 'a) * 'b, unit, 'i, (unit * 'a) * 'b, unit, 'i,
'o tzresult, unit) RPC.Service.t -> 'o tzresult, unit) RPC_service.t ->
'a -> 'b -> 'i -> 'o tzresult Lwt.t 'a -> 'b -> 'i -> 'o tzresult Lwt.t
type block = Node_rpc_services.Blocks.block type block = Node_rpc_services.Blocks.block

2
lib_client_base/jbuild
View File

@ -7,6 +7,7 @@
tezos-storage tezos-storage
tezos-node-p2p-base tezos-node-p2p-base
tezos-node-services tezos-node-services
tezos-node-http
tezos-node-updater tezos-node-updater
tezos-protocol-compiler)) tezos-protocol-compiler))
(flags (:standard -w -9+27-30-32-40@8 (flags (:standard -w -9+27-30-32-40@8
@ -15,6 +16,7 @@
-open Tezos_storage -open Tezos_storage
-open Tezos_node_p2p_base -open Tezos_node_p2p_base
-open Tezos_node_services -open Tezos_node_services
-open Tezos_node_http
-open Tezos_node_updater)))) -open Tezos_node_updater))))
(alias (alias

6
lib_client_base/tezos-client-base.opam
View File

@ -10,6 +10,12 @@ depends: [
"ocamlfind" { build } "ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta15" } "jbuilder" { build & >= "1.0+beta15" }
"tezos-base" "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-genesis"
"tezos-embedded-protocol-demo" "tezos-embedded-protocol-demo"
"tezos-embedded-protocol-alpha" "tezos-embedded-protocol-alpha"

2
lib_embedded_protocol_alpha/src/contract_repr.ml
View File

@ -125,7 +125,7 @@ let arg =
match of_b58check hash with match of_b58check hash with
| Error _ -> Error "Cannot parse contract id" | Error _ -> Error "Cannot parse contract id"
| Ok contract -> Ok contract in | Ok contract -> Ok contract in
RPC.Arg.make RPC_arg.make
~descr: "A contract identifier encoded in b58check." ~descr: "A contract identifier encoded in b58check."
~name: "contract_id" ~name: "contract_id"
~construct ~construct

2
lib_embedded_protocol_alpha/src/contract_repr.mli
View File

@ -58,7 +58,7 @@ val encoding : contract Data_encoding.t
val origination_nonce_encoding : origination_nonce 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 module Index : sig
type t = contract type t = contract

2
lib_embedded_protocol_alpha/src/cycle_repr.ml
View File

@ -17,7 +17,7 @@ let arg =
match Int32.of_string str with match Int32.of_string str with
| exception _ -> Error "Cannot parse cycle" | exception _ -> Error "Cannot parse cycle"
| cycle -> Ok cycle in | cycle -> Ok cycle in
RPC.Arg.make RPC_arg.make
~descr:"A cycle integer" ~descr:"A cycle integer"
~name: "block_cycle" ~name: "block_cycle"
~construct ~construct

2
lib_embedded_protocol_alpha/src/cycle_repr.mli
View File

@ -11,7 +11,7 @@ type t
type cycle = t type cycle = t
include Compare.S with type t := t include Compare.S with type t := t
val encoding: cycle Data_encoding.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 pp: Format.formatter -> cycle -> unit
val root: cycle val root: cycle

2
lib_embedded_protocol_alpha/src/raw_level_repr.ml
View File

@ -18,7 +18,7 @@ let arg =
match Int32.of_string str with match Int32.of_string str with
| exception _ -> Error "Cannot parse level" | exception _ -> Error "Cannot parse level"
| raw_level -> Ok raw_level in | raw_level -> Ok raw_level in
RPC.Arg.make RPC_arg.make
~descr:"A level integer" ~descr:"A level integer"
~name: "block_level" ~name: "block_level"
~construct ~construct

2
lib_embedded_protocol_alpha/src/raw_level_repr.mli
View File

@ -10,7 +10,7 @@
type t type t
type raw_level = t type raw_level = t
val encoding: raw_level Data_encoding.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 val pp: Format.formatter -> raw_level -> unit
include Compare.S with type t := raw_level include Compare.S with type t := raw_level

332
lib_embedded_protocol_alpha/src/services.ml
View File

@ -36,188 +36,188 @@ let wrap_tzerror encoding =
let operations custom_root = let operations custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "All the operations of the block (fully decoded)." ~description: "All the operations of the block (fully decoded)."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
(list (list (dynamic_size Operation.encoding)))) (list (list (dynamic_size Operation.encoding))))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "operations") RPC_path.(custom_root / "operations")
let header custom_root = let header custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "The header of the block (fully decoded)." ~description: "The header of the block (fully decoded)."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Block_header.encoding) ~output: (wrap_tzerror Block_header.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "header") RPC_path.(custom_root / "header")
module Header = struct module Header = struct
let priority custom_root = let priority custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Baking priority of the block." ~description: "Baking priority of the block."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror uint16) ~output: (wrap_tzerror uint16)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "header" / "priority") RPC_path.(custom_root / "header" / "priority")
let seed_nonce_hash custom_root = let seed_nonce_hash custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Hash of the seed nonce of the block." ~description: "Hash of the seed nonce of the block."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Nonce_hash.encoding) ~output: (wrap_tzerror Nonce_hash.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "header" / "seed_nonce_hash") RPC_path.(custom_root / "header" / "seed_nonce_hash")
end end
module Constants = struct module Constants = struct
let cycle_length custom_root = let cycle_length custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Cycle length" ~description: "Cycle length"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "cycle length" int32) describe ~title: "cycle length" int32)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "constants" / "cycle_length") RPC_path.(custom_root / "constants" / "cycle_length")
let voting_period_length custom_root = let voting_period_length custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Length of the voting period" ~description: "Length of the voting period"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "voting period length" int32) describe ~title: "voting period length" int32)
~error: Data_encoding.empty ~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 = let time_before_reward custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Time before reward" ~description: "Time before reward"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "time before reward" Period.encoding) describe ~title: "time before reward" Period.encoding)
~error: Data_encoding.empty ~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 = let slot_durations custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Slot durations" ~description: "Slot durations"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "time between slots" (list Period.encoding)) describe ~title: "time between slots" (list Period.encoding))
~error: Data_encoding.empty ~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 = let first_free_baking_slot custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "First free baking slot" ~description: "First free baking slot"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "first free baking slot" uint16) describe ~title: "first free baking slot" uint16)
~error: Data_encoding.empty ~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 = let max_signing_slot custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Max signing slot" ~description: "Max signing slot"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "max signing slot" uint16) describe ~title: "max signing slot" uint16)
~error: Data_encoding.empty ~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 = let instructions_per_transaction custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Instructions per transaction" ~description: "Instructions per transaction"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "instructions per transaction" int31) describe ~title: "instructions per transaction" int31)
~error: Data_encoding.empty ~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 = let proof_of_work_threshold custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Stamp threshold" ~description: "Stamp threshold"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "proof_of_work threshold" int64) describe ~title: "proof_of_work threshold" int64)
~error: Data_encoding.empty ~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 = let errors custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Schema for all the RPC errors from this protocol version" ~description: "Schema for all the RPC errors from this protocol version"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: json_schema ~output: json_schema
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "constants" / "errors") RPC_path.(custom_root / "constants" / "errors")
end end
module Context = struct module Context = struct
let level custom_root = let level custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Detailled level information for the current block" ~description: "Detailled level information for the current block"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "detailled level info" Level.encoding) describe ~title: "detailled level info" Level.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "level") RPC_path.(custom_root / "context" / "level")
let next_level custom_root = let next_level custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Detailled level information for the next block" ~description: "Detailled level information for the next block"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "detailled level info" Level.encoding) describe ~title: "detailled level info" Level.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "next_level") RPC_path.(custom_root / "context" / "next_level")
let roll_value custom_root = let roll_value custom_root =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Tez.encoding) ~output: (wrap_tzerror Tez.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "roll_value") RPC_path.(custom_root / "context" / "roll_value")
let next_roll custom_root = let next_roll custom_root =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror int32) ~output: (wrap_tzerror int32)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "next_roll") RPC_path.(custom_root / "context" / "next_roll")
let voting_period_kind custom_root = let voting_period_kind custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Voting period kind for the current block" ~description: "Voting period kind for the current block"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: ~output:
(wrap_tzerror @@ (wrap_tzerror @@
(obj1 (obj1
(req "voting_period_kind" Voting_period.kind_encoding))) (req "voting_period_kind" Voting_period.kind_encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "voting_period_kind") RPC_path.(custom_root / "context" / "voting_period_kind")
module Nonce = struct module Nonce = struct
@ -244,23 +244,23 @@ module Context = struct
] ]
let get custom_root = let get custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Info about the nonce of a previous block." ~description: "Info about the nonce of a previous block."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror nonce_encoding) ~output: (wrap_tzerror nonce_encoding)
~error: Data_encoding.empty ~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 = let hash custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Hash of the current block's nonce." ~description: "Hash of the current block's nonce."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "nonce hash" Nonce_hash.encoding) describe ~title: "nonce hash" Nonce_hash.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "nonce") RPC_path.(custom_root / "context" / "nonce")
end end
@ -272,7 +272,7 @@ module Context = struct
match Ed25519.Public_key_hash.of_b58check_opt hash with match Ed25519.Public_key_hash.of_b58check_opt hash with
| None -> Error "Cannot parse public key hash" | None -> Error "Cannot parse public key hash"
| Some public_key_hash -> Ok public_key_hash in | Some public_key_hash -> Ok public_key_hash in
RPC.Arg.make RPC_arg.make
~descr:"A public key hash" ~descr:"A public key hash"
~name: "public_key_hash" ~name: "public_key_hash"
~construct ~construct
@ -285,22 +285,22 @@ module Context = struct
(req "public_key" Ed25519.Public_key.encoding)) (req "public_key" Ed25519.Public_key.encoding))
let list custom_root = let list custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "List the known public keys" ~description: "List the known public keys"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ list pk_encoding) ~output: (wrap_tzerror @@ list pk_encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "keys") RPC_path.(custom_root / "context" / "keys")
let get custom_root = let get custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Fetch the stored public key" ~description: "Fetch the stored public key"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ pk_encoding) ~output: (wrap_tzerror @@ pk_encoding)
~error: Data_encoding.empty ~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 end
@ -309,76 +309,76 @@ module Context = struct
module Contract = struct module Contract = struct
let balance custom_root = let balance custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Access the balance of a contract." ~description: "Access the balance of a contract."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Tez.encoding) ~output: (wrap_tzerror Tez.encoding)
~error: Data_encoding.empty ~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 = let manager custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Access the manager of a contract." ~description: "Access the manager of a contract."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror Ed25519.Public_key_hash.encoding) ~output: (wrap_tzerror Ed25519.Public_key_hash.encoding)
~error: Data_encoding.empty ~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 = let delegate custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Access the delegate of a contract, if any." ~description: "Access the delegate of a contract, if any."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror (option Ed25519.Public_key_hash.encoding)) ~output: (wrap_tzerror (option Ed25519.Public_key_hash.encoding))
~error: Data_encoding.empty ~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 = let counter custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Access the counter of a contract, if any." ~description: "Access the counter of a contract, if any."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror int32) ~output: (wrap_tzerror int32)
~error: Data_encoding.empty ~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 = let spendable custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Tells if the contract tokens can be spent by the manager." ~description: "Tells if the contract tokens can be spent by the manager."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror bool) ~output: (wrap_tzerror bool)
~error: Data_encoding.empty ~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 = let delegatable custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Tells if the contract delegate can be changed." ~description: "Tells if the contract delegate can be changed."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror bool) ~output: (wrap_tzerror bool)
~error: Data_encoding.empty ~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 = let script custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Access the code and data of the contract." ~description: "Access the code and data of the contract."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror (option Script.encoding)) ~output: (wrap_tzerror (option Script.encoding))
~error: Data_encoding.empty ~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 = let storage custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Access the data of the contract." ~description: "Access the data of the contract."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror (option Script.expr_encoding)) ~output: (wrap_tzerror (option Script.expr_encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg / "storage") RPC_path.(custom_root / "context" / "contracts" /: Contract.arg / "storage")
type info = { type info = {
manager: public_key_hash ; manager: public_key_hash ;
@ -390,9 +390,9 @@ module Context = struct
} }
let get custom_root = let get custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Access the complete status of a contract." ~description: "Access the complete status of a contract."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: ~output:
(wrap_tzerror @@ (wrap_tzerror @@
@ -411,17 +411,17 @@ module Context = struct
(opt "script" Script.encoding) (opt "script" Script.encoding)
(req "counter" int32)) (req "counter" int32))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "contracts" /: Contract.arg) RPC_path.(custom_root / "context" / "contracts" /: Contract.arg)
let list custom_root = let list custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"All existing contracts (including non-empty default contracts)." "All existing contracts (including non-empty default contracts)."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ list Contract.encoding) ~output: (wrap_tzerror @@ list Contract.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "context" / "contracts") RPC_path.(custom_root / "context" / "contracts")
end end
@ -432,14 +432,14 @@ end
module Helpers = struct module Helpers = struct
let minimal_timestamp custom_root = let minimal_timestamp custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Minimal timestamp for the next block." ~description: "Minimal timestamp for the next block."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (opt "priority" int31)) ~input: (obj1 (opt "priority" int31))
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj1 (req "timestamp" Timestamp.encoding)) obj1 (req "timestamp" Timestamp.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "minimal_timestamp") RPC_path.(custom_root / "helpers" / "minimal_timestamp")
let run_code_input_encoding = let run_code_input_encoding =
(obj6 (obj6
@ -451,21 +451,21 @@ module Helpers = struct
(opt "origination_nonce" Contract.origination_nonce_encoding)) (opt "origination_nonce" Contract.origination_nonce_encoding))
let run_code custom_root = let run_code custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Run a piece of code in the current context" ~description: "Run a piece of code in the current context"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: run_code_input_encoding ~input: run_code_input_encoding
~output: (wrap_tzerror ~output: (wrap_tzerror
(obj2 (obj2
(req "storage" Script.expr_encoding) (req "storage" Script.expr_encoding)
(req "output" Script.expr_encoding))) (req "output" Script.expr_encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "run_code") RPC_path.(custom_root / "helpers" / "run_code")
let apply_operation custom_root = let apply_operation custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Applies an operation in the current context" ~description: "Applies an operation in the current context"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj4 ~input: (obj4
(req "pred_block" Block_hash.encoding) (req "pred_block" Block_hash.encoding)
(req "operation_hash" Operation_hash.encoding) (req "operation_hash" Operation_hash.encoding)
@ -474,14 +474,14 @@ module Helpers = struct
~output: (wrap_tzerror ~output: (wrap_tzerror
(obj1 (req "contracts" (list Contract.encoding)))) (obj1 (req "contracts" (list Contract.encoding))))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "apply_operation") RPC_path.(custom_root / "helpers" / "apply_operation")
let trace_code custom_root = let trace_code custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Run a piece of code in the current context, \ ~description: "Run a piece of code in the current context, \
keeping a trace" keeping a trace"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: run_code_input_encoding ~input: run_code_input_encoding
~output: (wrap_tzerror ~output: (wrap_tzerror
(obj3 (obj3
@ -493,55 +493,55 @@ module Helpers = struct
(req "gas" int31) (req "gas" int31)
(req "stack" (list (Script.expr_encoding))))))) (req "stack" (list (Script.expr_encoding)))))))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "trace_code") RPC_path.(custom_root / "helpers" / "trace_code")
let typecheck_code custom_root = let typecheck_code custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Typecheck a piece of code in the current context" ~description: "Typecheck a piece of code in the current context"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: Script.expr_encoding ~input: Script.expr_encoding
~output: (wrap_tzerror Script_ir_translator.type_map_enc) ~output: (wrap_tzerror Script_ir_translator.type_map_enc)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "typecheck_code") RPC_path.(custom_root / "helpers" / "typecheck_code")
let typecheck_data custom_root = let typecheck_data custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Check that some data expression is well formed \ ~description: "Check that some data expression is well formed \
and of a given type in the current context" and of a given type in the current context"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj2 ~input: (obj2
(req "data" Script.expr_encoding) (req "data" Script.expr_encoding)
(req "type" Script.expr_encoding)) (req "type" Script.expr_encoding))
~output: (wrap_tzerror empty) ~output: (wrap_tzerror empty)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "typecheck_data") RPC_path.(custom_root / "helpers" / "typecheck_data")
let hash_data custom_root = let hash_data custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Computes the hash of some data expression \ ~description: "Computes the hash of some data expression \
using the same algorithm as script instruction H" using the same algorithm as script instruction H"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (req "data" Script.expr_encoding)) ~input: (obj1 (req "data" Script.expr_encoding))
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj1 (req "hash" string)) obj1 (req "hash" string))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "hash_data") RPC_path.(custom_root / "helpers" / "hash_data")
let level custom_root = let level custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "..." ~description: "..."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 ~input: (obj1
(opt "offset" int32)) (opt "offset" int32))
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "block level and cycle information" Level.encoding) describe ~title: "block level and cycle information" Level.encoding)
~error: Data_encoding.empty ~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 = let levels custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Levels of a cycle" ~description: "Levels of a cycle"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
describe ~title: "levels of a cycle" describe ~title: "levels of a cycle"
@ -549,7 +549,7 @@ module Helpers = struct
(req "first" Raw_level.encoding) (req "first" Raw_level.encoding)
(req "last" Raw_level.encoding))) (req "last" Raw_level.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "levels" /: Cycle.arg) RPC_path.(custom_root / "helpers" / "levels" /: Cycle.arg)
module Rights = struct module Rights = struct
@ -571,11 +571,11 @@ module Helpers = struct
(req "timestamp" Timestamp.encoding)) (req "timestamp" Timestamp.encoding))
let baking_rights custom_root = let baking_rights custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List gelegates allowed to bake for the next level, \ "List gelegates allowed to bake for the next level, \
ordered by priority." ordered by priority."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj2 obj2
@ -586,14 +586,14 @@ module Helpers = struct
(req "delegate" Ed25519.Public_key_hash.encoding) (req "delegate" Ed25519.Public_key_hash.encoding)
(req "timestamp" Timestamp.encoding))))) (req "timestamp" Timestamp.encoding)))))
~error: Data_encoding.empty ~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 = let baking_rights_for_level custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List delegate allowed to bake for a given level, \ "List delegate allowed to bake for a given level, \
ordered by priority." ordered by priority."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj2 obj2
@ -601,49 +601,49 @@ module Helpers = struct
(req "delegates" (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "baking" / "level" /: Raw_level.arg ) / "baking" / "level" /: Raw_level.arg )
let baking_levels custom_root = let baking_levels custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List level for which we might computed baking rights." "List level for which we might computed baking rights."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj1 (req "levels" (list Raw_level.encoding))) obj1 (req "levels" (list Raw_level.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "baking" / "level" ) / "baking" / "level" )
let baking_rights_for_delegate custom_root = let baking_rights_for_delegate custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Future baking rights for a given delegate." ~description: "Future baking rights for a given delegate."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: slots_range_encoding ~input: slots_range_encoding
~output: (wrap_tzerror (Data_encoding.list baking_slot_encoding)) ~output: (wrap_tzerror (Data_encoding.list baking_slot_encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "baking" / "delegate" /: Context.Key.public_key_hash_arg ) / "baking" / "delegate" /: Context.Key.public_key_hash_arg )
let baking_delegates custom_root = let baking_delegates custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List delegates with baking rights." "List delegates with baking rights."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj1 (req "delegates" obj1 (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "baking" / "delegate" ) / "baking" / "delegate" )
let endorsement_rights custom_root = let endorsement_rights custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List delegates allowed to endorse for the current block." "List delegates allowed to endorse for the current block."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj2 obj2
@ -651,13 +651,13 @@ module Helpers = struct
(req "delegates" (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
~error: Data_encoding.empty ~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 = let endorsement_rights_for_level custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List delegates allowed to endorse blocks for a given level." "List delegates allowed to endorse blocks for a given level."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (opt "max_priority" int31)) ~input: (obj1 (opt "max_priority" int31))
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj2 obj2
@ -665,42 +665,42 @@ module Helpers = struct
(req "delegates" (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "endorsement" / "level" /: Raw_level.arg ) / "endorsement" / "level" /: Raw_level.arg )
let endorsement_levels custom_root = let endorsement_levels custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List level for which we might computed endorsement rights." "List level for which we might computed endorsement rights."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj1 (req "levels" (list Raw_level.encoding))) obj1 (req "levels" (list Raw_level.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "endorsement" / "level" ) / "endorsement" / "level" )
let endorsement_rights_for_delegate custom_root = let endorsement_rights_for_delegate custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Compute endorsement rights for a given delegate." ~description: "Compute endorsement rights for a given delegate."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: slots_range_encoding ~input: slots_range_encoding
~output: (wrap_tzerror @@ Data_encoding.list endorsement_slot_encoding) ~output: (wrap_tzerror @@ Data_encoding.list endorsement_slot_encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "endorsement" / "delegate" /: Context.Key.public_key_hash_arg ) / "endorsement" / "delegate" /: Context.Key.public_key_hash_arg )
let endorsement_delegates custom_root = let endorsement_delegates custom_root =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List delegates with endorsement rights." "List delegates with endorsement rights."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (wrap_tzerror @@ ~output: (wrap_tzerror @@
obj1 (req "delegates" obj1 (req "delegates"
(list Ed25519.Public_key_hash.encoding))) (list Ed25519.Public_key_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "rights" RPC_path.(custom_root / "helpers" / "rights"
/ "endorsement" / "delegate" ) / "endorsement" / "delegate" )
end end
@ -708,9 +708,9 @@ module Helpers = struct
module Forge = struct module Forge = struct
let operations custom_root = let operations custom_root =
RPC.Service.post_service RPC_service.post_service
~description:"Forge an operation" ~description:"Forge an operation"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: Operation.unsigned_operation_encoding ~input: Operation.unsigned_operation_encoding
~output: ~output:
(wrap_tzerror @@ (wrap_tzerror @@
@ -718,16 +718,16 @@ module Helpers = struct
(req "operation" @@ (req "operation" @@
describe ~title: "hex encoded operation" bytes))) describe ~title: "hex encoded operation" bytes)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "forge" / "operations" ) RPC_path.(custom_root / "helpers" / "forge" / "operations" )
let empty_proof_of_work_nonce = let empty_proof_of_work_nonce =
MBytes.of_string MBytes.of_string
(String.make Constants_repr.proof_of_work_nonce_size '\000') (String.make Constants_repr.proof_of_work_nonce_size '\000')
let block_proto_header custom_root = let block_proto_header custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "Forge the protocol-specific part of a block header" ~description: "Forge the protocol-specific part of a block header"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: ~input:
(obj3 (obj3
(req "priority" uint16) (req "priority" uint16)
@ -738,16 +738,16 @@ module Helpers = struct
empty_proof_of_work_nonce)) empty_proof_of_work_nonce))
~output: (wrap_tzerror bytes) ~output: (wrap_tzerror bytes)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "forge" / "block_proto_header") RPC_path.(custom_root / "helpers" / "forge" / "block_proto_header")
end end
module Parse = struct module Parse = struct
let operations custom_root = let operations custom_root =
RPC.Service.post_service RPC_service.post_service
~description:"Parse operations" ~description:"Parse operations"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: ~input:
(obj2 (obj2
(req "operations" (list (dynamic_size Operation.raw_encoding))) (req "operations" (list (dynamic_size Operation.raw_encoding)))
@ -755,16 +755,16 @@ module Helpers = struct
~output: ~output:
(wrap_tzerror (list (dynamic_size Operation.encoding))) (wrap_tzerror (list (dynamic_size Operation.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "parse" / "operations" ) RPC_path.(custom_root / "helpers" / "parse" / "operations" )
let block custom_root = let block custom_root =
RPC.Service.post_service RPC_service.post_service
~description:"Parse a block" ~description:"Parse a block"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: Block_header.raw_encoding ~input: Block_header.raw_encoding
~output: (wrap_tzerror Block_header.proto_header_encoding) ~output: (wrap_tzerror Block_header.proto_header_encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "parse" / "block" ) RPC_path.(custom_root / "helpers" / "parse" / "block" )
end end

22
lib_embedded_protocol_alpha/src/services_registration.ml
View File

@ -26,34 +26,34 @@ let rpc_init
Tezos_context.init ~level ~timestamp ~fitness context >>=? fun context -> Tezos_context.init ~level ~timestamp ~fitness context >>=? fun context ->
return { block_hash ; block_header ; operation_hashes ; operations ; 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 = let register0_fullctxt s f =
rpc_services := 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 () -> (fun ctxt q () ->
( rpc_init ctxt >>=? fun ctxt -> ( 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 register0 s f = register0_fullctxt s (fun { context ; _ } -> f context)
let register1_fullctxt s f = let register1_fullctxt s f =
rpc_services := 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 -> (fun ctxt q arg ->
( rpc_init ctxt >>=? fun ctxt -> ( 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 s f = register1_fullctxt s (fun { context ; _ } x -> f context x)
let register1_noctxt s f = let register1_noctxt s f =
rpc_services := rpc_services :=
RPC.Directory.register !rpc_services (s RPC.Path.open_root) RPC_directory.register !rpc_services (s RPC_path.open_root)
(fun _ q arg -> f q arg >>= RPC.Answer.return) (fun _ q arg -> f q arg >>= RPC_answer.return)
let register2_fullctxt s f = let register2_fullctxt s f =
rpc_services := 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 -> (fun (ctxt, arg1) q arg2 ->
( rpc_init ctxt >>=? fun ctxt -> ( 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) let register2 s f = register2_fullctxt s (fun { context ; _ } q x y -> f context q x y)
@ -214,12 +214,12 @@ let () =
let () = let () =
let register2 s f = let register2 s f =
rpc_services := 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 -> (fun (ctxt, contract) () arg ->
( rpc_init ctxt >>=? fun { context = ctxt ; _ } -> ( rpc_init ctxt >>=? fun { context = ctxt ; _ } ->
Contract.exists ctxt contract >>=? function Contract.exists ctxt contract >>=? function
| true -> f ctxt contract arg | 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 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.balance Contract.get_balance ;
register2' Services.Context.Contract.manager Contract.get_manager ; register2' Services.Context.Contract.manager Contract.get_manager ;

8
lib_embedded_protocol_alpha/src/tezos_context.mli
View File

@ -83,7 +83,7 @@ module Raw_level : sig
include BASIC_DATA include BASIC_DATA
type raw_level = t 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 val diff: raw_level -> raw_level -> int32
@ -98,7 +98,7 @@ module Cycle : sig
include BASIC_DATA include BASIC_DATA
type cycle = t type cycle = t
val arg: cycle RPC.Arg.arg val arg: cycle RPC_arg.arg
val root: cycle val root: cycle
val succ: cycle -> cycle val succ: cycle -> cycle
@ -304,7 +304,7 @@ module Voting_period : sig
include BASIC_DATA include BASIC_DATA
type voting_period = t type voting_period = t
val arg: voting_period RPC.Arg.arg val arg: voting_period RPC_arg.arg
val root: voting_period val root: voting_period
val succ: voting_period -> voting_period val succ: voting_period -> voting_period
@ -403,7 +403,7 @@ module Contract : sig
include BASIC_DATA include BASIC_DATA
type contract = t type contract = t
val arg: contract RPC.Arg.arg val arg: contract RPC_arg.arg
val to_b58check: contract -> string val to_b58check: contract -> string
val of_b58check: string -> contract tzresult val of_b58check: string -> contract tzresult

2
lib_embedded_protocol_alpha/src/voting_period_repr.ml
View File

@ -18,7 +18,7 @@ let arg =
match Int32.of_string str with match Int32.of_string str with
| exception _ -> Error "Cannot parse voting period" | exception _ -> Error "Cannot parse voting period"
| voting_period -> Ok voting_period in | voting_period -> Ok voting_period in
RPC.Arg.make RPC_arg.make
~descr:"A voting period" ~descr:"A voting period"
~name: "voting_period" ~name: "voting_period"
~construct ~construct

2
lib_embedded_protocol_alpha/src/voting_period_repr.mli
View File

@ -10,7 +10,7 @@
type t type t
type voting_period = t type voting_period = t
val encoding: voting_period Data_encoding.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 val pp: Format.formatter -> voting_period -> unit
include Compare.S with type t := voting_period include Compare.S with type t := voting_period

26
lib_embedded_protocol_demo/src/services.ml
View File

@ -32,34 +32,34 @@ let wrap_tzerror encoding =
] ]
let echo_service custom_root = let echo_service custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "An dummy echo service" ~description: "An dummy echo service"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: Data_encoding.(obj1 (req "msg" string)) ~input: Data_encoding.(obj1 (req "msg" string))
~output: Data_encoding.(obj1 (req "msg" string)) ~output: Data_encoding.(obj1 (req "msg" string))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "echo") RPC_path.(custom_root / "echo")
let failing_service custom_root = let failing_service custom_root =
RPC.Service.post_service RPC_service.post_service
~description: "A failing service" ~description: "A failing service"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: Data_encoding.(obj1 (req "arg" int31)) ~input: Data_encoding.(obj1 (req "arg" int31))
~output: (wrap_tzerror Data_encoding.empty) ~output: (wrap_tzerror Data_encoding.empty)
~error: 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 = let dir =
RPC.Directory.register RPC_directory.register
dir dir
(failing_service RPC.Path.open_root) (failing_service RPC_path.open_root)
(fun _ctxt () x -> Error.demo_error x >>= RPC.Answer.return) (fun _ctxt () x -> Error.demo_error x >>= RPC_answer.return)
in in
let dir = let dir =
RPC.Directory.register RPC_directory.register
dir dir
(echo_service RPC.Path.open_root) (echo_service RPC_path.open_root)
(fun _ctxt () x -> RPC.Answer.return x) (fun _ctxt () x -> RPC_answer.return x)
in in
dir dir

16
lib_embedded_protocol_genesis/src/services.ml
View File

@ -34,9 +34,9 @@ let wrap_tzerror encoding =
module Forge = struct module Forge = struct
let block custom_root = let block custom_root =
let open Data_encoding in let open Data_encoding in
RPC.Service.post_service RPC_service.post_service
~description: "Forge a block" ~description: "Forge a block"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: ~input:
(merge_objs (merge_objs
(obj6 (obj6
@ -49,7 +49,7 @@ module Forge = struct
Data.Command.encoding) Data.Command.encoding)
~output: (obj1 (req "payload" bytes)) ~output: (obj1 (req "payload" bytes))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(custom_root / "helpers" / "forge" / "block") RPC_path.(custom_root / "helpers" / "forge" / "block")
end end
let int64_to_bytes i = let int64_to_bytes i =
@ -60,16 +60,16 @@ let int64_to_bytes i =
let operations_hash = let operations_hash =
Operation_list_list_hash.compute [] Operation_list_list_hash.compute []
let rpc_services : Updater.rpc_context RPC.Directory.t = let rpc_services : Updater.rpc_context RPC_directory.t =
let dir = RPC.Directory.empty in let dir = RPC_directory.empty in
let dir = let dir =
RPC.Directory.register RPC_directory.register
dir dir
(Forge.block RPC.Path.open_root) (Forge.block RPC_path.open_root)
(fun _ctxt () ((_net_id, level, proto_level, predecessor, (fun _ctxt () ((_net_id, level, proto_level, predecessor,
timestamp, fitness), command) -> timestamp, fitness), command) ->
let shell = { Block_header.level ; proto_level ; predecessor ; let shell = { Block_header.level ; proto_level ; predecessor ;
timestamp ; fitness ; validation_passes = 0 ; operations_hash } in timestamp ; fitness ; validation_passes = 0 ; operations_hash } in
let bytes = Data.Command.forge shell command in let bytes = Data.Command.forge shell command in
RPC.Answer.return bytes) in RPC_answer.return bytes) in
dir dir

10
lib_node_http/RPC_answer.ml Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include Resto_directory.Answer

10
lib_node_http/RPC_answer.mli Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include module type of (struct include Resto_directory.Answer end)

24
lib_node_http/RPC_client.ml
View File

@ -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 module type LOGGER = Client.LOGGER
type logger = (module LOGGER) type logger = (module LOGGER)
@ -32,7 +32,7 @@ type rest_error =
| Connection_failed of string | Connection_failed of string
| Not_found | Not_found
| Bad_request of string | 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 | Unsupported_media_type of string option
| Not_acceptable of { proposed: string ; acceptable: string } | Not_acceptable of { proposed: string ; acceptable: string }
| Unexpected_status_code of { code: Cohttp.Code.status_code ; | Unexpected_status_code of { code: Cohttp.Code.status_code ;
@ -68,7 +68,7 @@ let rest_error_encoding =
case ~tag: 3 case ~tag: 3
(obj2 (obj2
(req "kind" (constant "method_not_allowed")) (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 Method_not_allowed meths -> Some ((), meths) | _ -> None)
(function ((), meths) -> Method_not_allowed meths) ; (function ((), meths) -> Method_not_allowed meths) ;
case ~tag: 4 case ~tag: 4
@ -145,7 +145,7 @@ let pp_rest_error ppf err =
Format.fprintf ppf Format.fprintf ppf
"@[<v 2>The requested service only accepts the following method:@ %a@]" "@[<v 2>The requested service only accepts the following method:@ %a@]"
(Format.pp_print_list (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 meths
| Unsupported_media_type None -> | Unsupported_media_type None ->
Format.fprintf ppf Format.fprintf ppf
@ -177,7 +177,7 @@ let pp_rest_error ppf err =
"Generic error" "Generic error"
type error += type error +=
| Request_failed of { meth: RPC.meth ; | Request_failed of { meth: RPC_service.meth ;
uri: Uri.t ; uri: Uri.t ;
error: rest_error } error: rest_error }
@ -199,11 +199,11 @@ let () =
\ - meth: %s@ \ \ - meth: %s@ \
\ - uri: %s@ \ \ - uri: %s@ \
\ - error: %a@]" \ - error: %a@]"
(RPC.string_of_meth meth) (RPC_service.string_of_meth meth)
(Uri.to_string uri) (Uri.to_string uri)
pp_rest_error error) pp_rest_error error)
Data_encoding.(obj3 Data_encoding.(obj3
(req "meth" RPC.meth_encoding) (req "meth" RPC_service.meth_encoding)
(req "uri" uri_encoding) (req "uri" uri_encoding)
(req "error" rest_error_encoding)) (req "error" rest_error_encoding))
(function (function
@ -212,7 +212,7 @@ let () =
(fun (meth, uri, error) -> Request_failed { uri ; meth ; error }) (fun (meth, uri, error) -> Request_failed { uri ; meth ; error })
let request_failed meth uri 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 }) fail (Request_failed { meth ; uri ; error })
let generic_call ?logger ?accept ?body ?media meth uri : (content, content) rest_result Lwt.t = 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 request_failed meth uri
(Unexpected_status_code { code ; content ; media_type }) (Unexpected_status_code { code ; content ; media_type })
| `Method_not_allowed allowed -> | `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) request_failed meth uri (Method_not_allowed allowed)
| `Unsupported_media_type -> | `Unsupported_media_type ->
let media = Option.map media ~f:Media_type.name in 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 -> Cohttp_lwt.Body.to_string content >>= fun content ->
request_failed meth uri (Unexpected_status_code { code ; content ; media_type }) request_failed meth uri (Unexpected_status_code { code ; content ; media_type })
| `Method_not_allowed allowed -> | `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) request_failed meth uri (Method_not_allowed allowed)
| `Unsupported_media_type -> | `Unsupported_media_type ->
let name = let name =
@ -340,7 +340,7 @@ let handle accept (meth, uri, ans) =
let call_streamed_service let call_streamed_service
(type p q i o ) (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 ~on_chunk ~on_close
(params : p) (query : q) (body : i) : (unit -> unit) tzresult Lwt.t = (params : p) (query : q) (body : i) : (unit -> unit) tzresult Lwt.t =
Client.call_streamed_service Client.call_streamed_service
@ -350,7 +350,7 @@ let call_streamed_service
let call_service let call_service
(type p q i o ) (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) (params : p)
(query : q) (body : i) : o tzresult Lwt.t = (query : q) (body : i) : o tzresult Lwt.t =
Client.call_service Client.call_service

12
lib_node_http/RPC_client.mli
View File

@ -41,7 +41,7 @@ type rest_error =
| Connection_failed of string | Connection_failed of string
| Not_found | Not_found
| Bad_request of string | 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 | Unsupported_media_type of string option
| Not_acceptable of { proposed: string ; acceptable: string } | Not_acceptable of { proposed: string ; acceptable: string }
| Unexpected_status_code of { code: Cohttp.Code.status_code ; | Unexpected_status_code of { code: Cohttp.Code.status_code ;
@ -55,7 +55,7 @@ type rest_error =
| Generic_error (* temporary *) | Generic_error (* temporary *)
type error += type error +=
| Request_failed of { meth: RPC.meth ; | Request_failed of { meth: RPC_service.meth ;
uri: Uri.t ; uri: Uri.t ;
error: rest_error } error: rest_error }
@ -64,27 +64,27 @@ val generic_call :
?accept:Media_type.t list -> ?accept:Media_type.t list ->
?body:Cohttp_lwt.Body.t -> ?body:Cohttp_lwt.Body.t ->
?media:Media_type.t -> ?media:Media_type.t ->
[< RPC.meth ] -> [< RPC_service.meth ] ->
Uri.t -> (content, content) rest_result Lwt.t Uri.t -> (content, content) rest_result Lwt.t
val generic_json_call : val generic_json_call :
?logger:logger -> ?logger:logger ->
?body:Data_encoding.json -> ?body:Data_encoding.json ->
[< RPC.meth ] -> Uri.t -> [< RPC_service.meth ] -> Uri.t ->
(Data_encoding.json, Data_encoding.json option) rest_result Lwt.t (Data_encoding.json, Data_encoding.json option) rest_result Lwt.t
val call_service : val call_service :
Media_type.t list -> Media_type.t list ->
?logger:logger -> ?logger:logger ->
base:Uri.t -> 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 'p -> 'q -> 'i -> 'o tzresult Lwt.t
val call_streamed_service : val call_streamed_service :
Media_type.t list -> Media_type.t list ->
?logger:logger -> ?logger:logger ->
base:Uri.t -> 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_chunk: ('o -> unit) ->
on_close: (unit -> unit) -> on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t

10
lib_node_http/RPC_directory.ml Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include Resto_directory.Make(RPC_encoding)

10
lib_node_http/RPC_directory.mli Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include module type of (struct include Resto_directory.Make(RPC_encoding) end)

5
lib_node_http/RPC_server.ml
View File

@ -12,7 +12,4 @@ type cors = Resto_cohttp.Cors.t = {
allowed_origins : string list ; allowed_origins : string list ;
} }
include Resto_directory include Resto_cohttp.Server.Make(RPC_encoding)(Logging.RPC)
module Directory = Resto_directory.Make(RPC.Data)
include Resto_cohttp.Server.Make(RPC.Data)(Logging.RPC)

7
lib_node_http/RPC_server.mli
View File

@ -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. *) (** Typed RPC services: server implementation. *)
type cors = { type cors = {
@ -28,7 +23,7 @@ val launch :
?cors:cors -> ?cors:cors ->
media_types:Media_type.t list -> media_types:Media_type.t list ->
Conduit_lwt_unix.server -> Conduit_lwt_unix.server ->
unit Directory.t -> unit RPC_directory.t ->
server Lwt.t server Lwt.t
(** Kill an RPC server. *) (** Kill an RPC server. *)

2
lib_node_http/media_type.ml
View File

@ -7,7 +7,7 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
include Resto_cohttp.Media_type.Make(RPC.Data) include Resto_cohttp.Media_type.Make(RPC_encoding)
let json = { let json = {
name = Cohttp.Accept.MediaType ("application", "json") ; name = Cohttp.Accept.MediaType ("application", "json") ;

2
lib_node_http/media_type.mli
View File

@ -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 ; name: Cohttp.Accept.media_range ;
q: int option ; q: int option ;
pp: 'a. 'a Data_encoding.t -> Format.formatter -> string -> unit ; pp: 'a. 'a Data_encoding.t -> Format.formatter -> string -> unit ;

160
lib_node_services/RPC.ml
View File

@ -1,160 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

10
lib_node_services/RPC_arg.ml Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include Resto.Arg

10
lib_node_services/RPC_arg.mli Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include (module type of struct include Resto.Arg end)

11
lib_node_services/RPC_description.ml Normal file
View File

@ -0,0 +1,11 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include Resto.Description

10
lib_node_services/RPC_description.mli Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include (module type of struct include Resto.Description end)

158
lib_node_services/RPC_encoding.ml Normal file
View File

@ -0,0 +1,158 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

12
lib_node_services/RPC_encoding.mli Normal file
View File

@ -0,0 +1,12 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

10
lib_node_services/RPC_path.ml Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include Resto.Path

10
lib_node_services/RPC_path.mli Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include (module type of struct include Resto.Path end)

10
lib_node_services/RPC_query.ml Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include Resto.Query

10
lib_node_services/RPC_query.mli Normal file
View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
include (module type of struct include Resto.Query end)

27
lib_node_services/RPC_service.ml Normal file
View File

@ -0,0 +1,27 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

14
lib_node_services/RPC.mli → lib_node_services/RPC_service.mli
View File

@ -7,12 +7,12 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
(** Typed RPC services: definition, binding and dispatch. *) type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
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)
val string_of_meth: [< meth ] -> string
val meth_of_string: string -> [> meth ] option
val meth_encoding: meth Data_encoding.t val meth_encoding: meth Data_encoding.t
module MethMap = Resto.MethMap
include (module type of struct include Resto.MakeService(RPC_encoding) end)

256
lib_node_services/node_rpc_services.ml
View File

@ -12,23 +12,23 @@ open Data_encoding
module Error = struct module Error = struct
let service = let service =
RPC.Service.post_service RPC_service.post_service
~description: "Schema for all the RPC errors from the shell" ~description: "Schema for all the RPC errors from the shell"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: Data_encoding.empty ~input: Data_encoding.empty
~output: Data_encoding.json_schema ~output: Data_encoding.json_schema
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "errors") RPC_path.(root / "errors")
let encoding = let encoding =
let { RPC.Service.meth ; uri ; _ } = let { RPC_service.meth ; uri ; _ } =
RPC.Service.forge_request service () () in RPC_service.forge_request service () () in
describe describe
~description: ~description:
(Printf.sprintf (Printf.sprintf
"The full list of error is available with \ "The full list of error is available with \
the global RPC `%s %s`" 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 (conv
~schema:Json_schema.any ~schema:Json_schema.any
(fun exn -> `A (List.map json_of_error exn)) (fun exn -> `A (List.map json_of_error exn))
@ -144,84 +144,84 @@ module Blocks = struct
of 'head' or 'test_head'." in of 'head' or 'test_head'." in
let construct = to_string in let construct = to_string in
let destruct = parse_block 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 = let block_path : (unit, unit * block) RPC_path.path =
RPC.Path.(root / "blocks" /: blocks_arg ) RPC_path.(root / "blocks" /: blocks_arg )
let info = let info =
RPC.Service.post_service RPC_service.post_service
~description:"All the information about a block." ~description:"All the information about a block."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (dft "operations" bool true)) ~input: (obj1 (dft "operations" bool true))
~output: block_info_encoding ~output: block_info_encoding
~error: Data_encoding.empty ~error: Data_encoding.empty
block_path block_path
let net_id = let net_id =
RPC.Service.post_service RPC_service.post_service
~description:"Returns the net of the chain in which the block belongs." ~description:"Returns the net of the chain in which the block belongs."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "net_id" Net_id.encoding)) ~output: (obj1 (req "net_id" Net_id.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "net_id") RPC_path.(block_path / "net_id")
let level = let level =
RPC.Service.post_service RPC_service.post_service
~description:"Returns the block's level." ~description:"Returns the block's level."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "level" int32)) ~output: (obj1 (req "level" int32))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "level") RPC_path.(block_path / "level")
let predecessor = let predecessor =
RPC.Service.post_service RPC_service.post_service
~description:"Returns the previous block's id." ~description:"Returns the previous block's id."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "predecessor" Block_hash.encoding)) ~output: (obj1 (req "predecessor" Block_hash.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "predecessor") RPC_path.(block_path / "predecessor")
let predecessors = let predecessors =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"...." "...."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (req "length" Data_encoding.uint16)) ~input: (obj1 (req "length" Data_encoding.uint16))
~output: (obj1 ~output: (obj1
(req "blocks" (Data_encoding.list Block_hash.encoding))) (req "blocks" (Data_encoding.list Block_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "predecessors") RPC_path.(block_path / "predecessors")
let hash = let hash =
RPC.Service.post_service RPC_service.post_service
~description:"Returns the block's id." ~description:"Returns the block's id."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "hash" Block_hash.encoding)) ~output: (obj1 (req "hash" Block_hash.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "hash") RPC_path.(block_path / "hash")
let fitness = let fitness =
RPC.Service.post_service RPC_service.post_service
~description:"Returns the block's fitness." ~description:"Returns the block's fitness."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "fitness" Fitness.encoding)) ~output: (obj1 (req "fitness" Fitness.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "fitness") RPC_path.(block_path / "fitness")
let timestamp = let timestamp =
RPC.Service.post_service RPC_service.post_service
~description:"Returns the block's timestamp." ~description:"Returns the block's timestamp."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "timestamp" Time.encoding)) ~output: (obj1 (req "timestamp" Time.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "timestamp") RPC_path.(block_path / "timestamp")
type operations_param = { type operations_param = {
contents: bool ; contents: bool ;
@ -238,9 +238,9 @@ module Blocks = struct
(dft "monitor" bool false)) (dft "monitor" bool false))
let operations = let operations =
RPC.Service.post_service RPC_service.post_service
~description:"List the block operations." ~description:"List the block operations."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: operations_param_encoding ~input: operations_param_encoding
~output: (obj1 ~output: (obj1
(req "operations" (req "operations"
@ -250,25 +250,25 @@ module Blocks = struct
(opt "contents" (opt "contents"
(dynamic_size Operation.encoding))))))) (dynamic_size Operation.encoding)))))))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "operations") RPC_path.(block_path / "operations")
let protocol = let protocol =
RPC.Service.post_service RPC_service.post_service
~description:"List the block protocol." ~description:"List the block protocol."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj1 (req "protocol" Protocol_hash.encoding)) ~output: (obj1 (req "protocol" Protocol_hash.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "protocol") RPC_path.(block_path / "protocol")
let test_network = let test_network =
RPC.Service.post_service RPC_service.post_service
~description:"Returns the status of the associated test network." ~description:"Returns the status of the associated test network."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: Test_network_status.encoding ~output: Test_network_status.encoding
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "test_network") RPC_path.(block_path / "test_network")
let pending_operations = let pending_operations =
let operation_encoding = let operation_encoding =
@ -276,10 +276,10 @@ module Blocks = struct
(obj1 (req "hash" Operation_hash.encoding)) (obj1 (req "hash" Operation_hash.encoding))
Operation.encoding in Operation.encoding in
(* TODO: branch_delayed/... *) (* TODO: branch_delayed/... *)
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"List the not-yet-prevalidated operations." "List the not-yet-prevalidated operations."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: ~output:
(conv (conv
@ -297,10 +297,10 @@ module Blocks = struct
(Preapply_result.encoding Error.encoding)) (Preapply_result.encoding Error.encoding))
(obj1 (req "unprocessed" (list (dynamic_size operation_encoding)))))) (obj1 (req "unprocessed" (list (dynamic_size operation_encoding))))))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "pending_operations") RPC_path.(block_path / "pending_operations")
let proto_path = let proto_path =
RPC.Path.(block_path / "proto") RPC_path.(block_path / "proto")
type preapply_param = { type preapply_param = {
timestamp: Time.t ; timestamp: Time.t ;
@ -338,30 +338,30 @@ module Blocks = struct
(Preapply_result.encoding Error.encoding)))) (Preapply_result.encoding Error.encoding))))
let preapply = let preapply =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"Simulate the validation of a block that would contain \ "Simulate the validation of a block that would contain \
the given operations and return the resulting fitness." the given operations and return the resulting fitness."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: preapply_param_encoding ~input: preapply_param_encoding
~output: (Error.wrap preapply_result_encoding) ~output: (Error.wrap preapply_result_encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "preapply") RPC_path.(block_path / "preapply")
let complete = let complete =
let prefix_arg = let prefix_arg =
let destruct s = Ok s let destruct s = Ok s
and construct s = s in and construct s = s in
RPC.Arg.make ~name:"prefix" ~destruct ~construct () in RPC_arg.make ~name:"prefix" ~destruct ~construct () in
RPC.Service.post_service RPC_service.post_service
~description: "Try to complete a prefix of a Base58Check-encoded data. \ ~description: "Try to complete a prefix of a Base58Check-encoded data. \
This RPC is actually able to complete hashes of \ This RPC is actually able to complete hashes of \
block, operations, public_keys and contracts." block, operations, public_keys and contracts."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (list string) ~output: (list string)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(block_path / "complete" /: prefix_arg ) RPC_path.(block_path / "complete" /: prefix_arg )
type list_param = { type list_param = {
include_ops: bool ; include_ops: bool ;
@ -429,23 +429,23 @@ module Blocks = struct
int31))) int31)))
let list = let list =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"Lists known heads of the blockchain sorted with decreasing fitness. \ "Lists known heads of the blockchain sorted with decreasing fitness. \
Optional arguments allows to returns the list of predecessors for \ Optional arguments allows to returns the list of predecessors for \
known heads or the list of predecessors for a given list of blocks." 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 ~input: list_param_encoding
~output: (obj1 (req "blocks" (list (list block_info_encoding)))) ~output: (obj1 (req "blocks" (list (list block_info_encoding))))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "blocks") RPC_path.(root / "blocks")
let list_invalid = let list_invalid =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"Lists blocks that have been declared invalid along with the errors\ "Lists blocks that have been declared invalid along with the errors\
that led to them being declared invalid" that led to them being declared invalid"
~query: RPC.Query.empty ~query: RPC_query.empty
~input:empty ~input:empty
~output:(Data_encoding.list ~output:(Data_encoding.list
(obj3 (obj3
@ -453,7 +453,7 @@ module Blocks = struct
(req "level" int32) (req "level" int32)
(req "errors" Error.encoding))) (req "errors" Error.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "invalid_blocks") RPC_path.(root / "invalid_blocks")
end end
@ -467,18 +467,18 @@ module Protocols = struct
let destruct h = let destruct h =
try Ok (Protocol_hash.of_b58check_exn h) try Ok (Protocol_hash.of_b58check_exn h)
with _ -> Error "Can't parse hash" in with _ -> Error "Can't parse hash" in
RPC.Arg.make ~name ~descr ~construct ~destruct () RPC_arg.make ~name ~descr ~construct ~destruct ()
let contents = let contents =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: ~output:
(obj1 (req "data" (obj1 (req "data"
(describe ~title: "Tezos protocol" (describe ~title: "Tezos protocol"
(Protocol.encoding)))) (Protocol.encoding))))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "protocols" /: protocols_arg) RPC_path.(root / "protocols" /: protocols_arg)
type list_param = { type list_param = {
contents: bool option ; contents: bool option ;
@ -494,8 +494,8 @@ module Protocols = struct
(opt "monitor" bool)) (opt "monitor" bool))
let list = let list =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: list_param_encoding ~input: list_param_encoding
~output: ~output:
(obj1 (obj1
@ -507,7 +507,7 @@ module Protocols = struct
(dynamic_size Protocol.encoding))) (dynamic_size Protocol.encoding)))
))) )))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "protocols") RPC_path.(root / "protocols")
end end
@ -515,8 +515,8 @@ module Network = struct
open P2p_types open P2p_types
let (peer_id_arg : P2p_types.Peer_id.t RPC.Arg.arg) = let (peer_id_arg : P2p_types.Peer_id.t RPC_arg.arg) =
RPC.Arg.make RPC_arg.make
~name:"peer_id" ~name:"peer_id"
~descr:"A network global identifier, also known as an identity." ~descr:"A network global identifier, also known as an identity."
~destruct:(fun s -> try ~destruct:(fun s -> try
@ -526,7 +526,7 @@ module Network = struct
() ()
let point_arg = let point_arg =
RPC.Arg.make RPC_arg.make
~name:"point" ~name:"point"
~descr:"A network point (ipv4:port or [ipv6]:port)." ~descr:"A network point (ipv4:port or [ipv6]:port)."
~destruct:Point.of_string ~destruct:Point.of_string
@ -534,99 +534,99 @@ module Network = struct
() ()
let versions = let versions =
RPC.Service.post_service RPC_service.post_service
~description:"Supported network layer versions." ~description:"Supported network layer versions."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (list P2p_types.Version.encoding) ~output: (list P2p_types.Version.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "network" / "versions") RPC_path.(root / "network" / "versions")
let stat = let stat =
RPC.Service.post_service RPC_service.post_service
~description:"Global network bandwidth statistics in B/s." ~description:"Global network bandwidth statistics in B/s."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: P2p_types.Stat.encoding ~output: P2p_types.Stat.encoding
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "network" / "stat") RPC_path.(root / "network" / "stat")
let events = let events =
RPC.Service.post_service RPC_service.post_service
~description:"Stream of all network events" ~description:"Stream of all network events"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: P2p_types.Connection_pool_log_event.encoding ~output: P2p_types.Connection_pool_log_event.encoding
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "network" / "log") RPC_path.(root / "network" / "log")
let connect = let connect =
RPC.Service.post_service RPC_service.post_service
~description:"Connect to a peer" ~description:"Connect to a peer"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (dft "timeout" float 5.)) ~input: (obj1 (dft "timeout" float 5.))
~output: (Error.wrap @@ empty) ~output: (Error.wrap @@ empty)
~error: Data_encoding.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) let monitor_encoding = obj1 (dft "monitor" bool false)
module Connection = struct module Connection = struct
let list = let list =
RPC.Service.post_service RPC_service.post_service
~description:"List the running P2P connection." ~description:"List the running P2P connection."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (list P2p_types.Connection_info.encoding) ~output: (list P2p_types.Connection_info.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "network" / "connection") RPC_path.(root / "network" / "connection")
let info = let info =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (option P2p_types.Connection_info.encoding) ~output: (option P2p_types.Connection_info.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
~description:"Details about the current P2P connection to the given peer." ~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 = let kick =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: (obj1 (req "wait" bool)) ~input: (obj1 (req "wait" bool))
~output: empty ~output: empty
~error: Data_encoding.empty ~error: Data_encoding.empty
~description:"Forced close of the current P2P connection to the given peer." ~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 end
module Point = struct module Point = struct
let info = let info =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (option P2p_types.Point_info.encoding) ~output: (option P2p_types.Point_info.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
~description: "Details about a given `IP:addr`." ~description: "Details about a given `IP:addr`."
RPC.Path.(root / "network" / "point" /: point_arg) RPC_path.(root / "network" / "point" /: point_arg)
let events = let events =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: monitor_encoding ~input: monitor_encoding
~output: (list P2p_connection_pool_types.Point_info.Event.encoding) ~output: (list P2p_connection_pool_types.Point_info.Event.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
~description: "Monitor network events related to an `IP:addr`." ~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 list =
let filter = let filter =
obj1 (dft "filter" (list P2p_types.Point_state.encoding) []) in obj1 (dft "filter" (list P2p_types.Point_state.encoding) []) in
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: filter ~input: filter
~output: ~output:
(list (tup2 (list (tup2
@ -635,35 +635,35 @@ module Network = struct
~error: Data_encoding.empty ~error: Data_encoding.empty
~description:"List the pool of known `IP:port` \ ~description:"List the pool of known `IP:port` \
used for establishing P2P connections ." used for establishing P2P connections ."
RPC.Path.(root / "network" / "point") RPC_path.(root / "network" / "point")
end end
module Peer_id = struct module Peer_id = struct
let info = let info =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (option P2p_types.Peer_info.encoding) ~output: (option P2p_types.Peer_info.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
~description:"Details about a given peer." ~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 = let events =
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: monitor_encoding ~input: monitor_encoding
~output: (list P2p_connection_pool_types.Peer_info.Event.encoding) ~output: (list P2p_connection_pool_types.Peer_info.Event.encoding)
~error: Data_encoding.empty ~error: Data_encoding.empty
~description:"Monitor network events related to a given peer." ~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 list =
let filter = let filter =
obj1 (dft "filter" (list P2p_types.Peer_state.encoding) []) in obj1 (dft "filter" (list P2p_types.Peer_state.encoding) []) in
RPC.Service.post_service RPC_service.post_service
~query: RPC.Query.empty ~query: RPC_query.empty
~input: filter ~input: filter
~output: ~output:
(list (tup2 (list (tup2
@ -671,20 +671,20 @@ module Network = struct
P2p_types.Peer_info.encoding)) P2p_types.Peer_info.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
~description:"List the peers the node ever met." ~description:"List the peers the node ever met."
RPC.Path.(root / "network" / "peer_id") RPC_path.(root / "network" / "peer_id")
end end
end end
let forge_block_header = let forge_block_header =
RPC.Service.post_service RPC_service.post_service
~description: "Forge a block header" ~description: "Forge a block header"
~query: RPC.Query.empty ~query: RPC_query.empty
~input: Block_header.encoding ~input: Block_header.encoding
~output: (obj1 (req "block" bytes)) ~output: (obj1 (req "block" bytes))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "forge_block_header") RPC_path.(root / "forge_block_header")
type inject_block_param = { type inject_block_param = {
raw: MBytes.t ; raw: MBytes.t ;
@ -723,7 +723,7 @@ let inject_block_param =
(list (list (dynamic_size Operation.encoding)))))) (list (list (dynamic_size Operation.encoding))))))
let inject_block = let inject_block =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"Inject a block in the node and broadcast it. The `operations` \ "Inject a block in the node and broadcast it. The `operations` \
embedded in `blockHeader` might be pre-validated using a \ 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 \ (e.g. '/blocks/head/context/preapply'). Returns the ID of the \
block. By default, the RPC will wait for the block to be \ block. By default, the RPC will wait for the block to be \
validated before answering." validated before answering."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: inject_block_param ~input: inject_block_param
~output: ~output:
(Error.wrap @@ (Error.wrap @@
(obj1 (req "block_hash" Block_hash.encoding))) (obj1 (req "block_hash" Block_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "inject_block") RPC_path.(root / "inject_block")
let inject_operation = let inject_operation =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"Inject an operation in node and broadcast it. Returns the \ "Inject an operation in node and broadcast it. Returns the \
ID of the operation. The `signedOperationContents` should be \ ID of the operation. The `signedOperationContents` should be \
@ -749,7 +749,7 @@ let inject_operation =
the operation to be (pre-)validated before answering. See \ the operation to be (pre-)validated before answering. See \
RPCs under /blocks/prevalidation for more details on the \ RPCs under /blocks/prevalidation for more details on the \
prevalidation context." prevalidation context."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: ~input:
(obj4 (obj4
(req "signedOperationContents" (req "signedOperationContents"
@ -775,13 +775,13 @@ let inject_operation =
~title: "Hash of the injected operation" @@ ~title: "Hash of the injected operation" @@
(obj1 (req "injectedOperation" Operation_hash.encoding))) (obj1 (req "injectedOperation" Operation_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "inject_operation") RPC_path.(root / "inject_operation")
let inject_protocol = let inject_protocol =
RPC.Service.post_service RPC_service.post_service
~description: ~description:
"Inject a protocol in node. Returns the ID of the protocol." "Inject a protocol in node. Returns the ID of the protocol."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: ~input:
(obj3 (obj3
(req "protocol" (req "protocol"
@ -804,35 +804,35 @@ let inject_protocol =
~title: "Hash of the injected protocol" @@ ~title: "Hash of the injected protocol" @@
(obj1 (req "injectedProtocol" Protocol_hash.encoding))) (obj1 (req "injectedProtocol" Protocol_hash.encoding)))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "inject_protocol") RPC_path.(root / "inject_protocol")
let bootstrapped = let bootstrapped =
RPC.Service.post_service RPC_service.post_service
~description:"" ~description:""
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (obj2 ~output: (obj2
(req "block" Block_hash.encoding) (req "block" Block_hash.encoding)
(req "timestamp" Time.encoding)) (req "timestamp" Time.encoding))
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "bootstrapped") RPC_path.(root / "bootstrapped")
let complete = let complete =
let prefix_arg = let prefix_arg =
let destruct s = Ok s let destruct s = Ok s
and construct s = s in and construct s = s in
RPC.Arg.make ~name:"prefix" ~destruct ~construct () in RPC_arg.make ~name:"prefix" ~destruct ~construct () in
RPC.Service.post_service RPC_service.post_service
~description: "Try to complete a prefix of a Base58Check-encoded data. \ ~description: "Try to complete a prefix of a Base58Check-encoded data. \
This RPC is actually able to complete hashes of \ This RPC is actually able to complete hashes of \
block and hashes of operations." block and hashes of operations."
~query: RPC.Query.empty ~query: RPC_query.empty
~input: empty ~input: empty
~output: (list string) ~output: (list string)
~error: Data_encoding.empty ~error: Data_encoding.empty
RPC.Path.(root / "complete" /: prefix_arg ) RPC_path.(root / "complete" /: prefix_arg )
let describe = let describe =
RPC.Service.description_service RPC_service.description_service
~description: "RPCs documentation and input/output schema" ~description: "RPCs documentation and input/output schema"
RPC.Path.(root / "describe") RPC_path.(root / "describe")

82
lib_node_services/node_rpc_services.mli
View File

@ -9,7 +9,7 @@
module Error : sig module Error : sig
val service: 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 encoding: error list Data_encoding.t
val wrap: 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding val wrap: 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding
end end
@ -22,7 +22,7 @@ module Blocks : sig
| `Test_head of int | `Test_prevalidation | `Test_head of int | `Test_prevalidation
| `Hash of Block_hash.t | `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 parse_block: string -> (block, string) result
val to_string: block -> string val to_string: block -> string
@ -46,35 +46,35 @@ module Blocks : sig
val info: val info:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, bool, unit * block, unit, bool,
block_info, unit) RPC.Service.t block_info, unit) RPC_service.t
val net_id: val net_id:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
Net_id.t, unit) RPC.Service.t Net_id.t, unit) RPC_service.t
val level: val level:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
Int32.t, unit) RPC.Service.t Int32.t, unit) RPC_service.t
val predecessor: val predecessor:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
Block_hash.t, unit) RPC.Service.t Block_hash.t, unit) RPC_service.t
val predecessors: val predecessors:
([ `POST ], unit, ([ `POST ], unit,
unit * block , unit, int, unit * block , unit, int,
Block_hash.t list, unit) RPC.Service.t Block_hash.t list, unit) RPC_service.t
val hash: val hash:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
Block_hash.t, unit) RPC.Service.t Block_hash.t, unit) RPC_service.t
val timestamp: val timestamp:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
Time.t, unit) RPC.Service.t Time.t, unit) RPC_service.t
val fitness: val fitness:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
MBytes.t list, unit) RPC.Service.t MBytes.t list, unit) RPC_service.t
type operations_param = { type operations_param = {
contents: bool ; contents: bool ;
@ -83,20 +83,20 @@ module Blocks : sig
val operations: val operations:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, operations_param, 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: val protocol:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
Protocol_hash.t, unit) RPC.Service.t Protocol_hash.t, unit) RPC_service.t
val test_network: val test_network:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, unit, unit * block, unit, unit,
Test_network_status.t, unit) RPC.Service.t Test_network_status.t, unit) RPC_service.t
val pending_operations: val pending_operations:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, 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 = { type list_param = {
include_ops: bool ; include_ops: bool ;
@ -110,12 +110,12 @@ module Blocks : sig
val list: val list:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, list_param, unit, unit, list_param,
block_info list list, unit) RPC.Service.t block_info list list, unit) RPC_service.t
val list_invalid: val list_invalid:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, 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 = { type preapply_param = {
timestamp: Time.t ; timestamp: Time.t ;
@ -131,14 +131,14 @@ module Blocks : sig
val preapply: val preapply:
([ `POST ], unit, ([ `POST ], unit,
unit * block, unit, preapply_param, unit * block, unit, preapply_param,
preapply_result tzresult, unit) RPC.Service.t preapply_result tzresult, unit) RPC_service.t
val complete: val complete:
([ `POST ], unit, ([ `POST ], unit,
(unit * block) * string, unit, 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 end
@ -148,7 +148,7 @@ module Protocols : sig
val contents: val contents:
([ `POST ], unit, ([ `POST ], unit,
unit * Protocol_hash.t, unit, unit, unit * Protocol_hash.t, unit, unit,
Protocol.t, unit) RPC.Service.t Protocol.t, unit) RPC_service.t
type list_param = { type list_param = {
contents: bool option ; contents: bool option ;
@ -158,7 +158,7 @@ module Protocols : sig
val list: val list:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, list_param, 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 end
@ -167,39 +167,39 @@ module Network : sig
val stat : val stat :
([ `POST ], unit, ([ `POST ], unit,
unit, unit, unit, unit, unit, unit,
P2p_types.Stat.t, unit) RPC.Service.t P2p_types.Stat.t, unit) RPC_service.t
val versions : val versions :
([ `POST ], unit, ([ `POST ], unit,
unit, unit, unit, unit, unit, unit,
P2p_types.Version.t list, unit) RPC.Service.t P2p_types.Version.t list, unit) RPC_service.t
val events : val events :
([ `POST ], unit, ([ `POST ], unit,
unit, unit, 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 : val connect :
([ `POST ], unit, ([ `POST ], unit,
unit * P2p_types.Point.t, unit, float, unit * P2p_types.Point.t, unit, float,
unit tzresult, unit) RPC.Service.t unit tzresult, unit) RPC_service.t
module Connection : sig module Connection : sig
val list : val list :
([ `POST ], unit, ([ `POST ], unit,
unit, unit, 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 : val info :
([ `POST ], unit, ([ `POST ], unit,
unit * P2p_types.Peer_id.t, unit, 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 : val kick :
([ `POST ], unit, ([ `POST ], unit,
unit * P2p_types.Peer_id.t, unit, bool, unit * P2p_types.Peer_id.t, unit, bool,
unit, unit) RPC.Service.t unit, unit) RPC_service.t
end end
@ -207,15 +207,15 @@ module Network : sig
val list : val list :
([ `POST ], unit, ([ `POST ], unit,
unit, unit, P2p_types.Point_state.t list, 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 : val info :
([ `POST ], unit, ([ `POST ], unit,
unit * P2p_types.Point.t, unit, 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 : val events :
([ `POST ], unit, ([ `POST ], unit,
unit * P2p_types.Point.t, unit, bool, 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 end
module Peer_id : sig module Peer_id : sig
@ -223,17 +223,17 @@ module Network : sig
val list : val list :
([ `POST ], unit, ([ `POST ], unit,
unit, unit, P2p_types.Peer_state.t list, 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 : val info :
([ `POST ], unit, ([ `POST ], unit,
unit * P2p_types.Peer_id.t, unit, 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 : val events :
([ `POST ], unit, ([ `POST ], unit,
unit * P2p_types.Peer_id.t, unit, bool, 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 end
@ -242,7 +242,7 @@ end
val forge_block_header: val forge_block_header:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, Block_header.t, unit, unit, Block_header.t,
MBytes.t, unit) RPC.Service.t MBytes.t, unit) RPC_service.t
type inject_block_param = { type inject_block_param = {
raw: MBytes.t ; raw: MBytes.t ;
@ -255,26 +255,26 @@ type inject_block_param = {
val inject_block: val inject_block:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, inject_block_param, unit, unit, inject_block_param,
Block_hash.t tzresult, unit) RPC.Service.t Block_hash.t tzresult, unit) RPC_service.t
val inject_operation: val inject_operation:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, (MBytes.t * bool * Net_id.t option * bool option), 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: val inject_protocol:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, (Protocol.t * bool * bool option), 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: val bootstrapped:
([ `POST ], unit, ([ `POST ], unit,
unit, unit, unit, unit, unit, unit,
Block_hash.t * Time.t, unit) RPC.Service.t Block_hash.t * Time.t, unit) RPC_service.t
val complete: val complete:
([ `POST ], unit, ([ `POST ], unit,
unit * string, unit, 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

6
lib_node_shell/node.ml
View File

@ -522,8 +522,8 @@ module RPC = struct
| Some rpc_context -> | Some rpc_context ->
Context.get_protocol rpc_context.context >>= fun protocol_hash -> Context.get_protocol rpc_context.context >>= fun protocol_hash ->
let (module Proto) = State.Registred_protocol.get_exn protocol_hash in let (module Proto) = State.Registred_protocol.get_exn protocol_hash in
let dir = RPC_server.Directory.map (fun () -> rpc_context) Proto.rpc_services in let dir = RPC_directory.map (fun () -> rpc_context) Proto.rpc_services in
Lwt.return (Some (RPC_server.Directory.map (fun _ -> ()) dir)) Lwt.return (Some (RPC_directory.map (fun _ -> ()) dir))
let heads node = let heads node =
let net_state = Net_validator.net_state node.mainnet_validator in let net_state = Net_validator.net_state node.mainnet_validator in
@ -627,7 +627,7 @@ module RPC = struct
] ]
end in end in
let shutdown () = Lwt_watcher.shutdown stopper in let shutdown () = Lwt_watcher.shutdown stopper in
RPC_server.Answer.{ next ; shutdown } RPC_answer.{ next ; shutdown }
module Network = struct module Network = struct

6
lib_node_shell/node.mli
View File

@ -89,7 +89,7 @@ module RPC : sig
t -> (Protocol_hash.t * Protocol.t) Lwt_stream.t * Lwt_watcher.stopper t -> (Protocol_hash.t * Protocol.t) Lwt_stream.t * Lwt_watcher.stopper
val context_dir: val context_dir:
t -> block -> 'a RPC_server.Directory.t option Lwt.t t -> block -> 'a RPC_directory.t option Lwt.t
val preapply: val preapply:
t -> block -> t -> block ->
@ -98,13 +98,13 @@ module RPC : sig
(Block_header.shell_header * error Preapply_result.t) tzresult Lwt.t (Block_header.shell_header * error Preapply_result.t) tzresult Lwt.t
val context_dir: val context_dir:
t -> block -> 'a RPC_server.Directory.t option Lwt.t t -> block -> 'a RPC_directory.t option Lwt.t
val complete: val complete:
t -> ?block:block -> string -> string list Lwt.t t -> ?block:block -> string -> string list Lwt.t
val bootstrapped: val bootstrapped:
t -> (Block_hash.t * Time.t) RPC_server.Answer.stream t -> (Block_hash.t * Time.t) RPC_answer.stream
module Network : sig module Network : sig

176
lib_node_shell/node_rpc.ml
View File

@ -36,70 +36,70 @@ let monitor_operations node contents =
Lwt.return_some @@ Lwt.return_some @@
List.map (List.map (fun h -> h, None)) hashes List.map (List.map (fun h -> h, None)) hashes
end in end in
RPC_server.Answer.return_stream { next ; shutdown } RPC_answer.return_stream { next ; shutdown }
let register_bi_dir node dir = let register_bi_dir node dir =
let dir = let dir =
let implementation b () include_ops = let implementation b () include_ops =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return (filter_bi include_ops bi) in RPC_answer.return (filter_bi include_ops bi) in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.info implementation in Services.Blocks.info implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.hash in RPC_answer.return bi.hash in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.hash Services.Blocks.hash
implementation in implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.net_id in RPC_answer.return bi.net_id in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.net_id implementation in Services.Blocks.net_id implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.level in RPC_answer.return bi.level in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.level implementation in Services.Blocks.level implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.predecessor in RPC_answer.return bi.predecessor in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.predecessor implementation in Services.Blocks.predecessor implementation in
let dir = let dir =
let implementation b () len = let implementation b () len =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
Node.RPC.predecessors node len bi.hash >>= fun hashes -> Node.RPC.predecessors node len bi.hash >>= fun hashes ->
RPC_server.Answer.return hashes in RPC_answer.return hashes in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.predecessors implementation in Services.Blocks.predecessors implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.fitness in RPC_answer.return bi.fitness in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.fitness implementation in Services.Blocks.fitness implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.timestamp in RPC_answer.return bi.timestamp in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.timestamp implementation in Services.Blocks.timestamp implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.protocol in RPC_answer.return bi.protocol in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.protocol implementation in Services.Blocks.protocol implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.block_info node b >>= fun bi -> Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.test_network in RPC_answer.return bi.test_network in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.test_network implementation in Services.Blocks.test_network implementation in
let dir = let dir =
let implementation b () { Node_rpc_services.Blocks.contents ; monitor } = 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 -> Node.RPC.operation_hashes node b >>= fun hashes ->
if contents then if contents then
Node.RPC.operations node b >>= fun ops -> 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 List.map2 (List.map2 (fun h op -> h, Some op)) hashes ops
else else
RPC_server.Answer.return @@ RPC_answer.return @@
List.map (List.map (fun h -> h, None)) hashes List.map (List.map (fun h -> h, None)) hashes
in in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.operations implementation in Services.Blocks.operations implementation in
let dir = let dir =
let implementation b () () = let implementation b () () =
Node.RPC.pending_operations node b >>= fun res -> Node.RPC.pending_operations node b >>= fun res ->
RPC_server.Answer.return res in RPC_answer.return res in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.pending_operations Services.Blocks.pending_operations
implementation in implementation in
let dir = let dir =
@ -133,15 +133,15 @@ let register_bi_dir node dir =
Node.RPC.preapply node b Node.RPC.preapply node b
~timestamp ~proto_header ~sort_operations operations >>= function ~timestamp ~proto_header ~sort_operations operations >>= function
| Ok (shell_header, operations) -> | Ok (shell_header, operations) ->
RPC_server.Answer.return RPC_answer.return
(Ok { Services.Blocks.shell_header ; operations }) (Ok { Services.Blocks.shell_header ; operations })
| Error _ as err -> RPC_server.Answer.return err in | Error _ as err -> RPC_answer.return err in
RPC_server.Directory.register1 dir RPC_directory.register1 dir
Services.Blocks.preapply implementation in Services.Blocks.preapply implementation in
dir dir
let ops_dir _node = let ops_dir _node =
let ops_dir = RPC_server.Directory.empty in let ops_dir = RPC_directory.empty in
ops_dir ops_dir
let rec insert_future_block (bi: Services.Blocks.block_info) = function let rec insert_future_block (bi: Services.Blocks.block_info) = function
@ -304,7 +304,7 @@ let list_blocks
List.map List.map
(List.map (filter_bi include_ops)) (List.map (filter_bi include_ops))
requested_blocks in requested_blocks in
RPC_server.Answer.return infos RPC_answer.return infos
else begin else begin
let (bi_stream, stopper) = Node.RPC.block_watcher node in let (bi_stream, stopper) = Node.RPC.block_watcher node in
let stream = let stream =
@ -326,12 +326,12 @@ let list_blocks
List.map (List.map (filter_bi include_ops)) requested_blocks in List.map (List.map (filter_bi include_ops)) requested_blocks in
Lwt.return (Some infos) Lwt.return (Some infos)
end in end in
RPC_server.Answer.return_stream { next ; shutdown } RPC_answer.return_stream { next ; shutdown }
end end
let list_invalid node () () = let list_invalid node () () =
Node.RPC.list_invalid node >>= fun l -> 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 list_protocols node () {Services.Protocols.monitor; contents} =
let monitor = match monitor with None -> false | Some x -> x in 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)) Lwt.return (hash, None))
protocols >>= fun protocols -> protocols >>= fun protocols ->
if not monitor then if not monitor then
RPC_server.Answer.return protocols RPC_answer.return protocols
else else
let stream, stopper = Node.RPC.protocol_watcher node in let stream, stopper = Node.RPC.protocol_watcher node in
let shutdown () = Lwt_watcher.shutdown stopper in let shutdown () = Lwt_watcher.shutdown stopper in
@ -362,20 +362,20 @@ let list_protocols node () {Services.Protocols.monitor; contents} =
first_request := false ; first_request := false ;
Lwt.return (Some protocols) Lwt.return (Some protocols)
end in end in
RPC_server.Answer.return_stream { next ; shutdown } RPC_answer.return_stream { next ; shutdown }
let get_protocols node hash () () = let get_protocols node hash () () =
Node.RPC.protocol_content node hash >>= function Node.RPC.protocol_content node hash >>= function
| Ok bytes -> RPC_server.Answer.return bytes | Ok bytes -> RPC_answer.return bytes
| Error _ -> raise Not_found | Error _ -> raise Not_found
let build_rpc_directory node = let build_rpc_directory node =
let dir = RPC_server.Directory.empty in let dir = RPC_directory.empty in
let dir = let dir =
RPC_server.Directory.register0 dir Services.Blocks.list RPC_directory.register0 dir Services.Blocks.list
(list_blocks node) in (list_blocks node) in
let dir = let dir =
RPC_server.Directory.register0 dir Services.Blocks.list_invalid RPC_directory.register0 dir Services.Blocks.list_invalid
(list_invalid node) in (list_invalid node) in
let dir = register_bi_dir node dir in let dir = register_bi_dir node dir in
let dir = let dir =
@ -384,23 +384,23 @@ let build_rpc_directory node =
Node.RPC.context_dir node block >>= function Node.RPC.context_dir node block >>= function
| None -> Lwt.fail Not_found | None -> Lwt.fail Not_found
| Some context_dir -> Lwt.return context_dir) | Some context_dir -> Lwt.return context_dir)
(fun _ -> Lwt.return RPC_server.Directory.empty) in (fun _ -> Lwt.return RPC_directory.empty) in
RPC_server.Directory.register_dynamic_directory1 RPC_directory.register_dynamic_directory1
~descr: ~descr:
"All the RPCs which are specific to the protocol version." "All the RPCs which are specific to the protocol version."
dir Services.Blocks.proto_path implementation in dir Services.Blocks.proto_path implementation in
let dir = let dir =
RPC_server.Directory.register0 dir Services.Protocols.list RPC_directory.register0 dir Services.Protocols.list
(list_protocols node) in (list_protocols node) in
let dir = let dir =
RPC_server.Directory.register1 dir Services.Protocols.contents RPC_directory.register1 dir Services.Protocols.contents
(get_protocols node) in (get_protocols node) in
let dir = let dir =
let implementation () header = let implementation () header =
let res = let res =
Data_encoding.Binary.to_bytes Block_header.encoding header in Data_encoding.Binary.to_bytes Block_header.encoding header in
RPC_server.Answer.return res in RPC_answer.return res in
RPC_server.Directory.register0 dir Services.forge_block_header RPC_directory.register0 dir Services.forge_block_header
implementation in implementation in
let dir = let dir =
let implementation () let implementation ()
@ -410,88 +410,88 @@ let build_rpc_directory node =
node ~force node ~force
raw operations >>=? fun (hash, wait) -> raw operations >>=? fun (hash, wait) ->
(if blocking then wait else return ()) >>=? fun () -> return hash (if blocking then wait else return ()) >>=? fun () -> return hash
end >>= RPC_server.Answer.return in end >>= RPC_answer.return in
RPC_server.Directory.register0 dir Services.inject_block implementation in RPC_directory.register0 dir Services.inject_block implementation in
let dir = let dir =
let implementation () (contents, blocking, net_id, force) = let implementation () (contents, blocking, net_id, force) =
Node.RPC.inject_operation Node.RPC.inject_operation
node ?force ?net_id contents >>= fun (hash, wait) -> node ?force ?net_id contents >>= fun (hash, wait) ->
begin begin
(if blocking then wait else return ()) >>=? fun () -> return hash (if blocking then wait else return ()) >>=? fun () -> return hash
end >>= RPC_server.Answer.return in end >>= RPC_answer.return in
RPC_server.Directory.register0 dir Services.inject_operation implementation in RPC_directory.register0 dir Services.inject_operation implementation in
let dir = let dir =
let implementation () (proto, blocking, force) = let implementation () (proto, blocking, force) =
Node.RPC.inject_protocol ?force node proto >>= fun (hash, wait) -> Node.RPC.inject_protocol ?force node proto >>= fun (hash, wait) ->
begin begin
(if blocking then wait else return ()) >>=? fun () -> return hash (if blocking then wait else return ()) >>=? fun () -> return hash
end >>= RPC_server.Answer.return in end >>= RPC_answer.return in
RPC_server.Directory.register0 dir Services.inject_protocol implementation in RPC_directory.register0 dir Services.inject_protocol implementation in
let dir = let dir =
let implementation () () = let implementation () () =
RPC_server.Answer.return_stream (Node.RPC.bootstrapped node) in RPC_answer.return_stream (Node.RPC.bootstrapped node) in
RPC_server.Directory.register0 dir Services.bootstrapped implementation in RPC_directory.register0 dir Services.bootstrapped implementation in
let dir = let dir =
let implementation () () = let implementation () () =
RPC_server.Answer.return RPC_answer.return
Data_encoding.Json.(schema Error_monad.error_encoding) in 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 = let dir =
RPC_server.Directory.register1 dir Services.complete RPC_directory.register1 dir Services.complete
(fun s () () -> (fun s () () ->
Node.RPC.complete node s >>= RPC_server.Answer.return) in Node.RPC.complete node s >>= RPC_answer.return) in
let dir = let dir =
RPC_server.Directory.register2 dir Services.Blocks.complete RPC_directory.register2 dir Services.Blocks.complete
(fun block s () () -> (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 *) (* Network : Global *)
let dir = let dir =
let implementation () () = let implementation () () =
Node.RPC.Network.stat node |> RPC_server.Answer.return in Node.RPC.Network.stat node |> RPC_answer.return in
RPC_server.Directory.register0 dir Services.Network.stat implementation in RPC_directory.register0 dir Services.Network.stat implementation in
let dir = let dir =
let implementation () () = let implementation () () =
RPC_server.Answer.return Distributed_db.Raw.supported_versions in RPC_answer.return Distributed_db.Raw.supported_versions in
RPC_server.Directory.register0 dir Services.Network.versions implementation in RPC_directory.register0 dir Services.Network.versions implementation in
let dir = let dir =
let implementation () () = let implementation () () =
let stream, stopper = Node.RPC.Network.watch node in let stream, stopper = Node.RPC.Network.watch node in
let shutdown () = Lwt_watcher.shutdown stopper in let shutdown () = Lwt_watcher.shutdown stopper in
let next () = Lwt_stream.get stream in let next () = Lwt_stream.get stream in
RPC_server.Answer.return_stream { next ; shutdown } in RPC_answer.return_stream { next ; shutdown } in
RPC_server.Directory.register0 dir Services.Network.events implementation in RPC_directory.register0 dir Services.Network.events implementation in
let dir = let dir =
let implementation point () timeout = let implementation point () timeout =
Node.RPC.Network.connect node point timeout >>= RPC_server.Answer.return in Node.RPC.Network.connect node point timeout >>= RPC_answer.return in
RPC_server.Directory.register1 dir Services.Network.connect implementation in RPC_directory.register1 dir Services.Network.connect implementation in
(* Network : Connection *) (* Network : Connection *)
let dir = let dir =
let implementation peer_id () () = let implementation peer_id () () =
Node.RPC.Network.Connection.info node peer_id |> RPC_server.Answer.return in Node.RPC.Network.Connection.info node peer_id |> RPC_answer.return in
RPC_server.Directory.register1 dir Services.Network.Connection.info implementation in RPC_directory.register1 dir Services.Network.Connection.info implementation in
let dir = let dir =
let implementation peer_id () wait = let implementation peer_id () wait =
Node.RPC.Network.Connection.kick node peer_id wait >>= RPC_server.Answer.return in Node.RPC.Network.Connection.kick node peer_id wait >>= RPC_answer.return in
RPC_server.Directory.register1 dir Services.Network.Connection.kick implementation in RPC_directory.register1 dir Services.Network.Connection.kick implementation in
let dir = let dir =
let implementation () () = let implementation () () =
Node.RPC.Network.Connection.list node |> RPC_server.Answer.return in Node.RPC.Network.Connection.list node |> RPC_answer.return in
RPC_server.Directory.register0 dir Services.Network.Connection.list implementation in RPC_directory.register0 dir Services.Network.Connection.list implementation in
(* Network : Peer_id *) (* Network : Peer_id *)
let dir = let dir =
let implementation () state = let implementation () state =
Node.RPC.Network.Peer_id.list node ~restrict:state |> RPC_server.Answer.return in Node.RPC.Network.Peer_id.list node ~restrict:state |> RPC_answer.return in
RPC_server.Directory.register0 dir Services.Network.Peer_id.list implementation in RPC_directory.register0 dir Services.Network.Peer_id.list implementation in
let dir = let dir =
let implementation peer_id () () = let implementation peer_id () () =
Node.RPC.Network.Peer_id.info node peer_id |> RPC_server.Answer.return in Node.RPC.Network.Peer_id.info node peer_id |> RPC_answer.return in
RPC_server.Directory.register1 dir Services.Network.Peer_id.info implementation in RPC_directory.register1 dir Services.Network.Peer_id.info implementation in
let dir = let dir =
let implementation peer_id () monitor = let implementation peer_id () monitor =
if monitor then if monitor then
@ -505,21 +505,21 @@ let build_rpc_directory node =
first_request := false ; first_request := false ;
Lwt.return_some @@ Node.RPC.Network.Peer_id.events node peer_id Lwt.return_some @@ Node.RPC.Network.Peer_id.events node peer_id
end in end in
RPC_server.Answer.return_stream { next ; shutdown } RPC_answer.return_stream { next ; shutdown }
else else
Node.RPC.Network.Peer_id.events node peer_id |> RPC_server.Answer.return in Node.RPC.Network.Peer_id.events node peer_id |> RPC_answer.return in
RPC_server.Directory.register1 dir Services.Network.Peer_id.events implementation in RPC_directory.register1 dir Services.Network.Peer_id.events implementation in
(* Network : Point *) (* Network : Point *)
let dir = let dir =
let implementation () state = let implementation () state =
Node.RPC.Network.Point.list node ~restrict:state |> RPC_server.Answer.return in Node.RPC.Network.Point.list node ~restrict:state |> RPC_answer.return in
RPC_server.Directory.register0 dir Services.Network.Point.list implementation in RPC_directory.register0 dir Services.Network.Point.list implementation in
let dir = let dir =
let implementation point () () = let implementation point () () =
Node.RPC.Network.Point.info node point |> RPC_server.Answer.return in Node.RPC.Network.Point.info node point |> RPC_answer.return in
RPC_server.Directory.register1 dir Services.Network.Point.info implementation in RPC_directory.register1 dir Services.Network.Point.info implementation in
let dir = let dir =
let implementation point () monitor = let implementation point () monitor =
if monitor then if monitor then
@ -533,10 +533,10 @@ let build_rpc_directory node =
first_request := false ; first_request := false ;
Lwt.return_some @@ Node.RPC.Network.Point.events node point Lwt.return_some @@ Node.RPC.Network.Point.events node point
end in end in
RPC_server.Answer.return_stream { next ; shutdown } RPC_answer.return_stream { next ; shutdown }
else else
Node.RPC.Network.Point.events node point |> RPC_server.Answer.return in Node.RPC.Network.Point.events node point |> RPC_answer.return in
RPC_server.Directory.register1 dir Services.Network.Point.events implementation in RPC_directory.register1 dir Services.Network.Point.events implementation in
let dir = let dir =
RPC_server.Directory.register_describe_directory_service dir Services.describe in RPC_directory.register_describe_directory_service dir Services.describe in
dir dir

2
lib_node_shell/node_rpc.mli
View File

@ -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

10
lib_node_updater/tezos_protocol_environment.ml
View File

@ -56,10 +56,12 @@ module Make(Param : sig val name: string end)() = struct
module Block_header = Block_header module Block_header = Block_header
module Protocol = Protocol module Protocol = Protocol
end end
module RPC = struct module RPC_arg = RPC_arg
include RPC module RPC_path = RPC_path
include RPC_server module RPC_query = RPC_query
end module RPC_service = RPC_service
module RPC_answer = RPC_answer
module RPC_directory = RPC_directory
module Micheline = Tezos_micheline.Micheline module Micheline = Tezos_micheline.Micheline
module Fitness = Fitness module Fitness = Fitness
module Error_monad = struct module Error_monad = struct

4
lib_node_updater/updater.ml
View File

@ -108,7 +108,7 @@ module Node_protocol_environment_sigs = struct
and type Tezos_data.Operation.t = Operation.t 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.shell_header = Block_header.shell_header
and type Tezos_data.Block_header.t = Block_header.t 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.validation_result = validation_result
and type Updater.rpc_context = rpc_context and type Updater.rpc_context = rpc_context
@ -153,7 +153,7 @@ module type RAW_PROTOCOL = sig
validation_state -> operation -> validation_state tzresult Lwt.t validation_state -> operation -> validation_state tzresult Lwt.t
val finalize_block: val finalize_block:
validation_state -> validation_result tzresult Lwt.t 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: val configure_sandbox:
Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
end end

4
lib_node_updater/updater.mli
View File

@ -67,7 +67,7 @@ module type RAW_PROTOCOL = sig
validation_state -> operation -> validation_state tzresult Lwt.t validation_state -> operation -> validation_state tzresult Lwt.t
val finalize_block: val finalize_block:
validation_state -> validation_result tzresult Lwt.t 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: val configure_sandbox:
Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t
end end
@ -98,7 +98,7 @@ module Node_protocol_environment_sigs : sig
and type Tezos_data.Operation.t = Operation.t 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.shell_header = Block_header.shell_header
and type Tezos_data.Block_header.t = Block_header.t 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.validation_result = validation_result
and type Updater.rpc_context = rpc_context and type Updater.rpc_context = rpc_context

7
lib_protocol_environment_sigs/jbuild
View File

@ -40,7 +40,12 @@
;; Tezos specifics ;; Tezos specifics
v1/tezos_data.mli v1/tezos_data.mli
v1/context.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 v1/updater.mli
)) ))

290
lib_protocol_environment_sigs/v1/RPC.mli
View File

@ -1,290 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

29
lib_protocol_environment_sigs/v1/RPC_answer.mli Normal file
View File

@ -0,0 +1,29 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

28
lib_protocol_environment_sigs/v1/RPC_arg.mli Normal file
View File

@ -0,0 +1,28 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

77
lib_protocol_environment_sigs/v1/RPC_directory.mli Normal file
View File

@ -0,0 +1,77 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

36
lib_protocol_environment_sigs/v1/RPC_path.mli Normal file
View File

@ -0,0 +1,36 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

38
lib_protocol_environment_sigs/v1/RPC_query.mli Normal file
View File

@ -0,0 +1,38 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

100
lib_protocol_environment_sigs/v1/RPC_service.mli Normal file
View File

@ -0,0 +1,100 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

2
lib_protocol_environment_sigs/v1/updater.mli
View File

@ -132,7 +132,7 @@ module type PROTOCOL = sig
validation_state -> validation_result tzresult Lwt.t validation_state -> validation_result tzresult Lwt.t
(** The list of remote procedures exported by this implementation *) (** 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 (** An ad-hoc context patcher. It used only for debugging protocol
while running in the "sandbox" mode. This function is never used while running in the "sandbox" mode. This function is never used

3
vendors/ocplib-resto/lib_resto/resto.mli vendored
View File

@ -14,7 +14,8 @@ val string_of_meth: [< meth ] -> string
val meth_of_string: string -> [> meth ] option val meth_of_string: string -> [> meth ] option
module MethMap : Map.S with type key = meth 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. *) (** Typed path argument. *)
module Arg : sig module Arg : sig