summaryrefslogtreecommitdiff
path: root/src/Network/Kademlia/Bootstrap.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Kademlia/Bootstrap.hs')
-rw-r--r--src/Network/Kademlia/Bootstrap.hs22
1 files changed, 11 insertions, 11 deletions
diff --git a/src/Network/Kademlia/Bootstrap.hs b/src/Network/Kademlia/Bootstrap.hs
index d77f524c..4197e06e 100644
--- a/src/Network/Kademlia/Bootstrap.hs
+++ b/src/Network/Kademlia/Bootstrap.hs
@@ -143,7 +143,7 @@ forkPollForRefresh r@BucketRefresher{ refreshInterval
143 where 143 where
144 refresh :: Int -> IO Int 144 refresh :: Int -> IO Int
145 refresh n = do 145 refresh n = do
146 -- hPutStrLn stderr $ "Refresh time! "++ show n 146 -- dput XRefresh $ "Refresh time! "++ show n
147 refreshBucket r n 147 refreshBucket r n
148 148
149 go again ( bktnum :-> refresh_time ) = do 149 go again ( bktnum :-> refresh_time ) = do
@@ -162,7 +162,7 @@ forkPollForRefresh r@BucketRefresher{ refreshInterval
162 return () 162 return ()
163 return () 163 return ()
164 picoseconds -> do 164 picoseconds -> do
165 -- hPutStrLn stderr $ show (picoseconds `div` 10^12) ++ " seconds until refresh " ++ show bktnum 165 -- dput XRefresh $ show (picoseconds `div` 10^12) ++ " seconds until refresh " ++ show bktnum
166 threadDelay ( picoseconds `div` 10^6 ) 166 threadDelay ( picoseconds `div` 10^6 )
167 again 167 again
168 168
@@ -202,13 +202,13 @@ onFinishedRefresh BucketRefresher { bootstrapCountdown
202 , refreshQueue 202 , refreshQueue
203 , refreshBuckets } num now = do 203 , refreshBuckets } num now = do
204 bootstrapping <- readTVar bootstrapMode 204 bootstrapping <- readTVar bootstrapMode
205 if not bootstrapping then return $ return () -- hPutStrLn stderr $ "Finished non-boostrapping refresh: "++show num 205 if not bootstrapping then return $ return () -- dput XRefresh $ "Finished non-boostrapping refresh: "++show num
206 else do 206 else do
207 tbl <- readTVar refreshBuckets 207 tbl <- readTVar refreshBuckets
208 action <- 208 action <-
209 if num /= R.bktCount tbl - 1 209 if num /= R.bktCount tbl - 1
210 then do modifyTVar' bootstrapCountdown (fmap pred) 210 then do modifyTVar' bootstrapCountdown (fmap pred)
211 return $ return () -- hPutStrLn stderr $ "BOOTSTRAP decrement" 211 return $ return () -- dput XRefresh $ "BOOTSTRAP decrement"
212 else do 212 else do
213 -- The last bucket finished. 213 -- The last bucket finished.
214 cnt <- readTVar bootstrapCountdown 214 cnt <- readTVar bootstrapCountdown
@@ -225,17 +225,17 @@ onFinishedRefresh BucketRefresher { bootstrapCountdown
225 -- Schedule immediate refresh for unfull buckets (other than this one). 225 -- Schedule immediate refresh for unfull buckets (other than this one).
226 modifyTVar' refreshQueue $ Int.insert n (now - 1) 226 modifyTVar' refreshQueue $ Int.insert n (now - 1)
227 writeTVar bootstrapCountdown $! Just $! length unfull 227 writeTVar bootstrapCountdown $! Just $! length unfull
228 return $ return () -- hPutStrLn stderr $ "BOOTSTRAP scheduling: "++show unfull 228 return $ return () -- dput XRefresh $ "BOOTSTRAP scheduling: "++show unfull
229 Just n -> do writeTVar bootstrapCountdown $! Just $! pred n 229 Just n -> do writeTVar bootstrapCountdown $! Just $! pred n
230 return $ return () -- hPutStrLn stderr "BOOTSTRAP decrement (last bucket)" 230 return $ return () -- dput XRefresh "BOOTSTRAP decrement (last bucket)"
231 cnt <- readTVar bootstrapCountdown 231 cnt <- readTVar bootstrapCountdown
232 if (cnt == Just 0) 232 if (cnt == Just 0)
233 then do 233 then do
234 -- Boostrap finished! 234 -- Boostrap finished!
235 writeTVar bootstrapMode False 235 writeTVar bootstrapMode False
236 writeTVar bootstrapCountdown Nothing 236 writeTVar bootstrapCountdown Nothing
237 return $ do action ; hPutStrLn stderr $ "BOOTSTRAP complete (" ++ show (R.shape tbl) ++ ")." 237 return $ do action ; dput XRefresh $ "BOOTSTRAP complete (" ++ show (R.shape tbl) ++ ")."
238 else return $ do action ; hPutStrLn stderr $ "BOOTSTRAP progress " ++ show (num,R.shape tbl,cnt) 238 else return $ do action ; dput XRefresh $ "BOOTSTRAP progress " ++ show (num,R.shape tbl,cnt)
239 239
240refreshBucket :: (Show nid, Ord ni, Ord nid, Hashable nid, Hashable ni) => 240refreshBucket :: (Show nid, Ord ni, Ord nid, Hashable nid, Hashable ni) =>
241 BucketRefresher nid ni -> Int -> IO Int 241 BucketRefresher nid ni -> Int -> IO Int
@@ -254,7 +254,7 @@ refreshBucket r@BucketRefresher{ refreshSearch = sch
254 fin <- atomically $ newTVar False 254 fin <- atomically $ newTVar False
255 resultCounter <- atomically $ newTVar Set.empty 255 resultCounter <- atomically $ newTVar Set.empty
256 256
257 hPutStrLn stderr $ "Start refresh " ++ show (n,sample) 257 dput XRefresh $ "Start refresh " ++ show (n,sample)
258 258
259 -- Set 15 minute timeout in order to avoid overlapping refreshes. 259 -- Set 15 minute timeout in order to avoid overlapping refreshes.
260 s <- search sch tbl sample $ if n+1 == R.defaultBucketCount 260 s <- search sch tbl sample $ if n+1 == R.defaultBucketCount
@@ -289,9 +289,9 @@ restartBootstrap r@BucketRefresher{ bootstrapMode, bootstrapCountdown } = do
289 writeTVar bootstrapMode True 289 writeTVar bootstrapMode True
290 writeTVar bootstrapCountdown Nothing 290 writeTVar bootstrapCountdown Nothing
291 if not unchanged then return $ do 291 if not unchanged then return $ do
292 hPutStrLn stderr "BOOTSTRAP entered bootstrap mode" 292 dput XRefresh "BOOTSTRAP entered bootstrap mode"
293 refreshLastBucket r 293 refreshLastBucket r
294 else return $ hPutStrLn stderr "BOOTSTRAP already bootstrapping" 294 else return $ dput XRefresh "BOOTSTRAP already bootstrapping"
295 295
296bootstrap :: (Ord ni, Ord nid, Hashable nid, Hashable ni, Foldable t, Foldable t1, Show nid) => 296bootstrap :: (Ord ni, Ord nid, Hashable nid, Hashable ni, Foldable t, Foldable t1, Show nid) =>
297 BucketRefresher nid ni 297 BucketRefresher nid ni