Client/Shell: filter heads by date

src/client/client_node_rpcs.ml

@@ -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 }
+      { operations; length ; heads ; monitor = Some false ; delay ;
-  let monitor ?operations ?length ?heads ?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

src/client/client_node_rpcs.mli

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

src/client/embedded/bootstrap/mining/client_mining_blocks.ml

@@ -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 () =
+let monitor
-  Client_node_rpcs.Blocks.monitor ?operations ?length ?heads ?delay
+    ?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)

src/client/embedded/bootstrap/mining/client_mining_blocks.mli

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

src/client/embedded/bootstrap/mining/client_mining_daemon.ml

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

src/client/embedded/bootstrap/mining/client_mining_daemon.mli

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

src/client/embedded/bootstrap/mining/client_mining_main.ml

@@ -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 () =

src/node/shell/node_rpc.ml

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

src/node/shell/node_rpc_services.ml

@@ -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} ->
+      (fun { operations ; length ; heads ; monitor ;
-         (operations,length,heads,monitor,delay))
+             delay ; min_date ; min_heads } ->
-      (fun (operations,length,heads,monitor,delay) ->
+         (operations, length, heads, monitor, delay, min_date, min_heads))
-         {operations;length;heads;monitor;delay})
+      (fun (operations, length, heads, monitor, delay, min_date, min_heads) ->
-      (obj5
+         { 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 =

src/node/shell/node_rpc_services.mli

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