Client/Shell: filter heads by date

This commit is contained in:
Çağdaş Bozman 2016-09-21 16:22:43 +02:00 committed by Grégoire Henry
parent 03d37bfdeb
commit 4a7eb60631
10 changed files with 61 additions and 18 deletions

View File

@ -194,12 +194,14 @@ module Blocks = struct
call_service1 Services.Blocks.pending_operations block ()
let info ?(operations = false) h =
call_service1 Services.Blocks.info h operations
let list ?operations ?length ?heads ?delay () =
let list ?operations ?length ?heads ?delay ?min_date ?min_heads () =
call_service0 Services.Blocks.list
{ operations; length ; heads ; monitor = Some false ; delay }
let monitor ?operations ?length ?heads ?delay () =
{ operations; length ; heads ; monitor = Some false ; delay ;
min_date ; min_heads }
let monitor ?operations ?length ?heads ?delay ?min_date ?min_heads () =
call_streamed_service0 Services.Blocks.list
{ operations; length ; heads ; monitor = Some true ; delay }
{ operations; length ; heads ; monitor = Some true ; delay ;
min_date ; min_heads }
end
module Operations = struct

View File

@ -64,11 +64,13 @@ module Blocks : sig
?operations:bool -> block -> block_info Lwt.t
val list:
?operations:bool -> ?length:int -> ?heads:Block_hash.t list -> ?delay:int ->
?operations:bool -> ?length:int -> ?heads:Block_hash.t list ->
?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
unit -> block_info list list Lwt.t
val monitor:
?operations:bool -> ?length:int -> ?heads:Block_hash.t list -> ?delay:int ->
?operations: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 Lwt.t
type preapply_result = {

View File

@ -54,8 +54,11 @@ let sort_blocks ?(compare = compare) blocks =
let blocks = Utils.unopt_list blocks in
List.sort compare blocks
let monitor ?operations ?length ?heads ?delay ?compare () =
Client_node_rpcs.Blocks.monitor ?operations ?length ?heads ?delay
let monitor
?operations ?length ?heads ?delay
?min_date ?min_heads ?compare () =
Client_node_rpcs.Blocks.monitor
?operations ?length ?heads ?delay ?min_date ?min_heads
() >>= fun block_stream ->
let convert blocks = sort_blocks ?compare (List.flatten blocks) in
Lwt.return (Lwt_stream.map_s convert block_stream)

View File

@ -22,7 +22,8 @@ val info:
val compare: block_info -> block_info -> int
val monitor:
?operations:bool -> ?length:int -> ?heads:Block_hash.t list -> ?delay:int ->
?operations:bool -> ?length:int -> ?heads:Block_hash.t list ->
?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
?compare:(block_info -> block_info -> int) ->
unit -> block_info list Lwt_stream.t Lwt.t

View File

@ -9,11 +9,11 @@
open Logging.Client.Mining
let run ?max_priority ~delay delegates =
let run ?max_priority ~delay ?min_date delegates =
(* TODO really detach... *)
let endorsement =
if Client_proto_args.Daemon.(!all || !endorsement) then
Client_mining_blocks.monitor () >>= fun block_stream ->
Client_mining_blocks.monitor ?min_date () >>= fun block_stream ->
Client_mining_endorsement.create ~delay delegates block_stream
else
Lwt.return_unit
@ -26,7 +26,7 @@ let run ?max_priority ~delay delegates =
Lwt.return_unit
in
let forge =
Client_mining_blocks.monitor () >>= fun block_stream ->
Client_mining_blocks.monitor ?min_date () >>= fun block_stream ->
Client_mining_operations.monitor_endorsement () >>= fun endorsement_stream ->
if Client_proto_args.Daemon.(!all || !mining) then
Client_mining_forge.create

View File

@ -10,4 +10,5 @@
val run:
?max_priority: int ->
delay: int ->
?min_date: Time.t ->
public_key_hash list -> unit Lwt.t

View File

@ -105,6 +105,7 @@ let run_daemon delegates =
Client_mining_daemon.run
?max_priority:!max_priority
~delay:!endorsement_delay
~min_date:((Time.add (Time.now ()) (Int64.neg 1800L)))
(List.map snd delegates)
let commands () =

View File

@ -205,10 +205,12 @@ let create_delayed_stream
let list_blocks
node
{ Services.Blocks.operations ; length ; heads ; monitor ; delay } =
{ Services.Blocks.operations ; length ; heads ; monitor ; delay ;
min_date; min_heads} =
let include_ops = match operations with None -> false | Some x -> x in
let len = match length with None -> 1 | Some x -> x in
let monitor = match monitor with None -> false | Some x -> x in
let time =
match delay with
| None -> None
@ -218,6 +220,20 @@ let list_blocks
| None ->
Node.RPC.heads node >>= fun heads ->
let heads = List.map snd (Block_hash_map.bindings heads) in
let heads =
match min_date with
| None -> heads
| Some date ->
let min_heads =
match min_heads with
| None -> 0
| Some min_heads -> min_heads in
snd @@
List.fold_left (fun (min_heads, acc) (bi : Node.RPC.block_info) ->
min_heads - 1,
if Time.(>) bi.timestamp date || min_heads > 0 then bi :: acc
else acc)
(min_heads, []) heads in
begin
match time with
| None -> Lwt.return heads

View File

@ -261,14 +261,18 @@ module Blocks = struct
heads: Block_hash.t list option ;
monitor: bool option ;
delay: int option ;
min_date: Time.t option;
min_heads: int option;
}
let list_param_encoding =
conv
(fun {operations;length;heads;monitor;delay} ->
(operations,length,heads,monitor,delay))
(fun (operations,length,heads,monitor,delay) ->
{operations;length;heads;monitor;delay})
(obj5
(fun { operations ; length ; heads ; monitor ;
delay ; min_date ; min_heads } ->
(operations, length, heads, monitor, delay, min_date, min_heads))
(fun (operations, length, heads, monitor, delay, min_date, min_heads) ->
{ operations ; length ; heads ; monitor ;
delay ; min_date ; min_heads })
(obj7
(opt "operations"
(Data_encoding.describe
~description:
@ -302,6 +306,17 @@ module Blocks = struct
When this optional argument is 0, only blocks with a \
timestamp in the past are considered. Other values allows to \
adjust the current time."
int31))
(opt "min_date"
(Data_encoding.describe
~description: "When `min_date` is provided, heads with a \
timestamp before `min_date` are filtered ouf"
Time.encoding))
(opt "min_heads"
(Data_encoding.describe
~description:"When `min_date` is provided, returns at least \
`min_heads` even when their timestamp is before \
`min_date`."
int31)))
let list =

View File

@ -61,6 +61,8 @@ module Blocks : sig
heads: Block_hash.t list option ;
monitor: bool option ;
delay: int option ;
min_date: Time.t option;
min_heads: int option;
}
val list:
(unit, unit, list_param, block_info list list) RPC.service