Distributed_db: randomly selecting peer

This commit is contained in:
Grégoire Henry 2017-09-29 18:43:13 +02:00 committed by Benjamin Canou
parent c05c739475
commit 616ca33498
3 changed files with 30 additions and 13 deletions

View File

@ -364,23 +364,19 @@ end = struct
not (P2p.Peer_id.Set.is_empty peers) then not (P2p.Peer_id.Set.is_empty peers) then
( Table.remove state.pending key ; acc ) ( Table.remove state.pending key ; acc )
else else
let requested_peers = let requested_peer =
if P2p.Peer_id.Set.is_empty remaining_peers P2p.Peer_id.random_set_elt
(if P2p.Peer_id.Set.is_empty remaining_peers
then active_peers then active_peers
else remaining_peers else remaining_peers) in
in
let next = { peers = remaining_peers ; let next = { peers = remaining_peers ;
next_request = now +. delay ; next_request = now +. delay ;
delay = delay *. 1.2 } in delay = delay *. 1.2 } in
Table.replace state.pending key next ; Table.replace state.pending key next ;
P2p.Peer_id.Set.fold
(fun gid acc ->
let requests = let requests =
try key :: P2p_types.Peer_id.Map.find gid acc try key :: P2p_types.Peer_id.Map.find requested_peer acc
with Not_found -> [key] in with Not_found -> [key] in
P2p_types.Peer_id.Map.add gid requests acc) P2p_types.Peer_id.Map.add requested_peer requests acc)
requested_peers
acc)
state.pending P2p_types.Peer_id.Map.empty in state.pending P2p_types.Peer_id.Map.empty in
P2p_types.Peer_id.Map.iter (Request.send state.param) requests ; P2p_types.Peer_id.Map.iter (Request.send state.param) requests ;
worker_loop state worker_loop state

View File

@ -105,6 +105,7 @@ module type INTERNAL_HASH = sig
?desc:string -> ?desc:string ->
('a, 'arg, 'ret) Cli_entries.params -> ('a, 'arg, 'ret) Cli_entries.params ->
(t -> 'a, 'arg, 'ret) Cli_entries.params (t -> 'a, 'arg, 'ret) Cli_entries.params
val random_set_elt: Set.t -> t
module Table : Hashtbl.S with type key = t module Table : Hashtbl.S with type key = t
end end
@ -325,6 +326,14 @@ module Make_Blake2B (R : sig
module Set = struct module Set = struct
include Set.Make(struct type nonrec t = t let compare = compare end) include Set.Make(struct type nonrec t = t let compare = compare end)
exception Found of elt
let random_elt s =
let n = Random.int (cardinal s) in
try
ignore
(fold (fun x i -> if i = n then raise (Found x) ; i+1) s 0 : int) ;
assert false
with Found x -> x
let encoding = let encoding =
Data_encoding.conv Data_encoding.conv
elements elements
@ -332,6 +341,8 @@ module Make_Blake2B (R : sig
Data_encoding.(list encoding) Data_encoding.(list encoding)
end end
let random_set_elt = Set.random_elt
module Map = struct module Map = struct
include Map.Make(struct type nonrec t = t let compare = compare end) include Map.Make(struct type nonrec t = t let compare = compare end)
let encoding arg_encoding = let encoding arg_encoding =
@ -631,12 +642,21 @@ module Net_id = struct
module Set = struct module Set = struct
include Set.Make(struct type nonrec t = t let compare = compare end) include Set.Make(struct type nonrec t = t let compare = compare end)
exception Found of elt
let random_elt s =
let n = Random.int (cardinal s) in
try
ignore
(fold (fun x i -> if i = n then raise (Found x) ; i+1) s 0 : int) ;
assert false
with Found x -> x
let encoding = let encoding =
Data_encoding.conv Data_encoding.conv
elements elements
(fun l -> List.fold_left (fun m x -> add x m) empty l) (fun l -> List.fold_left (fun m x -> add x m) empty l)
Data_encoding.(list encoding) Data_encoding.(list encoding)
end end
let random_set_elt = Set.random_elt
module Map = struct module Map = struct
include Map.Make(struct type nonrec t = t let compare = compare end) include Map.Make(struct type nonrec t = t let compare = compare end)

View File

@ -96,6 +96,7 @@ module type INTERNAL_HASH = sig
?desc:string -> ?desc:string ->
('a, 'arg, 'ret) Cli_entries.params -> ('a, 'arg, 'ret) Cli_entries.params ->
(t -> 'a, 'arg, 'ret) Cli_entries.params (t -> 'a, 'arg, 'ret) Cli_entries.params
val random_set_elt: Set.t -> t
module Table : Hashtbl.S with type key = t module Table : Hashtbl.S with type key = t
end end