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

RPC: remove deprecated function RPC.register*

Browse Source
This commit is contained in:
Grégoire Henry 2017-12-07 17:43:21 +01:00 committed by Benjamin Canou
parent f4c19694e0
commit e57a0734e5
6 changed files with 183 additions and 222 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

175
lib_embedded_protocol_alpha/src/services_registration.ml
View File

@ -30,31 +30,31 @@ let rpc_services = ref (RPC.Directory.empty : Updater.rpc_context RPC.Directory.
let register0_fullctxt s f =
rpc_services :=
RPC.register !rpc_services (s RPC.Path.open_root)
(fun ctxt () ->
RPC.Directory.register !rpc_services (s RPC.Path.open_root)
(fun ctxt q () ->
( rpc_init ctxt >>=? fun ctxt ->
f ctxt ) >>= RPC.Answer.return)
let register0 s f = register0_fullctxt s (fun { context } -> f context)
f ctxt q) >>= RPC.Answer.return)
let register0 s f = register0_fullctxt s (fun { context ; _ } -> f context)
let register1_fullctxt s f =
rpc_services :=
RPC.register !rpc_services (s RPC.Path.open_root)
(fun ctxt arg ->
RPC.Directory.register !rpc_services (s RPC.Path.open_root)
(fun ctxt q arg ->
( rpc_init ctxt >>=? fun ctxt ->
f ctxt arg ) >>= RPC.Answer.return)
let register1 s f = register1_fullctxt s (fun { context } x -> f context x)
f ctxt q arg ) >>= RPC.Answer.return)
let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x)
let register1_noctxt s f =
rpc_services :=
RPC.register !rpc_services (s RPC.Path.open_root)
(fun _ arg -> f arg >>= RPC.Answer.return)
RPC.Directory.register !rpc_services (s RPC.Path.open_root)
(fun _ q arg -> f q arg >>= RPC.Answer.return)
let register2_fullctxt s f =
rpc_services :=
RPC.register !rpc_services (s RPC.Path.open_root)
(fun (ctxt, arg1) arg2 ->
RPC.Directory.register !rpc_services (s RPC.Path.open_root)
(fun (ctxt, arg1) q arg2 ->
( rpc_init ctxt >>=? fun ctxt ->
f ctxt arg1 arg2 ) >>= RPC.Answer.return)
let register2 s f = register2_fullctxt s (fun { context } x y -> f context x y)
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)
(*-- Operations --------------------------------------------------------------*)
@ -62,7 +62,7 @@ let register2 s f = register2_fullctxt s (fun { context } x y -> f context x y)
let () =
register0_fullctxt
Services.operations
(fun { operation_hashes ; operations } ->
(fun { operation_hashes ; operations ; _ } () ->
operation_hashes () >>= fun operation_hashes ->
operations () >>= fun operations ->
map2_s
@ -72,29 +72,29 @@ let () =
let () =
register0_fullctxt
Services.header
(fun { block_header } ->
(fun { block_header ; _ } () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header) ;
register0_fullctxt
Services.Header.priority
(fun { block_header } ->
(fun { block_header ; _ } () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.priority) ;
register0_fullctxt
Services.Header.seed_nonce_hash
(fun { block_header } ->
(fun { block_header ; _ } () ->
Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
return block_header.proto.seed_nonce_hash)
(*-- Constants ---------------------------------------------------------------*)
let cycle_length ctxt =
let cycle_length ctxt () =
return @@ Constants.cycle_length ctxt
let () = register0 Services.Constants.cycle_length cycle_length
let voting_period_length ctxt =
let voting_period_length ctxt () =
return @@ Constants.voting_period_length ctxt
let () =
@ -102,50 +102,52 @@ let () =
Services.Constants.voting_period_length
voting_period_length
let time_before_reward ctxt =
let time_before_reward ctxt () =
return @@ Constants.time_before_reward ctxt
let () = register0 Services.Constants.time_before_reward time_before_reward
let slot_durations ctxt =
let slot_durations ctxt () =
return @@ Constants.slot_durations ctxt
let () = register0 Services.Constants.slot_durations slot_durations
let first_free_baking_slot ctxt =
let first_free_baking_slot ctxt () =
return @@ Constants.first_free_baking_slot ctxt
let () =
register0 Services.Constants.first_free_baking_slot first_free_baking_slot
let max_signing_slot ctxt =
let max_signing_slot ctxt () =
return @@ Constants.max_signing_slot ctxt
let () = register0 Services.Constants.max_signing_slot max_signing_slot
let instructions_per_transaction ctxt =
let instructions_per_transaction ctxt () =
return @@ Constants.instructions_per_transaction ctxt
let () =
register0
Services.Constants.instructions_per_transaction instructions_per_transaction
Services.Constants.instructions_per_transaction
instructions_per_transaction
let proof_of_work_threshold ctxt =
let proof_of_work_threshold ctxt () =
return @@ Constants.proof_of_work_threshold ctxt
let () =
register0 Services.Constants.proof_of_work_threshold proof_of_work_threshold
register0 Services.Constants.proof_of_work_threshold
proof_of_work_threshold
let () =
register1_noctxt Services.Constants.errors
(fun () ->
(fun () () ->
Lwt.return (Data_encoding.Json.(schema error_encoding)))
(*-- Context -----------------------------------------------------------------*)
type error += Unexpected_level_in_context
let level ctxt =
let level ctxt () =
let level = Level.current ctxt in
match Level.pred ctxt level with
| None -> fail Unexpected_level_in_context
@ -153,64 +155,68 @@ let level ctxt =
let () = register0 Services.Context.level level
let next_level ctxt =
let next_level ctxt () =
return (Level.current ctxt)
let () = register0 Services.Context.next_level next_level
let roll_value ctxt =
return (Roll.value ctxt)
let () = register0 Services.Context.roll_value roll_value
let () = register0 Services.Context.next_roll Roll.next
let () =
register0 Services.Context.next_level next_level
let () =
register0 Services.Context.voting_period_kind Vote.get_current_period_kind
register0 Services.Context.roll_value
(fun ctxt () -> return (Roll.value ctxt))
let () =
register0 Services.Context.next_roll
(fun ctxt () -> Roll.next ctxt)
let () =
register0 Services.Context.voting_period_kind
(fun ctxt () -> Vote.get_current_period_kind ctxt)
(*-- Context.Nonce -----------------------------------------------------------*)
let nonce ctxt raw_level () =
let nonce ctxt () raw_level () =
let level = Level.from_raw ctxt raw_level in
Nonce.get ctxt level >>= function
| Ok (Revealed nonce) -> return (Services.Context.Nonce.Revealed nonce)
| Ok (Unrevealed { nonce_hash }) ->
| Ok (Unrevealed { nonce_hash ; _ }) ->
return (Services.Context.Nonce.Missing nonce_hash)
| Error _ -> return Services.Context.Nonce.Forgotten
let () = register2 Services.Context.Nonce.get nonce
let nonce_hash ctxt =
level ctxt >>=? fun level ->
let nonce_hash ctxt () =
level ctxt () >>=? fun level ->
Nonce.get ctxt level >>=? function
| Unrevealed { nonce_hash } -> return nonce_hash
| Unrevealed { nonce_hash ; _ } -> return nonce_hash
| _ -> assert false
let () = register0 Services.Context.Nonce.hash nonce_hash
(*-- Context.Key -------------------------------------------------------------*)
let get_key ctxt hash () =
let get_key ctxt () hash () =
Delegates_pubkey.get ctxt hash >>=? fun pk ->
return (hash, pk)
let () = register2 Services.Context.Key.get get_key
let () =
register0 Services.Context.Key.list
(fun t -> Delegates_pubkey.list t >>= return)
(fun t () -> Delegates_pubkey.list t >>= return)
(*-- Context.Contract --------------------------------------------------------*)
let () =
register0 Services.Context.Contract.list
(fun ctxt -> Contract.list ctxt >>= return)
(fun ctxt () -> Contract.list ctxt >>= return)
let () =
let register2 s f =
rpc_services :=
RPC.register !rpc_services (s RPC.Path.open_root)
(fun (ctxt, contract) arg ->
( rpc_init ctxt >>=? fun { context = ctxt } ->
RPC.Directory.register !rpc_services (s RPC.Path.open_root)
(fun (ctxt, contract) () arg ->
( rpc_init ctxt >>=? fun { context = ctxt ; _ } ->
Contract.exists ctxt contract >>=? function
| true -> f ctxt contract arg
| false -> raise Not_found ) >>= RPC.Answer.return) in
@ -244,14 +250,14 @@ let minimal_timestamp ctxt prio =
let () = register1
Services.Helpers.minimal_timestamp
(fun ctxt slot ->
(fun ctxt () slot ->
let timestamp = Tezos_context.Timestamp.current ctxt in
minimal_timestamp ctxt slot timestamp)
let () =
(* ctxt accept_failing_script baker_contract pred_block block_prio operation *)
register1 Services.Helpers.apply_operation
(fun ctxt (pred_block, hash, forged_operation, signature) ->
(fun ctxt () (pred_block, hash, forged_operation, signature) ->
match Data_encoding.Binary.of_bytes
Operation.unsigned_operation_encoding
forged_operation with
@ -284,7 +290,7 @@ let () =
(Operation_hash.hash_string [ "FAKE " ; "FAKE" ; "FAKE" ]) in
(script, storage, input, amount, contract, qta, origination_nonce) in
register1 Services.Helpers.run_code
(fun ctxt parameters ->
(fun ctxt () parameters ->
let (code, storage, input, amount, contract, qta, origination_nonce) =
run_parameters ctxt parameters in
Script_interpreter.execute
@ -295,7 +301,7 @@ let () =
qta >>=? fun (sto, ret, _qta, _ctxt, _) ->
Error_monad.return (sto, ret)) ;
register1 Services.Helpers.trace_code
(fun ctxt parameters ->
(fun ctxt () parameters ->
let (code, storage, input, amount, contract, qta, origination_nonce) =
run_parameters ctxt parameters in
Script_interpreter.trace
@ -308,28 +314,27 @@ let () =
let () =
register1 Services.Helpers.typecheck_code
Script_ir_translator.typecheck_code
(fun ctxt () -> Script_ir_translator.typecheck_code ctxt)
let () =
register1 Services.Helpers.typecheck_data
Script_ir_translator.typecheck_data
(fun ctxt () -> Script_ir_translator.typecheck_data ctxt)
let () =
register1 Services.Helpers.hash_data
(fun _ctxt expr -> return (Script.hash_expr expr))
(fun _ctxt () expr -> return (Script.hash_expr expr))
let compute_level ctxt raw offset =
return (Level.from_raw ctxt ?offset raw)
let () =
register2 Services.Helpers.level
(fun ctxt () raw offset -> return (Level.from_raw ctxt ?offset raw))
let () = register2 Services.Helpers.level compute_level
let levels ctxt cycle () =
let levels = Level.levels_in_cycle ctxt cycle in
let first = List.hd (List.rev levels) in
let last = List.hd levels in
return (first.level, last.level)
let () = register2 Services.Helpers.levels levels
let () =
register2 Services.Helpers.levels
(fun ctxt () cycle () ->
let levels = Level.levels_in_cycle ctxt cycle in
let first = List.hd (List.rev levels) in
let last = List.hd levels in
return (first.level, last.level))
(*-- Helpers.Rights ----------------------------------------------------------*)
@ -357,7 +362,7 @@ let baking_rights ctxt level max =
let () =
register1 Services.Helpers.Rights.baking_rights
(fun ctxt max ->
(fun ctxt () max ->
let level = Level.current ctxt in
baking_rights ctxt level max >>=? fun (raw_level, slots) ->
begin
@ -374,12 +379,12 @@ let () =
let () =
register2 Services.Helpers.Rights.baking_rights_for_level
(fun ctxt raw_level max ->
(fun ctxt () raw_level max ->
let level = Level.from_raw ctxt raw_level in
baking_rights ctxt level max)
let baking_rights_for_delegate
ctxt contract (max_priority, min_level, max_level) =
ctxt () contract (max_priority, min_level, max_level) =
let max_priority = default_max_baking_priority ctxt max_priority in
let current_level = Level.current ctxt in
let min_level = match min_level with
@ -436,16 +441,16 @@ let endorsement_rights ctxt level max =
let () =
register1 Services.Helpers.Rights.endorsement_rights
(fun ctxt max ->
(fun ctxt () max ->
let level = Level.current ctxt in
endorsement_rights ctxt (Level.succ ctxt level) max) ;
register2 Services.Helpers.Rights.endorsement_rights_for_level
(fun ctxt raw_level max ->
(fun ctxt () raw_level max ->
let level = Level.from_raw ctxt raw_level in
endorsement_rights ctxt level max)
let endorsement_rights_for_delegate
ctxt contract (max_priority, min_level, max_level) =
ctxt () contract (max_priority, min_level, max_level) =
let current_level = Level.current ctxt in
let max_priority = default_max_endorsement_priority ctxt max_priority in
let min_level = match min_level with
@ -482,7 +487,7 @@ let operation_public_key ctxt = function
| None -> return (Some public_key)
| Some _ -> return None
let forge_operations _ctxt (shell, proto) =
let forge_operations _ctxt () (shell, proto) =
return (Operation.forge shell proto)
let () = register1 Services.Helpers.Forge.operations forge_operations
@ -493,7 +498,8 @@ let forge_block_proto_header _ctxt
{ priority ; seed_nonce_hash ; proof_of_work_nonce })
let () =
register1 Services.Helpers.Forge.block_proto_header forge_block_proto_header
register1 Services.Helpers.Forge.block_proto_header
(fun ctxt () -> forge_block_proto_header ctxt)
(*-- Helpers.Parse -----------------------------------------------------------*)
@ -512,7 +518,7 @@ let check_signature ctxt signature shell contents =
end >>=? fun public_key ->
Operation.check_signature public_key
{ signature ; shell ; contents ; hash = dummy_hash }
| Sourced_operations (Delegate_operations { source }) ->
| Sourced_operations (Delegate_operations { source ; _ }) ->
Operation.check_signature source
{ signature ; shell ; contents ; hash = dummy_hash }
| Sourced_operations (Dictator_operation _) ->
@ -520,7 +526,7 @@ let check_signature ctxt signature shell contents =
Operation.check_signature key
{ signature ; shell ; contents ; hash = dummy_hash }
let parse_operations ctxt (operations, check) =
let parse_operations ctxt () (operations, check) =
map_s begin fun raw ->
begin
Lwt.return
@ -532,13 +538,14 @@ let parse_operations ctxt (operations, check) =
end
end operations
let () = register1 Services.Helpers.Parse.operations parse_operations
let () =
register1 Services.Helpers.Parse.operations parse_operations
let parse_block _ctxt raw_block =
Lwt.return (Block_header.parse raw_block) >>=? fun { proto } ->
return proto
let () = register1 Services.Helpers.Parse.block parse_block
let () =
register1 Services.Helpers.Parse.block
(fun _ctxt () raw_block ->
Lwt.return (Block_header.parse raw_block) >>=? fun { proto ; _ } ->
return proto)
(*****)

11
lib_embedded_protocol_demo/src/services.ml
View File

@ -49,18 +49,17 @@ let failing_service custom_root =
~error: Data_encoding.empty
RPC.Path.(custom_root / "failing")
let rpc_services : Updater.rpc_context RPC.Directory.t =
let dir = RPC.Directory.empty in
let rpc_services : Updater.rpc_context RPC.Directory.t = let dir = RPC.Directory.empty in
let dir =
RPC.register
RPC.Directory.register
dir
(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
let dir =
RPC.register
RPC.Directory.register
dir
(echo_service RPC.Path.open_root)
(fun _ctxt x -> RPC.Answer.return x)
(fun _ctxt () x -> RPC.Answer.return x)
in
dir

6
lib_embedded_protocol_genesis/src/services.ml
View File

@ -63,11 +63,11 @@ let operations_hash =
let rpc_services : Updater.rpc_context RPC.Directory.t =
let dir = RPC.Directory.empty in
let dir =
RPC.register
RPC.Directory.register
dir
(Forge.block RPC.Path.open_root)
(fun _ctxt ((_net_id, level, proto_level, predecessor,
timestamp, fitness), command) ->
(fun _ctxt () ((_net_id, level, proto_level, predecessor,
timestamp, fitness), command) ->
let shell = { Block_header.level ; proto_level ; predecessor ;
timestamp ; fitness ; validation_passes = 0 ; operations_hash } in
let bytes = Data.Command.forge shell command in

16
lib_node_http/RPC_server.ml
View File

@ -47,19 +47,3 @@ let octet_stream = {
| Some data -> Ok data
end ;
}
(* Compatibility layer, to be removed ASAP. *)
let empty = Directory.empty
let register d s f = Directory.register d s (fun p () i -> f p i)
open Directory.Curry
let register0 root s f = register root s (curry Z f)
let register1 root s f = register root s (curry (S Z) f)
let register2 root s f = register root s (curry (S (S Z)) f)
(* let register3 root s f = register root s (curry (S (S (S Z))) f) *)
(* let register4 root s f = register root s (curry (S (S (S (S Z)))) f) *)
(* let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f) *)
let register_dynamic_directory1 =
Directory.register_dynamic_directory1

35
lib_node_http/RPC_server.mli
View File

@ -42,38 +42,3 @@ val launch :
(** Kill an RPC server. *)
val shutdown : server -> unit Lwt.t
(** Compatibility layer, to be removed ASAP. *)
val register:
'prefix Directory.t ->
([`POST], 'prefix, 'params, unit, 'input, 'output, unit) RPC.Service.t ->
('params -> 'input -> [< ('output, unit) RestoDirectory.Answer.t ] Lwt.t) ->
'prefix Directory.t
val register0:
unit Directory.t ->
([`POST], unit, unit, unit, 'i, 'o, unit) RPC.Service.t ->
('i -> [< ('o, unit) Answer.t ] Lwt.t) ->
unit Directory.t
val register1:
'prefix Directory.t ->
([`POST], 'prefix, unit * 'a, unit, 'i, 'o, unit) RPC.Service.t ->
('a -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
'prefix Directory.t
val register2:
'prefix Directory.t ->
([`POST], 'prefix, (unit * 'a) * 'b, unit, 'i, 'o, unit) RPC.Service.t ->
('a -> 'b -> 'i -> [< ('o, unit) Answer.t ] Lwt.t) ->
'prefix Directory.t
val register_dynamic_directory1:
?descr:string ->
'prefix Directory.t ->
('prefix, unit * 'a) RPC.Path.path ->
('a -> (unit * 'a) Directory.t Lwt.t) ->
'prefix Directory.t

162
lib_node_shell/node_rpc.ml
View File

@ -40,69 +40,69 @@ let monitor_operations node contents =
let register_bi_dir node dir =
let dir =
let implementation b include_ops =
let implementation b () include_ops =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return (filter_bi include_ops bi) in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.info implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.hash in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.hash
implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.net_id in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.net_id implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.level in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.level implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.predecessor in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.predecessor implementation in
let dir =
let implementation b len =
let implementation b () len =
Node.RPC.block_info node b >>= fun bi ->
Node.RPC.predecessors node len bi.hash >>= fun hashes ->
RPC_server.Answer.return hashes in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.predecessors implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.fitness in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.fitness implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.timestamp in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.timestamp implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.protocol in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.protocol implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_server.Answer.return bi.test_network in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.test_network implementation in
let dir =
let implementation b { Node_rpc_services.Blocks.contents ; monitor } =
let implementation b () { Node_rpc_services.Blocks.contents ; monitor } =
match b with
| `Prevalidation when monitor ->
monitor_operations node contents
@ -116,26 +116,27 @@ let register_bi_dir node dir =
RPC_server.Answer.return @@
List.map (List.map (fun h -> h, None)) hashes
in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.operations implementation in
let dir =
let implementation b () =
let implementation b () () =
Node.RPC.pending_operations node b >>= fun res ->
RPC_server.Answer.return res in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.pending_operations
implementation in
let dir =
let implementation
b { Services.Blocks.operations ; sort_operations ;
timestamp ; proto_header} =
b ()
{ Services.Blocks.operations ; sort_operations ;
timestamp ; proto_header} =
Node.RPC.preapply node b
~timestamp ~proto_header ~sort_operations operations >>= function
| Ok (shell_header, operations) ->
RPC_server.Answer.return
(Ok { Services.Blocks.shell_header ; operations })
| Error _ as err -> RPC_server.Answer.return err in
RPC_server.register1 dir
RPC_server.Directory.register1 dir
Services.Blocks.preapply implementation in
dir
@ -240,7 +241,7 @@ let create_delayed_stream
stream
let list_blocks
node
node ()
{ Services.Blocks.include_ops ; length ; heads ; monitor ; delay ;
min_date; min_heads} =
let len = match length with None -> 1 | Some x -> x in
@ -328,11 +329,11 @@ let list_blocks
RPC_server.Answer.return_stream { next ; shutdown }
end
let list_invalid node () =
let list_invalid node () () =
Node.RPC.list_invalid node >>= fun l ->
RPC_server.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 include_contents = match contents with None -> false | Some x -> x in
Node.RPC.protocols node >>= fun protocols ->
@ -363,7 +364,7 @@ let list_protocols node {Services.Protocols.monitor; contents} =
end in
RPC_server.Answer.return_stream { next ; shutdown }
let get_protocols node hash () =
let get_protocols node hash () () =
Node.RPC.protocol_content node hash >>= function
| Ok bytes -> RPC_server.Answer.return bytes
| Error _ -> raise Not_found
@ -371,9 +372,11 @@ let get_protocols node hash () =
let build_rpc_directory node =
let dir = RPC_server.Directory.empty in
let dir =
RPC_server.register0 dir Services.Blocks.list (list_blocks node) in
RPC_server.Directory.register0 dir Services.Blocks.list
(list_blocks node) in
let dir =
RPC_server.register0 dir Services.Blocks.list_invalid (list_invalid node) in
RPC_server.Directory.register0 dir Services.Blocks.list_invalid
(list_invalid node) in
let dir = register_bi_dir node dir in
let dir =
let implementation block =
@ -382,22 +385,25 @@ let build_rpc_directory node =
| None -> Lwt.fail Not_found
| Some context_dir -> Lwt.return context_dir)
(fun _ -> Lwt.return RPC_server.Directory.empty) in
RPC_server.register_dynamic_directory1
RPC_server.Directory.register_dynamic_directory1
~descr:
"All the RPCs which are specific to the protocol version."
dir Services.Blocks.proto_path implementation in
let dir =
RPC_server.register0 dir Services.Protocols.list (list_protocols node) in
RPC_server.Directory.register0 dir Services.Protocols.list
(list_protocols node) in
let dir =
RPC_server.register1 dir Services.Protocols.contents (get_protocols node) in
RPC_server.Directory.register1 dir Services.Protocols.contents
(get_protocols node) in
let dir =
let implementation header =
let implementation () header =
let res =
Data_encoding.Binary.to_bytes Block_header.encoding header in
RPC_server.Answer.return res in
RPC_server.register0 dir Services.forge_block_header implementation in
RPC_server.Directory.register0 dir Services.forge_block_header
implementation in
let dir =
let implementation
let implementation ()
{ Node_rpc_services.raw ; blocking ; force ; operations } =
begin
Node.RPC.inject_block
@ -405,89 +411,89 @@ let build_rpc_directory node =
raw operations >>=? fun (hash, wait) ->
(if blocking then wait else return ()) >>=? fun () -> return hash
end >>= RPC_server.Answer.return in
RPC_server.register0 dir Services.inject_block implementation in
RPC_server.Directory.register0 dir Services.inject_block implementation in
let dir =
let implementation (contents, blocking, net_id, force) =
let implementation () (contents, blocking, net_id, force) =
Node.RPC.inject_operation
node ?force ?net_id contents >>= fun (hash, wait) ->
begin
(if blocking then wait else return ()) >>=? fun () -> return hash
end >>= RPC_server.Answer.return in
RPC_server.register0 dir Services.inject_operation implementation in
RPC_server.Directory.register0 dir Services.inject_operation implementation in
let dir =
let implementation (proto, blocking, force) =
let implementation () (proto, blocking, force) =
Node.RPC.inject_protocol ?force node proto >>= fun (hash, wait) ->
begin
(if blocking then wait else return ()) >>=? fun () -> return hash
end >>= RPC_server.Answer.return in
RPC_server.register0 dir Services.inject_protocol implementation in
RPC_server.Directory.register0 dir Services.inject_protocol implementation in
let dir =
let implementation () =
let implementation () () =
RPC_server.Answer.return_stream (Node.RPC.bootstrapped node) in
RPC_server.register0 dir Services.bootstrapped implementation in
RPC_server.Directory.register0 dir Services.bootstrapped implementation in
let dir =
let implementation () =
let implementation () () =
RPC_server.Answer.return
Data_encoding.Json.(schema Error_monad.error_encoding) in
RPC_server.register0 dir Services.Error.service implementation in
RPC_server.Directory.register0 dir Services.Error.service implementation in
let dir =
RPC_server.register1 dir Services.complete
(fun s () ->
RPC_server.Directory.register1 dir Services.complete
(fun s () () ->
Node.RPC.complete node s >>= RPC_server.Answer.return) in
let dir =
RPC_server.register2 dir Services.Blocks.complete
(fun block s () ->
RPC_server.Directory.register2 dir Services.Blocks.complete
(fun block s () () ->
Node.RPC.complete node ~block s >>= RPC_server.Answer.return) in
(* Network : Global *)
let dir =
let implementation () =
let implementation () () =
Node.RPC.Network.stat node |> RPC_server.Answer.return in
RPC_server.register0 dir Services.Network.stat implementation in
RPC_server.Directory.register0 dir Services.Network.stat implementation in
let dir =
let implementation () =
let implementation () () =
RPC_server.Answer.return Distributed_db.Raw.supported_versions in
RPC_server.register0 dir Services.Network.versions implementation in
RPC_server.Directory.register0 dir Services.Network.versions implementation in
let dir =
let implementation () =
let implementation () () =
let stream, stopper = Node.RPC.Network.watch node in
let shutdown () = Lwt_watcher.shutdown stopper in
let next () = Lwt_stream.get stream in
RPC_server.Answer.return_stream { next ; shutdown } in
RPC_server.register0 dir Services.Network.events implementation in
RPC_server.Directory.register0 dir Services.Network.events implementation in
let dir =
let implementation point timeout =
let implementation point () timeout =
Node.RPC.Network.connect node point timeout >>= RPC_server.Answer.return in
RPC_server.register1 dir Services.Network.connect implementation in
RPC_server.Directory.register1 dir Services.Network.connect implementation in
(* Network : Connection *)
let dir =
let implementation peer_id () =
let implementation peer_id () () =
Node.RPC.Network.Connection.info node peer_id |> RPC_server.Answer.return in
RPC_server.register1 dir Services.Network.Connection.info implementation in
RPC_server.Directory.register1 dir Services.Network.Connection.info implementation in
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
RPC_server.register1 dir Services.Network.Connection.kick implementation in
RPC_server.Directory.register1 dir Services.Network.Connection.kick implementation in
let dir =
let implementation () =
let implementation () () =
Node.RPC.Network.Connection.list node |> RPC_server.Answer.return in
RPC_server.register0 dir Services.Network.Connection.list implementation in
RPC_server.Directory.register0 dir Services.Network.Connection.list implementation in
(* Network : Peer_id *)
let dir =
let implementation state =
let implementation () state =
Node.RPC.Network.Peer_id.list node ~restrict:state |> RPC_server.Answer.return in
RPC_server.register0 dir Services.Network.Peer_id.list implementation in
RPC_server.Directory.register0 dir Services.Network.Peer_id.list implementation in
let dir =
let implementation peer_id () =
let implementation peer_id () () =
Node.RPC.Network.Peer_id.info node peer_id |> RPC_server.Answer.return in
RPC_server.register1 dir Services.Network.Peer_id.info implementation in
RPC_server.Directory.register1 dir Services.Network.Peer_id.info implementation in
let dir =
let implementation peer_id monitor =
let implementation peer_id () monitor =
if monitor then
let stream, stopper = Node.RPC.Network.Peer_id.watch node peer_id in
let shutdown () = Lwt_watcher.shutdown stopper in
@ -502,20 +508,20 @@ let build_rpc_directory node =
RPC_server.Answer.return_stream { next ; shutdown }
else
Node.RPC.Network.Peer_id.events node peer_id |> RPC_server.Answer.return in
RPC_server.register1 dir Services.Network.Peer_id.events implementation in
RPC_server.Directory.register1 dir Services.Network.Peer_id.events implementation in
(* Network : Point *)
let dir =
let implementation state =
let implementation () state =
Node.RPC.Network.Point.list node ~restrict:state |> RPC_server.Answer.return in
RPC_server.register0 dir Services.Network.Point.list implementation in
RPC_server.Directory.register0 dir Services.Network.Point.list implementation in
let dir =
let implementation point () =
let implementation point () () =
Node.RPC.Network.Point.info node point |> RPC_server.Answer.return in
RPC_server.register1 dir Services.Network.Point.info implementation in
RPC_server.Directory.register1 dir Services.Network.Point.info implementation in
let dir =
let implementation point monitor =
let implementation point () monitor =
if monitor then
let stream, stopper = Node.RPC.Network.Point.watch node point in
let shutdown () = Lwt_watcher.shutdown stopper in
@ -530,7 +536,7 @@ let build_rpc_directory node =
RPC_server.Answer.return_stream { next ; shutdown }
else
Node.RPC.Network.Point.events node point |> RPC_server.Answer.return in
RPC_server.register1 dir Services.Network.Point.events implementation in
RPC_server.Directory.register1 dir Services.Network.Point.events implementation in
let dir =
RPC_server.Directory.register_describe_directory_service dir Services.describe in
dir