diff --git a/src/lib_shell/distributed_db.ml b/src/lib_shell/distributed_db.ml index b99f4cad0..2d54cff6f 100644 --- a/src/lib_shell/distributed_db.ml +++ b/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) diff --git a/src/lib_shell/distributed_db_functors.ml b/src/lib_shell/distributed_db_functors.ml index bbb237865..311abe678 100644 --- a/src/lib_shell/distributed_db_functors.ml +++ b/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" diff --git a/src/lib_shell/distributed_db_functors.mli b/src/lib_shell/distributed_db_functors.mli index 68f5fb07e..a5a93e0bb 100644 --- a/src/lib_shell/distributed_db_functors.mli +++ b/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