diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/Kademlia/Bootstrap.hs | 28 |
1 files changed, 17 insertions, 11 deletions
diff --git a/src/Network/Kademlia/Bootstrap.hs b/src/Network/Kademlia/Bootstrap.hs index 595659d2..b71704d9 100644 --- a/src/Network/Kademlia/Bootstrap.hs +++ b/src/Network/Kademlia/Bootstrap.hs | |||
@@ -126,10 +126,10 @@ updateRefresherIO sch ping BucketRefresher{..} = BucketRefresher | |||
126 | 126 | ||
127 | -- | Fork a refresh loop. Kill the returned thread to terminate it. | 127 | -- | Fork a refresh loop. Kill the returned thread to terminate it. |
128 | forkPollForRefresh :: SensibleNodeId nid ni => BucketRefresher nid ni -> IO ThreadId | 128 | forkPollForRefresh :: SensibleNodeId nid ni => BucketRefresher nid ni -> IO ThreadId |
129 | forkPollForRefresh BucketRefresher{ refreshInterval | 129 | forkPollForRefresh r@BucketRefresher{ refreshInterval |
130 | , refreshQueue | 130 | , refreshQueue |
131 | , refreshBuckets | 131 | , refreshBuckets |
132 | , refreshSearch } = fork $ do | 132 | , refreshSearch } = fork $ do |
133 | myThreadId >>= flip labelThread "pollForRefresh" | 133 | myThreadId >>= flip labelThread "pollForRefresh" |
134 | fix $ \again -> do | 134 | fix $ \again -> do |
135 | join $ atomically $ do | 135 | join $ atomically $ do |
@@ -137,7 +137,9 @@ forkPollForRefresh BucketRefresher{ refreshInterval | |||
137 | maybe retry (return . go again) nextup | 137 | maybe retry (return . go again) nextup |
138 | where | 138 | where |
139 | refresh :: Int -> IO Int | 139 | refresh :: Int -> IO Int |
140 | refresh = refreshBucket refreshSearch refreshBuckets | 140 | refresh n = do |
141 | hPutStrLn stderr $ "Refresh time! "++ show n | ||
142 | refreshBucket r n | ||
141 | 143 | ||
142 | go again ( bktnum :-> refresh_time ) = do | 144 | go again ( bktnum :-> refresh_time ) = do |
143 | now <- getPOSIXTime | 145 | now <- getPOSIXTime |
@@ -152,7 +154,9 @@ forkPollForRefresh BucketRefresher{ refreshInterval | |||
152 | _ <- refresh bktnum | 154 | _ <- refresh bktnum |
153 | return () | 155 | return () |
154 | return () | 156 | return () |
155 | seconds -> threadDelay ( seconds * 1000000 ) | 157 | picoseconds -> do |
158 | hPutStrLn stderr $ show (picoseconds `div` 10^12) ++ " seconds until refresh " ++ show bktnum | ||
159 | threadDelay ( picoseconds `div` 10^6 ) | ||
156 | again | 160 | again |
157 | 161 | ||
158 | 162 | ||
@@ -184,9 +188,11 @@ checkBucketFull space var resultCounter fin n found_node = do | |||
184 | _ -> False -- okay, good enough, let's quit. | 188 | _ -> False -- okay, good enough, let's quit. |
185 | 189 | ||
186 | 190 | ||
187 | refreshBucket :: (Hashable a, Hashable t, Ord t, Ord addr, Ord a, Show t) => | 191 | refreshBucket :: (Show nid, Ord ni, Ord nid, Hashable nid, Hashable ni) => |
188 | Search t addr tok a a -> TVar (BucketList a) -> Int -> IO Int | 192 | BucketRefresher nid ni -> Int -> IO Int |
189 | refreshBucket sch var n = do | 193 | refreshBucket r@BucketRefresher{ refreshSearch = sch |
194 | , refreshBuckets = var } | ||
195 | n = do | ||
190 | tbl <- atomically (readTVar var) | 196 | tbl <- atomically (readTVar var) |
191 | let count = bktCount tbl | 197 | let count = bktCount tbl |
192 | nid = kademliaLocation (searchSpace sch) (thisNode tbl) | 198 | nid = kademliaLocation (searchSpace sch) (thisNode tbl) |
@@ -216,9 +222,9 @@ refreshBucket sch var n = do | |||
216 | return rcount | 222 | return rcount |
217 | 223 | ||
218 | refreshLastBucket :: SensibleNodeId nid ni => BucketRefresher nid ni -> IO () | 224 | refreshLastBucket :: SensibleNodeId nid ni => BucketRefresher nid ni -> IO () |
219 | refreshLastBucket r@BucketRefresher { refreshBuckets, refreshSearch } = do | 225 | refreshLastBucket r@BucketRefresher { refreshBuckets } = do |
220 | cnt <- atomically $ bktCount <$> readTVar refreshBuckets | 226 | cnt <- atomically $ bktCount <$> readTVar refreshBuckets |
221 | void $ refreshBucket refreshSearch refreshBuckets (cnt - 1) | 227 | void $ refreshBucket r (cnt - 1) |
222 | 228 | ||
223 | bootstrap :: (Ord ni, Ord nid, Hashable nid, Hashable ni, Foldable t, Foldable t1, Show nid) => | 229 | bootstrap :: (Ord ni, Ord nid, Hashable nid, Hashable ni, Foldable t, Foldable t1, Show nid) => |
224 | BucketRefresher nid ni | 230 | BucketRefresher nid ni |