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

Client refactor: Move Client_node_rpcs.Block into Block_services

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-08 10:51:02 +01:00
parent db500b5ebd
commit 02c2035e93
29 changed files with 825 additions and 730 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin_client/jbuild
View File

@ -5,6 +5,7 @@
(public_names (tezos-client tezos-admin))
(libraries (tezos-base
tezos-rpc-http
tezos-shell-services
tezos-client-base
tezos-client-genesis
tezos-client-alpha))
@ -12,6 +13,7 @@
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_rpc_http
-open Tezos_shell_services
-open Tezos_client_base
-linkall))))

2
src/bin_client/main_lib.ml
View File

@ -13,7 +13,7 @@ let cctxt ~base_dir ~block rpc_config =
Client_commands.make_context ~base_dir ~block ~rpc_config (Client_commands.default_log ~base_dir)
let get_commands_for_version ctxt block protocol =
Client_node_rpcs.Blocks.protocol ctxt block >>= function
Block_services.protocol ctxt block >>= function
| Ok version -> begin
match protocol with
| None ->

2
src/lib_client_base/client_admin.ml
View File

@ -18,6 +18,6 @@ let commands () =
@@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list"
@@ stop)
(fun () block (cctxt : Client_commands.full_context) ->
Client_rpcs.call_err_service0 cctxt Block_services.unmark_invalid block >>=? fun () ->
Block_services.unmark_invalid cctxt block >>=? fun () ->
cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ;
]

15
src/lib_client_base/client_debug.ml
View File

