diff options
author | jim@bo <jim@bo> | 2018-06-20 22:40:37 -0400 |
---|---|---|
committer | jim@bo <jim@bo> | 2018-06-20 22:43:47 -0400 |
commit | 825962518c6ad00279fc23e8e1dec746980e483f (patch) | |
tree | 68c135bdffd879835c48cce3d397e8edf99b53f4 /src/Network/Kademlia/Bootstrap.hs | |
parent | 09aa079fbab069f177e08b5239bf684d312eb00a (diff) |
More DPut stuff
* verbose/quiet without args shows report
* verbose all - sets all tags verbose
* quiet all - sets all tags quiet
* XMisc defaults to verbose, everything else quiet
* new XMan tag for ToxManager related stuff
* s/hputStrLn stderr/dput XMisc/ in daemon code
Diffstat (limited to 'src/Network/Kademlia/Bootstrap.hs')
-rw-r--r-- | src/Network/Kademlia/Bootstrap.hs | 22 |
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 | ||
240 | refreshBucket :: (Show nid, Ord ni, Ord nid, Hashable nid, Hashable ni) => | 240 | refreshBucket :: (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 | ||
296 | bootstrap :: (Ord ni, Ord nid, Hashable nid, Hashable ni, Foldable t, Foldable t1, Show nid) => | 296 | bootstrap :: (Ord ni, Ord nid, Hashable nid, Hashable ni, Foldable t, Foldable t1, Show nid) => |
297 | BucketRefresher nid ni | 297 | BucketRefresher nid ni |