Shell/Distributed_db: make initial request delay depend on resource kind

src/lib_shell/distributed_db.ml

@@ -53,6 +53,7 @@ module Make_raw
     (Request_message : sig
        type param
        val max_length : int
+       val initial_delay : float
        val forge : param -> Hash.t list -> Message.t
      end)
     (Precheck : Distributed_db_functors.PRECHECK
@@ -62,6 +63,8 @@ module Make_raw
   module Request = struct
     type param = Request_message.param request_param
     let active { active } = active ()
+    let initial_delay  = Request_message.initial_delay
+
     let rec send state gid keys =
       let first_keys, keys = List.split_n Request_message.max_length keys in
       let msg = (Request_message.forge state.data first_keys) in
@@ -78,7 +81,6 @@ module Make_raw
         | _ -> Other in
       let meta = P2p.get_peer_metadata state.p2p gid in
       Peer_metadata.incr meta @@ Scheduled_request req ;
-      (* TODO update peer_metadata *)
       if keys <> [] then send state gid keys
   end
 
@@ -121,6 +123,7 @@ module Raw_operation =
     (struct
       type param = unit
       let max_length = 10
+      let initial_delay = 0.5
       let forge () keys = Message.Get_operations keys
     end)
     (struct
@@ -152,6 +155,7 @@ module Raw_block_header =
     (struct
       type param = unit
       let max_length = 10
+      let initial_delay = 0.5
       let forge () keys = Message.Get_block_headers keys
     end)
     (struct
@@ -208,6 +212,7 @@ module Raw_operation_hashes = struct
       (struct
         type param = unit
         let max_length = 10
+        let initial_delay = 1.
         let forge () keys =
           Message.Get_operation_hashes_for_blocks keys
       end)
@@ -280,6 +285,7 @@ module Raw_operations = struct
       (struct
         type param = unit
         let max_length = 10
+        let initial_delay = 1.
         let forge () keys =
           Message.Get_operations_for_blocks keys
       end)
@@ -329,6 +335,7 @@ module Raw_protocol =
     (Protocol_hash.Table)
     (struct
       type param = unit
+      let initial_delay = 10.
       let max_length = 10
       let forge () keys = Message.Get_protocols keys
     end)

src/lib_shell/distributed_db_functors.ml

@@ -327,6 +327,7 @@ end
 module type REQUEST = sig
   type key
   type param
+  val initial_delay : float
   val active : param -> P2p_peer.Set.t
   val send : param -> P2p_peer.Id.t -> key list -> unit
 end
@@ -436,8 +437,6 @@ end = struct
           Lwt_unix.sleep delay
         end
 
-  (* TODO should depend on the ressource kind... *)
-  let initial_delay = 0.5
 
   let process_event state now = function
     | Request (peer, key) -> begin
@@ -453,8 +452,8 @@ end = struct
             | None -> data.peers
             | Some peer -> P2p_peer.Set.add peer data.peers in
           Table.replace state.pending key {
-            delay = initial_delay ;
-            next_request = min data.next_request (now +. initial_delay) ;
+            delay = Request.initial_delay ;
+            next_request = min data.next_request (now +. Request.initial_delay) ;
             peers ;
           } ;
           lwt_debug Tag.DSL.(fun f ->
@@ -471,7 +470,7 @@ end = struct
           Table.add state.pending key {
             peers ;
             next_request = now ;
-            delay = initial_delay ;
+            delay = Request.initial_delay ;
           } ;
           lwt_debug Tag.DSL.(fun f ->
               f "registering request %a from %a -> added"

src/lib_shell/distributed_db_functors.mli

@@ -179,6 +179,7 @@ end
 module type REQUEST = sig
   type key
   type param
+  val initial_delay : float
   val active : param -> P2p_peer.Set.t
   val send : param -> P2p_peer.Id.t -> key list -> unit
 end