@ -62,14 +62,10 @@ let registered_protocols ppf =
(Client_commands.get_versions ())
let print_heads ppf cctxt =
Client_rpcs.call_service0 cctxt Block_services.list
{ include_ops = true ;
length = Some 1 ;
heads = None ;
monitor = None ;
delay = None ;
min_date = None ;
min_heads = None } >>=? fun heads ->
Block_services.list
~include_ops:true
~length:1
cctxt >>=? fun heads ->
return @@
Format.pp_print_list ~pp_sep:Format.pp_print_newline
(fun ppf blocks ->
@ -81,8 +77,7 @@ let print_heads ppf cctxt =
ppf heads
let print_rejected ppf cctxt =
Client_rpcs.call_service0 cctxt
Block_services.list_invalid () >>=? fun invalid ->
Block_services.list_invalid cctxt >>=? fun invalid ->
return @@
Format.pp_print_list
(fun ppf (hash, level, errors) ->

87
src/lib_client_base/client_node_rpcs.ml
View File

@ -39,98 +39,13 @@ let complete cctxt ?block prefix =
| None ->
call_service1 cctxt Shell_services.complete prefix ()
| Some block ->
call_service2 cctxt Block_services.complete block prefix ()
Block_services.complete cctxt block prefix
let describe cctxt ?(recurse = true) path =
Client_rpcs.call_service cctxt
Shell_services.describe
((), path) { recurse } ()
module Blocks = struct
type block = Block_services.block
type block_info = Block_services.block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
validation_passes: int ; (* uint8 *)
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
context: Context_hash.t ;
data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_network: Test_network_status.t;
}
type preapply_param = Block_services.preapply_param = {
timestamp: Time.t ;
proto_header: MBytes.t ;
operations: Operation.t list list ;
sort_operations: bool ;
}
type preapply_result = Block_services.preapply_result = {
shell_header: Block_header.shell_header ;
operations: error Preapply_result.t list ;
}
let net_id cctxt h =
call_service1 cctxt Block_services.net_id h ()
let level cctxt h =
call_service1 cctxt Block_services.level h ()
let predecessor cctxt h =
call_service1 cctxt Block_services.predecessor h ()
let predecessors cctxt h l =
call_service1 cctxt Block_services.predecessors h l
let hash cctxt h =
call_service1 cctxt Block_services.hash h ()
let timestamp cctxt h =
call_service1 cctxt Block_services.timestamp h ()
let fitness cctxt h =
call_service1 cctxt Block_services.fitness h ()
let operations cctxt ?(contents = false) h =
call_service1 cctxt Block_services.operations h
{ contents ; monitor = false }
let protocol cctxt h =
call_service1 cctxt Block_services.protocol h ()
let test_network cctxt h =
call_service1 cctxt Block_services.test_network h ()
let preapply cctxt h
?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations =
call_err_service1
cctxt Block_services.preapply h
{ timestamp ; proto_header ; sort_operations = sort ; operations }
let pending_operations cctxt block =
call_service1 cctxt Block_services.pending_operations block ()
let info cctxt ?(include_ops = true) h =
call_service1 cctxt Block_services.info h include_ops
let complete cctxt block prefix =
call_service2 cctxt Block_services.complete block prefix ()
let list cctxt ?(include_ops = false)
?length ?heads ?delay ?min_date ?min_heads () =
call_service0 cctxt Block_services.list
{ include_ops ; length ; heads ; monitor = Some false ; delay ;
min_date ; min_heads }
let monitor cctxt ?(include_ops = false)
?length ?heads ?delay ?min_date ?min_heads () =
call_streamed_service0 cctxt Block_services.list
{ include_ops ; length ; heads ; monitor = Some true ; delay ;
min_date ; min_heads }
end
module Operations = struct
let monitor cctxt ?(contents = false) () =
call_streamed_service1 cctxt Block_services.operations
`Prevalidation
{ contents ; monitor = true }
end
module Protocols = struct
let contents cctxt hash =

101
src/lib_client_base/client_node_rpcs.mli
View File

@ -38,105 +38,6 @@ val inject_protocol:
Protocol.t ->
Protocol_hash.t tzresult Lwt.t
module Blocks : sig
type block = Block_services.block
val net_id:
#Client_rpcs.ctxt ->
block -> Net_id.t tzresult Lwt.t
val level:
#Client_rpcs.ctxt ->
block -> Int32.t tzresult Lwt.t
val predecessor:
#Client_rpcs.ctxt ->
block -> Block_hash.t tzresult Lwt.t
val predecessors:
#Client_rpcs.ctxt ->
block -> int -> Block_hash.t list tzresult Lwt.t
val hash:
#Client_rpcs.ctxt ->
block -> Block_hash.t tzresult Lwt.t
val timestamp:
#Client_rpcs.ctxt ->
block -> Time.t tzresult Lwt.t
val fitness:
#Client_rpcs.ctxt ->
block -> MBytes.t list tzresult Lwt.t
val operations:
#Client_rpcs.ctxt ->
?contents:bool ->
block -> (Operation_hash.t * Operation.t option) list list tzresult Lwt.t
val protocol:
#Client_rpcs.ctxt ->
block -> Protocol_hash.t tzresult Lwt.t
val test_network:
#Client_rpcs.ctxt ->
block -> Test_network_status.t tzresult Lwt.t
val pending_operations:
#Client_rpcs.ctxt ->
block ->
(error Preapply_result.t * Operation.t Operation_hash.Map.t) tzresult Lwt.t
type block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
level: Int32.t ;
proto_level: int ; (* uint8 *)
predecessor: Block_hash.t ;
timestamp: Time.t ;
validation_passes: int ; (* uint8 *)
operations_hash: Operation_list_list_hash.t ;
fitness: MBytes.t list ;
context: Context_hash.t ;
data: MBytes.t ;
operations: (Operation_hash.t * Operation.t) list list option ;
protocol: Protocol_hash.t ;
test_network: Test_network_status.t ;
}
val info:
#Client_rpcs.ctxt ->
?include_ops:bool -> block -> block_info tzresult Lwt.t
val list:
#Client_rpcs.ctxt ->
?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
unit -> block_info list list tzresult Lwt.t
val monitor:
#Client_rpcs.ctxt ->
?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
unit -> block_info list list Lwt_stream.t tzresult Lwt.t
type preapply_result = {
shell_header: Block_header.shell_header ;
operations: error Preapply_result.t list ;
}
val preapply:
#Client_rpcs.ctxt ->
block ->
?timestamp:Time.t ->
?sort:bool ->
proto_header:MBytes.t ->
Operation.t list list -> preapply_result tzresult Lwt.t
end
module Operations : sig
val monitor:
#Client_rpcs.ctxt ->
?contents:bool ->
unit ->
(Operation_hash.t * Operation.t option) list list Lwt_stream.t tzresult Lwt.t
end
module Protocols : sig
val contents:
@ -171,7 +72,7 @@ end
val complete:
#Client_rpcs.ctxt ->
?block:Blocks.block -> string -> string list tzresult Lwt.t
?block:Block_services.block -> string -> string list tzresult Lwt.t
val describe:
#Client_rpcs.ctxt ->

17
src/lib_client_base/client_rpcs.ml
View File

@ -41,18 +41,7 @@ class type json_ctxt = object
(Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t
end
class type service_ctxt = object
method call_service :
'm 'p 'q 'i 'o 'e.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t
method call_streamed_service :
'm 'p 'q 'i 'o 'e.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
end
class type service_ctxt = RPC_context.t
class type ctxt = object
inherit json_ctxt
@ -73,13 +62,13 @@ class http_ctxt config : ctxt =
let uri = Uri.with_query uri (Uri.query uri) in
RPC_client.generic_json_call ~logger meth ?body uri
method call_service
: 'm 'p 'q 'i 'o 'e.
: 'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t =
fun service params query body ->
RPC_client.call_service Media_type.all_media_types ~logger ~base service params query body
method call_streamed_service
: 'm 'p 'q 'i 'o 'e.
: 'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->

13
src/lib_client_base/client_rpcs.mli
View File

@ -22,18 +22,7 @@ class type json_ctxt = object
(Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t
end
class type service_ctxt = object
method call_service :
'm 'p 'q 'i 'o 'e.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t
method call_streamed_service :
'm 'p 'q 'i 'o 'e.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
end
class type service_ctxt = RPC_context.t
class type ctxt = object
inherit json_ctxt

114
src/lib_rpc/RPC_context.ml Normal file
View File

@ -0,0 +1,114 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Error_monad
class type simple = object
method call_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t
end
class type streamed = object
method call_streamed_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
end
class type t = object
inherit simple
inherit streamed
end
type error +=
| Not_found of { meth: RPC_service.meth ;
uri: Uri.t }
| Generic_error of { meth: RPC_service.meth ;
uri: Uri.t }
let base = Uri.make ~scheme:"ocaml" ()
let not_found s p q =
let { RPC_service.meth ; uri ; _ } =
RPC_service.forge_request s ~base p q in
fail (Not_found { meth ; uri })
let generic_error s p q =
let { RPC_service.meth ; uri ; _ } =
RPC_service.forge_request s ~base p q in
fail (Generic_error { meth ; uri })
let of_directory (dir : unit RPC_directory.t) : t = object
method call_service : 'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t =
fun s p q i ->
RPC_directory.transparent_lookup dir s p q i >>= function
| `Ok v -> return v
| `OkStream { next ; shutdown } -> begin
next () >>= function
| Some v -> shutdown () ; return v
| None -> shutdown () ; not_found s p q
end
| `Not_found None -> not_found s p q
| `Unauthorized _
| `Error _
| `Not_found _
| `Forbidden _
| `Created _
| `Conflict _
| `No_content -> generic_error s p q
method call_streamed_service : 'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t =
fun s ~on_chunk ~on_close p q i ->
RPC_directory.transparent_lookup dir s p q i >>= function
| `OkStream { next; shutdown } ->
let rec loop () =
next () >>= function
| None -> on_close () ; Lwt.return_unit
| Some v -> on_chunk v ; loop () in
let _ = loop () in
return shutdown
| `Ok v ->
on_chunk v ; on_close () ;
return (fun () -> ())
| `Not_found None -> not_found s p q
| `Unauthorized _
| `Error _
| `Not_found (Some _)
| `Forbidden _
| `Created _
| `Conflict _
| `No_content -> generic_error s p q
end
let make_call s (ctxt : #simple) = ctxt#call_service s
let make_call1 s ctxt x = make_call s ctxt ((), x)
let make_call2 s ctxt x y = make_call s ctxt (((), x), y)
let make_call3 s ctxt x y z = make_call s ctxt ((((), x), y), z)
let make_err_call s ctxt p q i =
make_call s ctxt p q i >>=? Lwt.return
let make_err_call1 s ctxt x = make_err_call s ctxt ((), x)
let make_err_call2 s ctxt x y = make_err_call s ctxt (((), x), y)
type stopper = unit -> unit
let make_streamed_call s (ctxt : #streamed) p q i =
let stream, push = Lwt_stream.create () in
let on_chunk v = push (Some v)
and on_close () = push None in
ctxt#call_streamed_service s ~on_chunk ~on_close p q i >>=? fun close ->
return (stream, close)

74
src/lib_rpc/RPC_context.mli Normal file
View File

@ -0,0 +1,74 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
open Error_monad
class type simple = object
method call_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t
end
class type streamed = object
method call_streamed_service :
'm 'p 'q 'i 'o.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
end
class type t = object
inherit simple
inherit streamed
end
val of_directory : unit RPC_directory.t -> t
type error +=
| Not_found of { meth: RPC_service.meth ;
uri: Uri.t }
| Generic_error of { meth: RPC_service.meth ;
uri: Uri.t }
val make_call :
([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
#simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t
val make_call1 :
([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o) RPC_service.t ->
#simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
val make_call2 :
([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
#simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
val make_call3 :
([< Resto.meth ], unit, ((unit * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
#simple -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
val make_err_call :
([< Resto.meth ], unit, 'p, 'q, 'i, 'o tzresult) RPC_service.t ->
#simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t
val make_err_call1 :
([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o tzresult) RPC_service.t ->
#simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
val make_err_call2 :
([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o tzresult) RPC_service.t ->
#simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
type stopper = unit -> unit
val make_streamed_call :
([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
#streamed -> 'p -> 'q -> 'i ->
('o Lwt_stream.t * stopper) tzresult Lwt.t

24
src/lib_rpc_http/RPC_client.ml
View File

@ -27,10 +27,9 @@ type content_type = (string * string)
type raw_content = Cohttp_lwt.Body.t * content_type option
type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
type rest_error =
type rpc_error =
| Empty_answer
| Connection_failed of string
| Not_found
| Bad_request of string
| Method_not_allowed of RPC_service.meth list
| Unsupported_media_type of string option
@ -45,9 +44,8 @@ type rest_error =
media_type: string ;
error: string }
| OCaml_exception of string
| Generic_error (* temporary *)
let rest_error_encoding =
let rpc_error_encoding =
let open Data_encoding in
union
[ case (Tag 0)
@ -135,7 +133,7 @@ let rest_error_encoding =
(function ((), msg) -> OCaml_exception msg) ;
]
let pp_rest_error ppf err =
let pp_rpc_error ppf err =
match err with
| Empty_answer ->
Format.fprintf ppf
@ -143,9 +141,6 @@ let pp_rest_error ppf err =
| Connection_failed msg ->
Format.fprintf ppf
"Unable to connect to the node: \"%s\"" msg
| Not_found ->
Format.fprintf ppf
"404 Not Found"
| Bad_request msg ->
Format.fprintf ppf
"@[<v 2>Oups! It looks like we forged an invalid HTTP request.@,%s@]"
@ -187,14 +182,11 @@ let pp_rest_error ppf err =
Format.fprintf ppf
"@[<v 2>The server failed with an unexpected exception:@ %s@]"
msg
| Generic_error ->
Format.fprintf ppf
"Generic error"
type error +=
| Request_failed of { meth: RPC_service.meth ;
uri: Uri.t ;
error: rest_error }
error: rpc_error }
let uri_encoding =
let open Data_encoding in
@ -216,11 +208,11 @@ let () =
\ - error: %a@]"
(RPC_service.string_of_meth meth)
(Uri.to_string uri)
pp_rest_error error)
pp_rpc_error error)
Data_encoding.(obj3
(req "meth" RPC_service.meth_encoding)
(req "uri" uri_encoding)
(req "error" rest_error_encoding))
(req "error" rpc_error_encoding))
(function
| Request_failed { uri ; error ; meth } -> Some (meth, uri, error)
| _ -> None)
@ -338,10 +330,10 @@ let handle accept (meth, uri, ans) =
match ans with
| `Ok (Some v) -> return v
| `Ok None -> request_failed meth uri Empty_answer
| `Not_found None -> request_failed meth uri Not_found
| `Not_found None -> fail (RPC_context.Not_found { meth ; uri })
| `Conflict _ | `Error _ | `Forbidden _ | `Unauthorized _
| `Not_found (Some _) ->
request_failed meth uri Generic_error
fail (RPC_context.Generic_error { meth ; uri })
| `Unexpected_status_code (code, (content, _, media_type)) ->
let media_type = Option.map media_type ~f:Media_type.name in
Cohttp_lwt.Body.to_string content >>= fun content ->

6
src/lib_rpc_http/RPC_client.mli
View File

@ -36,10 +36,9 @@ type content_type = (string * string)
type raw_content = Cohttp_lwt.Body.t * content_type option
type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
type rest_error =
type rpc_error =
| Empty_answer
| Connection_failed of string
| Not_found
| Bad_request of string
| Method_not_allowed of RPC_service.meth list
| Unsupported_media_type of string option
@ -54,12 +53,11 @@ type rest_error =
media_type: string ;
error: string }
| OCaml_exception of string
| Generic_error (* temporary *)
type error +=
| Request_failed of { meth: RPC_service.meth ;
uri: Uri.t ;
error: rest_error }
error: rpc_error }
val generic_call :
?logger:logger ->

44
src/lib_shell/node_rpc.ml
View File

@ -42,65 +42,65 @@ let register_bi_dir node dir =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return (filter_bi include_ops bi) in
RPC_directory.register1 dir
Block_services.info implementation in
Block_services.S.info implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.hash in
RPC_directory.register1 dir
Block_services.hash
Block_services.S.hash
implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.net_id in
RPC_directory.register1 dir
Block_services.net_id implementation in
Block_services.S.net_id implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.level in
RPC_directory.register1 dir
Block_services.level implementation in
Block_services.S.level implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.predecessor in
RPC_directory.register1 dir
Block_services.predecessor implementation in
Block_services.S.predecessor implementation in
let dir =
let implementation b () len =
Node.RPC.block_info node b >>= fun bi ->
Node.RPC.predecessors node len bi.hash >>= fun hashes ->
RPC_answer.return hashes in
RPC_directory.register1 dir
Block_services.predecessors implementation in
Block_services.S.predecessors implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.fitness in
RPC_directory.register1 dir
Block_services.fitness implementation in
Block_services.S.fitness implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.timestamp in
RPC_directory.register1 dir
Block_services.timestamp implementation in
Block_services.S.timestamp implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.protocol in
RPC_directory.register1 dir
Block_services.protocol implementation in
Block_services.S.protocol implementation in
let dir =
let implementation b () () =
Node.RPC.block_info node b >>= fun bi ->
RPC_answer.return bi.test_network in
RPC_directory.register1 dir
Block_services.test_network implementation in
Block_services.S.test_network implementation in
let dir =
let implementation b () { Block_services.contents ; monitor } =
let implementation b () { Block_services.S.contents ; monitor } =
match b with
| `Prevalidation when monitor ->
monitor_operations node contents
@ -115,18 +115,18 @@ let register_bi_dir node dir =
List.map (List.map (fun h -> h, None)) hashes
in
RPC_directory.register1 dir
Block_services.operations implementation in
Block_services.S.operations implementation in
let dir =
let implementation b () () =
Node.RPC.pending_operations node b >>= fun res ->
RPC_answer.return res in
RPC_directory.register1 dir
Block_services.pending_operations
Block_services.S.pending_operations
implementation in
let dir =
let implementation
b ()
{ Block_services.operations ; sort_operations ;
{ Block_services.S.operations ; sort_operations ;
timestamp ; proto_header} =
Node.RPC.preapply node b
~timestamp ~proto_header ~sort_operations operations >>= function
@ -135,7 +135,7 @@ let register_bi_dir node dir =
(Ok { Block_services.shell_header ; operations })
| Error _ as err -> RPC_answer.return err in
RPC_directory.register1 dir
Block_services.preapply implementation in
Block_services.S.preapply implementation in
dir
let rec insert_future_block (bi: Block_services.block_info) = function
@ -236,7 +236,7 @@ let create_delayed_stream
let list_blocks
node ()
{ Block_services.include_ops ; length ; heads ; monitor ; delay ;
{ Block_services.S.include_ops ; length ; heads ; monitor ; delay ;
min_date; min_heads} =
let len = match length with None -> 1 | Some x -> x in
let monitor = match monitor with None -> false | Some x -> x in
@ -327,7 +327,7 @@ let list_invalid node () () =
Node.RPC.list_invalid node >>= fun l ->
RPC_answer.return l
let unmark_invalid node () block =
let unmark_invalid node block () () =
Node.RPC.unmark_invalid node block >>= fun x ->
RPC_answer.return x
@ -370,13 +370,13 @@ let get_protocols node hash () () =
let build_rpc_directory node =
let dir = RPC_directory.empty in
let dir =
RPC_directory.register0 dir Block_services.list
RPC_directory.register0 dir Block_services.S.list
(list_blocks node) in
let dir =
RPC_directory.register0 dir Block_services.list_invalid
RPC_directory.register0 dir Block_services.S.list_invalid
(list_invalid node) in
let dir =
RPC_directory.register0 dir Block_services.unmark_invalid
RPC_directory.register1 dir Block_services.S.unmark_invalid
(unmark_invalid node) in
let dir = register_bi_dir node dir in
let dir =
@ -389,7 +389,7 @@ let build_rpc_directory node =
RPC_directory.register_dynamic_directory1
~descr:
"All the RPCs which are specific to the protocol version."
dir Block_services.proto_path implementation in
dir Block_services.S.proto_path implementation in
let dir =
RPC_directory.register0 dir Protocol_services.list
(list_protocols node) in
@ -442,7 +442,7 @@ let build_rpc_directory node =
(fun s () () ->
Node.RPC.complete node s >>= RPC_answer.return) in
let dir =
RPC_directory.register2 dir Block_services.complete
RPC_directory.register2 dir Block_services.S.complete
(fun block s () () ->
Node.RPC.complete node ~block s >>= RPC_answer.return) in

190
src/lib_shell_services/block_services.ml
View File

@ -16,6 +16,30 @@ type block = [
| `Hash of Block_hash.t
]
let parse_block s =
try
match String.split '~' s with
| ["genesis"] -> Ok `Genesis
| ["head"] -> Ok (`Head 0)
| ["prevalidation"] -> Ok `Prevalidation
| ["test_head"] -> Ok (`Test_head 0)
| ["test_prevalidation"] -> Ok `Test_prevalidation
| ["head"; n] -> Ok (`Head (int_of_string n))
| ["test_head"; n] -> Ok (`Test_head (int_of_string n))
| [h] -> Ok (`Hash (Block_hash.of_b58check_exn h))
| _ -> raise Exit
with _ -> Error "Cannot parse block identifier."
let to_string = function
| `Genesis -> "genesis"
| `Head 0 -> "head"
| `Head n -> Printf.sprintf "head~%d" n
| `Prevalidation -> "prevalidation"
| `Test_head 0 -> "test_head"
| `Test_head n -> Printf.sprintf "test_head~%d" n
| `Test_prevalidation -> "test_prevalidation"
| `Hash h -> Block_hash.to_b58check h
type block_info = {
hash: Block_hash.t ;
net_id: Net_id.t ;
@ -70,31 +94,25 @@ let block_info_encoding =
Test_network_status.encoding Not_running))
Block_header.encoding))
let parse_block s =
try
match String.split '~' s with
| ["genesis"] -> Ok `Genesis
| ["head"] -> Ok (`Head 0)
| ["prevalidation"] -> Ok `Prevalidation
| ["test_head"] -> Ok (`Test_head 0)
| ["test_prevalidation"] -> Ok `Test_prevalidation
| ["head"; n] -> Ok (`Head (int_of_string n))
| ["test_head"; n] -> Ok (`Test_head (int_of_string n))
| [h] -> Ok (`Hash (Block_hash.of_b58check_exn h))
| _ -> raise Exit
with _ -> Error "Cannot parse block identifier."
type preapply_result = {
shell_header: Block_header.shell_header ;
operations: error Preapply_result.t list ;
}
let to_string = function
| `Genesis -> "genesis"
| `Head 0 -> "head"
| `Head n -> Printf.sprintf "head~%d" n
| `Prevalidation -> "prevalidation"
| `Test_head 0 -> "test_head"
| `Test_head n -> Printf.sprintf "test_head~%d" n
| `Test_prevalidation -> "test_prevalidation"
| `Hash h -> Block_hash.to_b58check h
let preapply_result_encoding =
(conv
(fun { shell_header ; operations } ->
(shell_header, operations))
(fun (shell_header, operations) ->
{ shell_header ; operations })
(obj2
(req "shell_header" Block_header.shell_header_encoding)
(req "operations"
(list (Preapply_result.encoding RPC_error.encoding)))))
let blocks_arg =
module S = struct
let blocks_arg =
let name = "block_id" in
let descr =
"A block identifier. This is either a block hash in hexadecimal \
@ -107,10 +125,10 @@ let blocks_arg =
let destruct = parse_block in
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 )
let info =
let info =
RPC_service.post_service
~description:"All the information about a block."
~query: RPC_query.empty
@ -118,7 +136,7 @@ let info =
~output: block_info_encoding
block_path
let net_id =
let net_id =
RPC_service.post_service
~description:"Returns the net of the chain in which the block belongs."
~query: RPC_query.empty
@ -126,7 +144,7 @@ let net_id =
~output: (obj1 (req "net_id" Net_id.encoding))
RPC_path.(block_path / "net_id")
let level =
let level =
RPC_service.post_service
~description:"Returns the block's level."
~query: RPC_query.empty
@ -134,7 +152,7 @@ let level =
~output: (obj1 (req "level" int32))
RPC_path.(block_path / "level")
let predecessor =
let predecessor =
RPC_service.post_service
~description:"Returns the previous block's id."
~query: RPC_query.empty
@ -142,7 +160,7 @@ let predecessor =
~output: (obj1 (req "predecessor" Block_hash.encoding))
RPC_path.(block_path / "predecessor")
let predecessors =
let predecessors =
RPC_service.post_service
~description:
"...."
@ -152,7 +170,7 @@ let predecessors =
(req "blocks" (Data_encoding.list Block_hash.encoding)))
RPC_path.(block_path / "predecessors")
let hash =
let hash =
RPC_service.post_service
~description:"Returns the block's id."
~query: RPC_query.empty
@ -160,7 +178,7 @@ let hash =
~output: (obj1 (req "hash" Block_hash.encoding))
RPC_path.(block_path / "hash")
let fitness =
let fitness =
RPC_service.post_service
~description:"Returns the block's fitness."
~query: RPC_query.empty
@ -168,7 +186,7 @@ let fitness =
~output: (obj1 (req "fitness" Fitness.encoding))
RPC_path.(block_path / "fitness")
let context =
let context =
RPC_service.post_service
~description:"Returns the hash of the resulting context."
~query: RPC_query.empty
@ -176,7 +194,7 @@ let context =
~output: (obj1 (req "context" Context_hash.encoding))
RPC_path.(block_path / "context")
let timestamp =
let timestamp =
RPC_service.post_service
~description:"Returns the block's timestamp."
~query: RPC_query.empty
@ -184,12 +202,12 @@ let timestamp =
~output: (obj1 (req "timestamp" Time.encoding))
RPC_path.(block_path / "timestamp")
type operations_param = {
type operations_param = {
contents: bool ;
monitor: bool ;
}
}
let operations_param_encoding =
let operations_param_encoding =
let open Data_encoding in
conv
(fun { contents ; monitor } -> (contents, monitor))
@ -198,7 +216,7 @@ let operations_param_encoding =
(dft "contents" bool false)
(dft "monitor" bool false))
let operations =
let operations =
RPC_service.post_service
~description:"List the block operations."
~query: RPC_query.empty
@ -212,7 +230,7 @@ let operations =
(dynamic_size Operation.encoding)))))))
RPC_path.(block_path / "operations")
let protocol =
let protocol =
RPC_service.post_service
~description:"List the block protocol."
~query: RPC_query.empty
@ -220,7 +238,7 @@ let protocol =
~output: (obj1 (req "protocol" Protocol_hash.encoding))
RPC_path.(block_path / "protocol")
let test_network =
let test_network =
RPC_service.post_service
~description:"Returns the status of the associated test network."
~query: RPC_query.empty
@ -228,7 +246,7 @@ let test_network =
~output: Test_network_status.encoding
RPC_path.(block_path / "test_network")
let pending_operations =
let pending_operations =
let operation_encoding =
merge_objs
(obj1 (req "hash" Operation_hash.encoding))
@ -256,17 +274,17 @@ let pending_operations =
(obj1 (req "unprocessed" (list (dynamic_size operation_encoding))))))
RPC_path.(block_path / "pending_operations")
let proto_path =
let proto_path =
RPC_path.(block_path / "proto")
type preapply_param = {
type preapply_param = {
timestamp: Time.t ;
proto_header: MBytes.t ;
operations: Operation.t list list ;
sort_operations: bool ;
}
}
let preapply_param_encoding =
let preapply_param_encoding =
(conv
(fun { timestamp ; proto_header ; operations ; sort_operations } ->
(timestamp, proto_header, operations, sort_operations))
@ -278,23 +296,7 @@ let preapply_param_encoding =
(req "operations" (list (dynamic_size (list (dynamic_size Operation.encoding)))))
(dft "sort_operations" bool false)))
type preapply_result = {
shell_header: Block_header.shell_header ;
operations: error Preapply_result.t list ;
}
let preapply_result_encoding =
(conv
(fun { shell_header ; operations } ->
(shell_header, operations))
(fun (shell_header, operations) ->
{ shell_header ; operations })
(obj2
(req "shell_header" Block_header.shell_header_encoding)
(req "operations"
(list (Preapply_result.encoding RPC_error.encoding)))))
let preapply =
let preapply =
RPC_service.post_service
~description:
"Simulate the validation of a block that would contain \
@ -304,7 +306,7 @@ let preapply =
~output: (RPC_error.wrap preapply_result_encoding)
RPC_path.(block_path / "preapply")
let complete =
let complete =
let prefix_arg =
let destruct s = Ok s
and construct s = s in
@ -318,7 +320,7 @@ let complete =
~output: (list string)
RPC_path.(block_path / "complete" /: prefix_arg )
type list_param = {
type list_param = {
include_ops: bool ;
length: int option ;
heads: Block_hash.t list option ;
@ -326,8 +328,8 @@ type list_param = {
delay: int option ;
min_date: Time.t option;
min_heads: int option;
}
let list_param_encoding =
}
let list_param_encoding =
conv
(fun { include_ops ; length ; heads ; monitor ;
delay ; min_date ; min_heads } ->
@ -383,7 +385,7 @@ let list_param_encoding =
`min_date`."
int31)))
let list =
let list =
RPC_service.post_service
~description:
"Lists known heads of the blockchain sorted with decreasing fitness. \
@ -394,7 +396,7 @@ let list =
~output: (obj1 (req "blocks" (list (list block_info_encoding))))
RPC_path.(root / "blocks")
let list_invalid =
let list_invalid =
RPC_service.post_service
~description:
"Lists blocks that have been declared invalid along with the errors\
@ -408,11 +410,59 @@ let list_invalid =
(req "errors" RPC_error.encoding)))
RPC_path.(root / "invalid_blocks")
let unmark_invalid =
let unmark_invalid =
RPC_service.post_service
~description:
"Unmark an invalid block"
~query: RPC_query.empty
~input:Data_encoding.(obj1 (req "block" Block_hash.encoding))
~input: Data_encoding.empty
~output:(RPC_error.wrap Data_encoding.empty)
RPC_path.(root / "unmark_invalid")
RPC_path.(root / "invalid_blocks" /: Block_hash.rpc_arg / "unmark" )
end
open RPC_context
let monitor_prevalidated_operations ?(contents = false) ctxt =
make_streamed_call S.operations ctxt
((), `Prevalidation) ()
{ contents ; monitor = true }
let net_id ctxt b = make_call1 S.net_id ctxt b () ()
let level ctxt b = make_call1 S.level ctxt b () ()
let predecessor ctxt b = make_call1 S.predecessor ctxt b () ()
let predecessors ctxt b n = make_call1 S.predecessors ctxt b () n
let hash ctxt b = make_call1 S.hash ctxt b () ()
let timestamp ctxt b = make_call1 S.timestamp ctxt b () ()
let fitness ctxt b = make_call1 S.fitness ctxt b () ()
let operations ctxt ?(contents = false) h =
make_call1 S.operations ctxt h () { contents ; monitor = false }
let protocol ctxt b = make_call1 S.protocol ctxt b () ()
let test_network ctxt b = make_call1 S.test_network ctxt b () ()
let pending_operations ctxt b = make_call1 S.pending_operations ctxt b () ()
let info ctxt ?(include_ops = true) h =
make_call1 S.info ctxt h () include_ops
let monitor ?(include_ops = false)
?length ?heads ?delay ?min_date ?min_heads ctxt =
make_streamed_call S.list ctxt () ()
{ include_ops ; length ; heads ;
monitor = Some true ; delay ;
min_date ; min_heads }
let list ?(include_ops = false)
?length ?heads ?delay ?min_date ?min_heads ctxt =
make_call S.list ctxt () ()
{ include_ops ; length ; heads ;
monitor = Some false ; delay ;
min_date ; min_heads }
let complete ctxt b s =
make_call2 S.complete ctxt b s () ()
let preapply ctxt h
?(timestamp = Time.now ()) ?(sort = false) ~proto_header operations =
make_err_call1 S.preapply ctxt h ()
{ timestamp ; proto_header ; sort_operations = sort ; operations }
let unmark_invalid ctxt h =
make_err_call1 S.unmark_invalid ctxt h () ()
let list_invalid ctxt =
make_call S.list_invalid ctxt () () ()

133
src/lib_shell_services/block_services.mli
View File

@ -13,7 +13,6 @@ type block = [
| `Test_head of int | `Test_prevalidation
| `Hash of Block_hash.t
]
val blocks_arg : block RPC_arg.arg
val parse_block: string -> (block, string) result
val to_string: block -> string
@ -35,66 +34,140 @@ type block_info = {
test_network: Test_network_status.t ;
}
type preapply_result = {
shell_header: Block_header.shell_header ;
operations: error Preapply_result.t list ;
}
open RPC_context
val net_id:
#simple -> block -> Net_id.t tzresult Lwt.t
val level:
#simple -> block -> Int32.t tzresult Lwt.t
val predecessor:
#simple -> block -> Block_hash.t tzresult Lwt.t
val predecessors:
#simple -> block -> int -> Block_hash.t list tzresult Lwt.t
val hash:
#simple -> block -> Block_hash.t tzresult Lwt.t
val timestamp:
#simple -> block -> Time.t tzresult Lwt.t
val fitness:
#simple -> block -> MBytes.t list tzresult Lwt.t
val operations:
#simple -> ?contents:bool ->
block -> (Operation_hash.t * Operation.t option) list list tzresult Lwt.t
val protocol:
#simple -> block -> Protocol_hash.t tzresult Lwt.t
val test_network:
#simple -> block -> Test_network_status.t tzresult Lwt.t
val pending_operations:
#simple -> block ->
(error Preapply_result.t * Operation.t Operation_hash.Map.t) tzresult Lwt.t
val info:
#simple ->
?include_ops:bool -> block -> block_info tzresult Lwt.t
val list:
?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
#simple ->
block_info list list tzresult Lwt.t
val monitor:
?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
#streamed ->
(block_info list list Lwt_stream.t * stopper) tzresult Lwt.t
val preapply:
#simple -> block ->
?timestamp:Time.t ->
?sort:bool ->
proto_header:MBytes.t ->
Operation.t list list -> preapply_result tzresult Lwt.t
val complete:
#simple -> block -> string -> string list tzresult Lwt.t
val monitor_prevalidated_operations:
?contents:bool ->
#streamed ->
((Operation_hash.t * Operation.t option) list list Lwt_stream.t * stopper) tzresult Lwt.t
val unmark_invalid:
#simple -> Block_hash.t -> unit Error_monad.tzresult Lwt.t
val list_invalid:
#simple -> (Block_hash.t * int32 * error list) list tzresult Lwt.t
module S : sig
val blocks_arg : block RPC_arg.arg
val info:
([ `POST ], unit,
unit * block, unit, bool,
block_info) RPC_service.t
val net_id:
val net_id:
([ `POST ], unit,
unit * block, unit, unit,
Net_id.t) RPC_service.t
val level:
val level:
([ `POST ], unit,
unit * block, unit, unit,
Int32.t) RPC_service.t
val predecessor:
val predecessor:
([ `POST ], unit,
unit * block, unit, unit,
Block_hash.t) RPC_service.t
val predecessors:
val predecessors:
([ `POST ], unit,
unit * block , unit, int,
Block_hash.t list) RPC_service.t
val hash:
val hash:
([ `POST ], unit,
unit * block, unit, unit,
Block_hash.t) RPC_service.t
val timestamp:
val timestamp:
([ `POST ], unit,
unit * block, unit, unit,
Time.t) RPC_service.t
val fitness:
val fitness:
([ `POST ], unit,
unit * block, unit, unit,
MBytes.t list) RPC_service.t
val context:
val context:
([ `POST ], unit,
unit * block, unit, unit,
Context_hash.t) RPC_service.t
type operations_param = {
type operations_param = {
contents: bool ;
monitor: bool ;
}
val operations:
}
val operations:
([ `POST ], unit,
unit * block, unit, operations_param,
(Operation_hash.t * Operation.t option) list list) RPC_service.t
val protocol:
val protocol:
([ `POST ], unit,
unit * block, unit, unit,
Protocol_hash.t) RPC_service.t
val test_network:
val test_network:
([ `POST ], unit,
unit * block, unit, unit,
Test_network_status.t) RPC_service.t
val pending_operations:
val pending_operations:
([ `POST ], unit,
unit * block, unit, unit,
error Preapply_result.t * Operation.t Operation_hash.Map.t) RPC_service.t
type list_param = {
type list_param = {
include_ops: bool ;
length: int option ;
heads: Block_hash.t list option ;
@ -102,39 +175,39 @@ type list_param = {
delay: int option ;
min_date: Time.t option;
min_heads: int option;
}
val list:
}
val list:
([ `POST ], unit,
unit, unit, list_param,
block_info list list) RPC_service.t
val list_invalid:
val list_invalid:
([ `POST ], unit,
unit, unit, unit,
(Block_hash.t * int32 * error list) list) RPC_service.t
val unmark_invalid:
([ `POST ], unit, unit, unit, Block_hash.t, unit tzresult) RPC_service.t
val unmark_invalid:
([ `POST ], unit,
unit * Block_hash.t, unit, unit,
unit tzresult) RPC_service.t
type preapply_param = {
type preapply_param = {
timestamp: Time.t ;
proto_header: MBytes.t ;
operations: Operation.t list list ;
sort_operations: bool ;
}
}
type preapply_result = {
shell_header: Block_header.shell_header ;
operations: error Preapply_result.t list ;
}
val preapply:
val preapply:
([ `POST ], unit,
unit * block, unit, preapply_param,
preapply_result tzresult) RPC_service.t
val complete:
val complete:
([ `POST ], unit,
(unit * block) * string, unit, unit,
string list) RPC_service.t
val proto_path: (unit, unit * block) RPC_path.path
val proto_path: (unit, unit * block) RPC_path.path
end

14
src/proto_alpha/lib_client/client_baking_blocks.ml
View File

@ -22,7 +22,7 @@ type block_info = {
let convert_block_info cctxt
( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
: Client_node_rpcs.Blocks.block_info ) =
: Block_services.block_info ) =
Client_proto_rpcs.Context.level cctxt (`Hash hash) >>= function
| Ok level ->
Lwt.return
@ -34,12 +34,12 @@ let convert_block_info cctxt
let convert_block_info_err cctxt
( { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol }
: Client_node_rpcs.Blocks.block_info ) =
: Block_services.block_info ) =
Client_proto_rpcs.Context.level cctxt (`Hash hash) >>=? fun level ->
return { hash ; net_id ; predecessor ; fitness ; timestamp ; protocol ; level }
let info cctxt ?include_ops block =
Client_node_rpcs.Blocks.info cctxt ?include_ops block >>=? fun block ->
Block_services.info cctxt ?include_ops block >>=? fun block ->
convert_block_info_err cctxt block
let compare (bi1 : block_info) (bi2 : block_info) =
@ -62,9 +62,9 @@ let sort_blocks cctxt ?(compare = compare) blocks =
let monitor cctxt
?include_ops ?length ?heads ?delay
?min_date ?min_heads ?compare () =
Client_node_rpcs.Blocks.monitor cctxt
Block_services.monitor
?include_ops ?length ?heads ?delay ?min_date ?min_heads
() >>=? fun block_stream ->
cctxt >>=? fun (block_stream, _stop) ->
let convert blocks =
sort_blocks cctxt ?compare (List.flatten blocks) >>= return in
return (Lwt_stream.map_s convert block_stream)
@ -74,12 +74,12 @@ let blocks_from_cycle cctxt block cycle =
Client_proto_rpcs.Context.level cctxt block >>=? fun level ->
Client_proto_rpcs.Helpers.levels cctxt block cycle >>=? fun (first, last) ->
let length = Int32.to_int (Raw_level.diff level.level first) in
Client_node_rpcs.Blocks.predecessors cctxt block length >>=? fun blocks ->
Block_services.predecessors cctxt block length >>=? fun blocks ->
let blocks =
List.remove
(length - (1 + Int32.to_int (Raw_level.diff last first))) blocks in
if Raw_level.(level.level = last) then
Client_node_rpcs.Blocks.hash cctxt block >>=? fun last ->
Block_services.hash cctxt block >>=? fun last ->
return (last :: blocks)
else
return blocks

4
src/proto_alpha/lib_client/client_baking_blocks.mli
View File

@ -22,7 +22,7 @@ type block_info = {
val info:
#Client_rpcs.ctxt ->
?include_ops:bool -> Client_node_rpcs.Blocks.block -> block_info tzresult Lwt.t
?include_ops:bool -> Block_services.block -> block_info tzresult Lwt.t
val compare:
block_info -> block_info -> int
@ -36,6 +36,6 @@ val monitor:
val blocks_from_cycle:
#Client_rpcs.ctxt ->
Client_node_rpcs.Blocks.block ->
Block_services.block ->
Cycle.t ->
Block_hash.t list tzresult Lwt.t

2
src/proto_alpha/lib_client/client_baking_endorsement.ml
View File

@ -95,7 +95,7 @@ let inject_endorsement (cctxt : Client_commands.full_context)
block level ?async
src_sk source slot =
let block = Client_rpcs.last_baked_block block in
Client_node_rpcs.Blocks.info cctxt block >>=? fun bi ->
Block_services.info cctxt block >>=? fun bi ->
Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt
block
~branch:bi.hash

12
src/proto_alpha/lib_client/client_baking_forge.ml
View File

@ -118,7 +118,7 @@ let forge_block cctxt block
begin
match operations with
| None ->
Client_node_rpcs.Blocks.pending_operations
Block_services.pending_operations
cctxt block >>=? fun (ops, pendings) ->
let ops =
List.map snd @@
@ -175,7 +175,7 @@ let forge_block cctxt block
let request = List.length operations in
let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in
let operations = classify_operations operations in
Client_node_rpcs.Blocks.preapply
Block_services.preapply
cctxt block ~timestamp ~sort ~proto_header operations >>=?
fun { operations = result ; shell_header } ->
let valid = List.fold_left (fun acc r -> acc + List.length r.Preapply_result.applied) 0 result in
@ -194,7 +194,7 @@ let forge_block cctxt block
let operations =
if not best_effort then operations
else List.map (fun l -> List.map snd l.Preapply_result.applied) result in
Client_node_rpcs.Blocks.info cctxt block >>=? fun {net_id} ->
Block_services.info cctxt block >>=? fun {net_id} ->
inject_block cctxt
?force ~net_id ~shell_header ~priority ~seed_nonce_hash ~src_sk
operations
@ -477,7 +477,7 @@ let bake (cctxt : Client_commands.full_context) state =
lwt_debug "Try baking after %a (slot %d) for %s (%a)"
Block_hash.pp_short bi.hash
priority name Time.pp_hum timestamp >>= fun () ->
Client_node_rpcs.Blocks.pending_operations cctxt
Block_services.pending_operations cctxt
block >>=? fun (res, ops) ->
let operations =
List.map snd @@
@ -487,7 +487,7 @@ let bake (cctxt : Client_commands.full_context) state =
let request = List.length operations in
let proto_header =
forge_faked_proto_header ~priority ~seed_nonce_hash in
Client_node_rpcs.Blocks.preapply cctxt block
Block_services.preapply cctxt block
~timestamp ~sort:true ~proto_header [operations] >>= function
| Error errs ->
lwt_log_error "Error while prevalidating operations:\n%a"
@ -559,7 +559,7 @@ let create
| None | Some (Ok [] | Error _) ->
cctxt#error "Can't fetch the current block head."
| Some (Ok (bi :: _ as initial_heads)) ->
Client_node_rpcs.Blocks.hash cctxt `Genesis >>=? fun genesis_hash ->
Block_services.hash cctxt `Genesis >>=? fun genesis_hash ->
let last_get_block = ref None in
let get_block () =
match !last_get_block with

3
src/proto_alpha/lib_client/client_baking_operations.ml
View File

@ -16,7 +16,8 @@ type operation = {
}
let monitor cctxt ?contents ?check () =
Client_node_rpcs.Operations.monitor cctxt ?contents () >>=? fun ops_stream ->
Block_services.monitor_prevalidated_operations
?contents cctxt >>=? fun (ops_stream, _) ->
let convert ops =
map_s
(fun (hash, op) ->

4
src/proto_alpha/lib_client/client_baking_revelation.ml
View File

@ -16,7 +16,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces =
(fun (level, nonce) ->
Seed_nonce_revelation { level ; nonce }) nonces in
let block = Client_rpcs.last_baked_block block in
Client_node_rpcs.Blocks.info rpc_config block >>=? fun bi ->
Block_services.info rpc_config block >>=? fun bi ->
Client_proto_rpcs.Helpers.Forge.Anonymous.operations rpc_config
block ~branch:bi.hash operations >>=? fun bytes ->
Client_node_rpcs.inject_operation
@ -27,7 +27,7 @@ let inject_seed_nonce_revelation rpc_config block ?async nonces =
let forge_seed_nonce_revelation
(cctxt: Client_commands.full_context)
block nonces =
Client_node_rpcs.Blocks.hash cctxt block >>=? fun hash ->
Block_services.hash cctxt block >>=? fun hash ->
match nonces with
| [] ->
cctxt#message "No nonce to reveal for block %a"

10
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -23,7 +23,7 @@ let rec find_predecessor rpc_config h n =
if n <= 0 then
return (`Hash h)
else
Client_node_rpcs.Blocks.predecessor rpc_config (`Hash h) >>=? fun h ->
Block_services.predecessor rpc_config (`Hash h) >>=? fun h ->
find_predecessor rpc_config h (n-1)
let get_branch rpc_config block branch =
@ -36,7 +36,7 @@ let get_branch rpc_config block branch =
| `Hash h -> find_predecessor rpc_config h branch
| `Genesis -> return `Genesis
end >>=? fun block ->
Client_node_rpcs.Blocks.info rpc_config block >>=? fun { net_id ; hash } ->
Block_services.info rpc_config block >>=? fun { net_id ; hash } ->
return (net_id, hash)
let parse_expression arg =
@ -61,7 +61,7 @@ let transfer rpc_config
rpc_config block
~branch ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee () >>=? fun bytes ->
Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
Block_services.predecessor rpc_config block >>=? fun predecessor ->
Client_keys.sign src_sk bytes >>=? fun signature ->
let signed_bytes =
MBytes.concat bytes (Ed25519.Signature.to_bytes signature) in
@ -78,7 +78,7 @@ let originate rpc_config ?net_id ~block ?signature bytes =
match signature with
| None -> bytes
| Some signature -> Ed25519.Signature.concat bytes signature in
Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
Block_services.predecessor rpc_config block >>=? fun predecessor ->
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_proto_rpcs.Helpers.apply_operation rpc_config block
predecessor oph bytes signature >>=? function
@ -178,7 +178,7 @@ let get_manager (cctxt : Client_commands.full_context) block source =
let dictate rpc_config block command seckey =
let block = Client_rpcs.last_baked_block block in
Client_node_rpcs.Blocks.info
Block_services.info
rpc_config block >>=? fun { net_id ; hash = branch } ->
Client_proto_rpcs.Helpers.Forge.Dictator.operation
rpc_config block ~branch command >>=? fun bytes ->

2
src/proto_alpha/lib_client/client_proto_context_commands.ml
View File

@ -48,7 +48,7 @@ let commands () =
no_options
(fixed [ "get" ; "timestamp" ])
begin fun () (cctxt : Client_commands.full_context) ->
Client_node_rpcs.Blocks.timestamp
Block_services.timestamp
cctxt cctxt#block >>=? fun v ->
cctxt#message "%s" (Time.to_notation v) >>= fun () ->
return ()

6
src/proto_alpha/lib_client/client_proto_rpcs.ml
View File

@ -21,10 +21,10 @@ let handle_error (cctxt : #Client_commands.logger) = function
let call_service0 cctxt s block =
Client_rpcs.call_service0 cctxt
(s Block_services.proto_path) block
(s Block_services.S.proto_path) block
let call_service1 cctxt s block a1 =
Client_rpcs.call_service1 cctxt
(s Block_services.proto_path) block a1
(s Block_services.S.proto_path) block a1
let call_error_service1 cctxt s block a1 =
call_service1 cctxt s block a1 >>= function
| Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err)
@ -32,7 +32,7 @@ let call_error_service1 cctxt s block a1 =
| Error _ as err -> Lwt.return err
let call_service2 cctxt s block a1 a2 =
Client_rpcs.call_service2 cctxt
(s Block_services.proto_path) block a1 a2
(s Block_services.S.proto_path) block a1 a2
let call_error_service2 cctxt s block a1 a2 =
call_service2 cctxt s block a1 a2 >>= function
| Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err)

2
src/proto_alpha/lib_client/test/jbuild
View File

@ -8,6 +8,7 @@
test_vote))
(libraries (tezos-base
tezos-rpc-http
tezos-shell-services
tezos-client-base
tezos-client-genesis
tezos-client-alpha
@ -16,6 +17,7 @@
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_rpc_http
-open Tezos_shell_services
-open Tezos_client_base
-open Tezos_client_genesis
-open Tezos_client_alpha))))

8
src/proto_alpha/lib_client/test/proto_alpha_helpers.ml
View File

@ -235,7 +235,7 @@ module Protocol = struct
Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block
let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals =
Client_node_rpcs.Blocks.info (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_info ->
Block_services.info (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_info ->
Client_proto_rpcs.Context.next_level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.proposals (new Client_rpcs.http_ctxt !rpc_config) block
~branch:block_info.hash
@ -248,7 +248,7 @@ module Protocol = struct
let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot =
let rpc = new Client_rpcs.http_ctxt !rpc_config in
Client_node_rpcs.Blocks.info rpc block >>=? fun block_info ->
Block_services.info rpc block >>=? fun block_info ->
Client_proto_rpcs.Context.next_level rpc block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.ballot rpc block
~branch:block_info.hash
@ -388,7 +388,7 @@ module Assert = struct
end
let check_protocol ?msg ~block h =
Client_node_rpcs.Blocks.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto ->
Block_services.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto ->
return @@ Assert.equal
?msg:(Assert.format_msg msg)
~prn:Protocol_hash.to_b58check
@ -445,7 +445,7 @@ module Endorse = struct
slot =
let block = Client_rpcs.last_baked_block block in
let rpc = new Client_rpcs.http_ctxt !rpc_config in
Client_node_rpcs.Blocks.info rpc block >>=? fun { hash ; _ } ->
Block_services.info rpc block >>=? fun { hash ; _ } ->
Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc
block
~branch:hash

16
src/proto_alpha/lib_client/test/proto_alpha_helpers.mli
View File

@ -97,13 +97,13 @@ end
module Baking : sig
val bake:
Client_node_rpcs.Blocks.block ->
Block_services.block ->
Account.t ->
Operation.raw list ->
Block_hash.t tzresult Lwt.t
val endorsement_reward:
Client_node_rpcs.Blocks.block -> int64 tzresult Lwt.t
Block_services.block -> int64 tzresult Lwt.t
end
@ -130,13 +130,13 @@ end
module Protocol : sig
val proposals :
?block:Client_node_rpcs.Blocks.block ->
?block:Block_services.block ->
src:Account.t ->
Protocol_hash.t list ->
Operation.raw tzresult Lwt.t
val ballot :
?block:Client_node_rpcs.Blocks.block ->
?block:Block_services.block ->
src:Account.t ->
proposal:Protocol_hash.t ->
Vote.ballot ->
@ -149,10 +149,10 @@ module Assert : sig
include module type of Assert
val balance_equal:
?block:Client_node_rpcs.Blocks.block ->
?block:Block_services.block ->
msg:string -> Account.t -> int64 -> unit tzresult Lwt.t
val delegate_equal:
?block:Client_node_rpcs.Blocks.block ->
?block:Block_services.block ->
msg:string -> Contract.t -> public_key_hash option -> unit tzresult Lwt.t
val failed_to_preapply:
@ -191,11 +191,11 @@ module Assert : sig
val wrong_delegate : msg:string -> 'a tzresult -> unit
val check_protocol :
?msg:string -> block:Client_node_rpcs.Blocks.block ->
?msg:string -> block:Block_services.block ->
Protocol_hash.t -> unit tzresult Lwt.t
val check_voting_period_kind :
?msg:string -> block:Client_node_rpcs.Blocks.block ->
?msg:string -> block:Block_services.block ->
Voting_period.kind -> unit tzresult Lwt.t
end

4
src/proto_genesis/lib_client/client_proto_main.ml
View File

@ -15,7 +15,7 @@ let protocol =
let call_service1 rpc_config s block a1 =
Client_rpcs.call_service1 rpc_config
(s Block_services.proto_path) block a1
(s Block_services.S.proto_path) block a1
let call_error_service1 rpc_config s block a1 =
call_service1 rpc_config s block a1 >>= function
@ -26,7 +26,7 @@ let call_error_service1 rpc_config s block a1 =
let bake rpc_config ?(timestamp = Time.now ()) block command sk =
let block = Client_rpcs.last_baked_block block in
let proto_header = Data_encoding.Binary.to_bytes Data.Command.encoding command in
Client_node_rpcs.Blocks.preapply
Block_services.preapply
rpc_config block ~timestamp ~proto_header [] >>=? fun { shell_header } ->
let blk =
Data_encoding.Binary.to_bytes Block_header.encoding

2
src/proto_genesis/lib_client/client_proto_main.mli
View File

@ -12,7 +12,7 @@ open Proto_genesis
val bake:
#Client_rpcs.ctxt ->
?timestamp: Time.t ->
Client_node_rpcs.Blocks.block ->
Block_services.block ->
Data.Command.t ->
Client_keys.sk_locator ->
Block_hash.t tzresult Lwt.t