diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Search.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Search.hs | 10 |
1 files changed, 7 insertions, 3 deletions
diff --git a/src/Network/BitTorrent/DHT/Search.hs b/src/Network/BitTorrent/DHT/Search.hs index 54547211..16a20620 100644 --- a/src/Network/BitTorrent/DHT/Search.hs +++ b/src/Network/BitTorrent/DHT/Search.hs | |||
@@ -6,7 +6,7 @@ | |||
6 | {-# LANGUAGE LambdaCase #-} | 6 | {-# LANGUAGE LambdaCase #-} |
7 | module Network.BitTorrent.DHT.Search where | 7 | module Network.BitTorrent.DHT.Search where |
8 | 8 | ||
9 | import Control.Concurrent.Async.Pool | 9 | import Tasks |
10 | import Control.Concurrent.STM | 10 | import Control.Concurrent.STM |
11 | import Control.Exception | 11 | import Control.Exception |
12 | import Control.Monad | 12 | import Control.Monad |
@@ -175,7 +175,7 @@ search sch buckets target result = do | |||
175 | 175 | ||
176 | searchLoop sch@Search{..} target result s@SearchState{..} = do | 176 | searchLoop sch@Search{..} target result s@SearchState{..} = do |
177 | myThreadId >>= flip labelThread ("search."++show target) | 177 | myThreadId >>= flip labelThread ("search."++show target) |
178 | withTaskGroup searchAlpha $ \g -> fix $ \again -> do | 178 | withTaskGroup ("search.g."++show target) searchAlpha $ \g -> fix $ \again -> do |
179 | join $ atomically $ do | 179 | join $ atomically $ do |
180 | cnt <- readTVar $ searchPendingCount | 180 | cnt <- readTVar $ searchPendingCount |
181 | informants <- readTVar searchInformant | 181 | informants <- readTVar searchInformant |
@@ -194,7 +194,11 @@ searchLoop sch@Search{..} target result s@SearchState{..} = do | |||
194 | do writeTVar searchQueued q | 194 | do writeTVar searchQueued q |
195 | modifyTVar searchVisited $ Set.insert (searchNodeAddress ni) | 195 | modifyTVar searchVisited $ Set.insert (searchNodeAddress ni) |
196 | modifyTVar searchPendingCount succ | 196 | modifyTVar searchPendingCount succ |
197 | return $ withAsync g (sendQuery sch target result s (ni :-> d)) (const again) | 197 | return $ do |
198 | forkTask g | ||
199 | "searchQuery" | ||
200 | $ sendQuery sch target result s (ni :-> d) | ||
201 | again | ||
198 | _ -> -- Otherwise, we are finished. | 202 | _ -> -- Otherwise, we are finished. |
199 | do check (cnt == 0) | 203 | do check (cnt == 0) |
200 | return $ return () | 204 | return $ return () |