1 files changed, 22 insertions, 2 deletions

diff --git a/src/Network/Kademlia/Bootstrap.hs b/src/Network/Kademlia/Bootstrap.hs
index b71704d9..f160000d 100644
--- a/src/Network/Kademlia/Bootstrap.hs
+++ b/src/Network/Kademlia/Bootstrap.hs
@@ -146,8 +146,10 @@ forkPollForRefresh r@BucketRefresher{ refreshInterval
         case fromEnum (refresh_time - now) of
             x | x <= 0 -> do -- Refresh time!
                              -- Move it to the back of the refresh queue.
-                             atomically $ modifyTVar' refreshQueue
-                                        $ Int.insert bktnum (now + refreshInterval)
+                             atomically $ do
+                                interval <- effectiveRefreshInterval r bktnum
+                                modifyTVar' refreshQueue
+                                            $ Int.insert bktnum (now + interval)
                              -- Now fork the refresh operation.
                              -- TODO: We should probably propogate the kill signal to this thread.
                              fork $ do myThreadId >>= flip labelThread ("refresh."++show bktnum)
@@ -262,6 +264,24 @@ bootstrap r@BucketRefresher { refreshSearch  = sch
     -- maintenance.
 
 
+effectiveRefreshInterval :: BucketRefresher nid ni -> Int -> STM POSIXTime
+effectiveRefreshInterval BucketRefresher{ refreshInterval
+                                        , refreshBuckets
+                                        , bootstrapMode   } num = do
+    tbl <- readTVar refreshBuckets
+    bootstrapping <- readTVar bootstrapMode
+    case bootstrapping of
+        False -> return refreshInterval
+        True  -> do
+            -- When bootstrapping, refresh interval for non-full buckets is only 15 seconds.
+            let fullcount = R.defaultBucketSize
+                count = fromMaybe fullcount $ listToMaybe $ drop (num - 1) $ R.shape tbl
+            if count == fullcount
+                then return refreshInterval
+                else return 15 -- seconds
+
+
+
 -- | Reschedule a bucket's refresh-time.  It should be called whenever a bucket
 -- changes.  This will typically be invoked from 'tblTransition'.
 --