Moved BucketRefresher construction responsibility for greater

encapsulation.

1 files changed, 34 insertions, 0 deletions

diff --git a/src/Network/Kademlia/Bootstrap.hs b/src/Network/Kademlia/Bootstrap.hs
index 92a20ca5..87fdc22f 100644
--- a/src/Network/Kademlia/Bootstrap.hs
+++ b/src/Network/Kademlia/Bootstrap.hs
@@ -32,6 +32,7 @@ import Data.IP
 import Data.Monoid
 import Data.Serialize                 (Serialize)
 import Data.Time.Clock.POSIX          (POSIXTime)
+import Data.Ord
 import System.Entropy
 import System.Timeout
 import Text.PrettyPrint               as PP hiding (($$), (<>))
@@ -72,6 +73,39 @@ data BucketRefresher nid ni = forall tok addr. Ord addr =>  BucketRefresher
     , refreshPing     :: ni -> IO Bool
     }
 
+newBucketRefresher :: (Ord addr, Ord a, Hashable a)
+                    => KademliaSpace a ni
+                    -> ni
+                    -> Search nid addr tok ni ni
+                    -> (ni -> IO Bool)
+                    -> STM (BucketRefresher nid ni)
+newBucketRefresher spc template_ni sch ping = do
+    let nodeId = kademliaLocation spc
+    bkts <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) template_ni R.defaultBucketCount
+    sched <- newTVar Int.empty
+    return  BucketRefresher
+                    { refreshInterval = 15 * 60
+                    , refreshQueue    = sched
+                    , refreshSearch   = sch
+                    , refreshBuckets  = bkts
+                    , refreshPing     = ping
+                    }
+
+-- | This was added to avoid the compile error "Record update for
+-- insufficiently polymorphic field" when trying to update the existentially
+-- quantified field 'refreshSearch'.
+updateRefresherIO :: Ord addr
+                     => Search nid addr tok ni ni
+                     -> (ni -> IO Bool)
+                     -> BucketRefresher nid ni ->  BucketRefresher nid ni
+updateRefresherIO sch ping BucketRefresher{..} = BucketRefresher
+    { refreshSearch   = sch
+    , refreshPing     = ping
+    , refreshInterval = refreshInterval
+    , refreshBuckets  = refreshBuckets
+    , refreshQueue    = refreshQueue
+    }
+
 -- | Fork a refresh loop.  Kill the returned thread to terminate it.
 forkPollForRefresh :: SensibleNodeId nid ni => BucketRefresher nid ni -> IO ThreadId
 forkPollForRefresh BucketRefresher{ refreshInterval