diff --git a/src/lib_shell/block_directory.ml b/src/lib_shell/block_directory.ml index 20fb8e913..6c8c141d2 100644 --- a/src/lib_shell/block_directory.ml +++ b/src/lib_shell/block_directory.ml @@ -54,6 +54,14 @@ let build_raw_rpc_directory return (State.Block.hash block) end ; + register0 S.live_blocks begin fun block () () -> + Chain_traversal.live_blocks + block + (State.Block.max_operations_ttl block) + >>= fun (live_blocks, _) -> + return live_blocks + end ; + (* block header *) register0 S.header begin fun block () () -> diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml index 1ac124559..5f75f145b 100644 --- a/src/lib_shell_services/block_services.ml +++ b/src/lib_shell_services/block_services.ml @@ -76,6 +76,7 @@ type chain_prefix = unit * chain type prefix = chain_prefix * block let chain_path = RPC_path.(root / "chains" /: chain_arg) let mempool_path p = RPC_path.(p / "mempool") +let live_blocks_path p = RPC_path.(p / "live_blocks") let dir_path : (chain_prefix, chain_prefix) RPC_path.t = RPC_path.(open_root / "blocks") let path = RPC_path.(dir_path /: blocks_arg) @@ -664,6 +665,16 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct end + let live_blocks = + RPC_service.get_service + ~description:"List the ancestors of the given block which, if \ + referred to as the branch in an operation \ + header, are recent enough for that operation to \ + be included in the current block." + ~query: RPC_query.empty + ~output: Block_hash.Set.encoding + RPC_path.(live_blocks_path open_root) + end let path = RPC_path.prefix chain_path path @@ -845,6 +856,11 @@ module Make(Proto : PROTO)(Next_proto : PROTO) = struct end + let live_blocks ctxt = + let f = make_call0 S.live_blocks ctxt in + fun ?(chain = `Main) ?(block = `Head 0) () -> + f chain block () () + end module Fake_protocol = struct diff --git a/src/lib_shell_services/block_services.mli b/src/lib_shell_services/block_services.mli index 551484c27..144cdfcaf 100644 --- a/src/lib_shell_services/block_services.mli +++ b/src/lib_shell_services/block_services.mli @@ -33,6 +33,7 @@ type prefix = (unit * chain) * block val dir_path: (chain_prefix, chain_prefix) RPC_path.t val path: (chain_prefix, chain_prefix * block) RPC_path.t val mempool_path : ('a, 'b) RPC_path.t -> ('a, 'b) RPC_path.t +val live_blocks_path : ('a, 'b) RPC_path.t -> ('a, 'b) RPC_path.t type operation_list_quota = { max_size: int ; @@ -236,6 +237,12 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig end + val live_blocks: + #simple -> + ?chain:chain -> + ?block:block -> + unit -> Block_hash.Set.t tzresult Lwt.t + module S : sig val hash: @@ -376,6 +383,11 @@ module Make(Proto : PROTO)(Next_proto : PROTO) : sig end + val live_blocks: + ([ `GET ], prefix, + prefix, unit, unit, + Block_hash.Set.t) RPC_service.t + end end