From 616ca334985abd450ffb63bd1147c366a2b3dc07 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= <gregoire.henry@ocamlpro.com>
Date: Fri, 29 Sep 2017 18:43:13 +0200
Subject: [PATCH] Distributed_db: randomly selecting peer

---
 src/node/shell/distributed_db_functors.ml | 22 +++++++++-------------
 src/utils/hash.ml                         | 20 ++++++++++++++++++++
 src/utils/hash.mli                        |  1 +
 3 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/src/node/shell/distributed_db_functors.ml b/src/node/shell/distributed_db_functors.ml
index 01255b07a..c50635b5e 100644
--- a/src/node/shell/distributed_db_functors.ml
+++ b/src/node/shell/distributed_db_functors.ml
@@ -364,23 +364,19 @@ end = struct
                   not (P2p.Peer_id.Set.is_empty peers) then
                  ( Table.remove state.pending key ; acc )
                else
-                 let requested_peers =
-                   if P2p.Peer_id.Set.is_empty remaining_peers
-                   then active_peers
-                   else remaining_peers
-                 in
+                 let requested_peer =
+                   P2p.Peer_id.random_set_elt
+                     (if P2p.Peer_id.Set.is_empty remaining_peers
+                      then active_peers
+                      else remaining_peers) in
                  let next = { peers = remaining_peers ;
                               next_request = now +. delay ;
                               delay = delay *. 1.2 } in
                  Table.replace state.pending key next ;
-                 P2p.Peer_id.Set.fold
-                   (fun gid acc ->
-                      let requests =
-                        try key :: P2p_types.Peer_id.Map.find gid acc
-                        with Not_found -> [key] in
-                      P2p_types.Peer_id.Map.add gid requests acc)
-                   requested_peers
-                   acc)
+                 let requests =
+                   try key :: P2p_types.Peer_id.Map.find requested_peer acc
+                   with Not_found -> [key] in
+                 P2p_types.Peer_id.Map.add requested_peer requests acc)
           state.pending P2p_types.Peer_id.Map.empty in
       P2p_types.Peer_id.Map.iter (Request.send state.param) requests ;
       worker_loop state
diff --git a/src/utils/hash.ml b/src/utils/hash.ml
index 388a90da3..f7533996d 100644
--- a/src/utils/hash.ml
+++ b/src/utils/hash.ml
@@ -105,6 +105,7 @@ module type INTERNAL_HASH = sig
     ?desc:string ->
     ('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
 end
 
@@ -325,6 +326,14 @@ module Make_Blake2B (R : sig
 
   module Set = struct
     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 =
       Data_encoding.conv
         elements
@@ -332,6 +341,8 @@ module Make_Blake2B (R : sig
         Data_encoding.(list encoding)
   end
 
+  let random_set_elt = Set.random_elt
+
   module Map = struct
     include Map.Make(struct type nonrec t = t let compare = compare end)
     let encoding arg_encoding =
@@ -631,12 +642,21 @@ module Net_id = struct
 
   module Set = struct
     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 =
       Data_encoding.conv
         elements
         (fun l -> List.fold_left (fun m x -> add x m) empty l)
         Data_encoding.(list encoding)
   end
+  let random_set_elt = Set.random_elt
 
   module Map = struct
     include Map.Make(struct type nonrec t = t let compare = compare end)
diff --git a/src/utils/hash.mli b/src/utils/hash.mli
index f028101ca..a5437d2a9 100644
--- a/src/utils/hash.mli
+++ b/src/utils/hash.mli
@@ -96,6 +96,7 @@ module type INTERNAL_HASH = sig
     ?desc:string ->
     ('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
 end