diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/DHT/Search.hs | 30 |
1 files changed, 19 insertions, 11 deletions
diff --git a/src/Network/BitTorrent/DHT/Search.hs b/src/Network/BitTorrent/DHT/Search.hs index 1fe73c30..79cc9489 100644 --- a/src/Network/BitTorrent/DHT/Search.hs +++ b/src/Network/BitTorrent/DHT/Search.hs | |||
@@ -67,26 +67,34 @@ sendQuery IterativeSearch{..} (ni :-> d) = do | |||
67 | modifyTVar searchInformant $ MM.insertTake searchK ni d | 67 | modifyTVar searchInformant $ MM.insertTake searchK ni d |
68 | modifyTVar searchResults $ \s -> foldr Set.insert s rs | 68 | modifyTVar searchResults $ \s -> foldr Set.insert s rs |
69 | 69 | ||
70 | |||
71 | searchIsFinished :: Ord ip => IterativeSearch ip r -> STM Bool | ||
72 | searchIsFinished IterativeSearch{..} = do | ||
73 | q <- readTVar searchQueued | ||
74 | cnt <- readTVar searchPendingCount | ||
75 | informants <- readTVar searchInformant | ||
76 | return $ cnt == 0 | ||
77 | && ( MM.null q | ||
78 | || ( MM.size informants >= searchK | ||
79 | && ( PSQ.prio (fromJust $ MM.findMax informants) | ||
80 | <= PSQ.prio (fromJust $ MM.findMin q)))) | ||
81 | |||
70 | search :: | 82 | search :: |
71 | (Ord r, Ord ip) => | 83 | (Ord r, Ord ip) => |
72 | IterativeSearch ip r -> IO () | 84 | IterativeSearch ip r -> IO () |
73 | search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do | 85 | search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do |
74 | fix $ \again -> do | 86 | fix $ \again -> do |
75 | join $ atomically $ do | 87 | join $ atomically $ do |
76 | found <- MM.minView <$> readTVar searchQueued | ||
77 | cnt <- readTVar $ searchPendingCount | 88 | cnt <- readTVar $ searchPendingCount |
89 | informants <- readTVar searchInformant | ||
90 | found <- MM.minView <$> readTVar searchQueued | ||
78 | case found of | 91 | case found of |
79 | Nothing -> retry | 92 | Just (ni :-> d, q) |
80 | Just (ni :-> d, q) -> do | 93 | | (MM.size informants < searchK) && (cnt > 0 || not (MM.null q)) |
81 | informants <- readTVar searchInformant | 94 | || (PSQ.prio (fromJust $ MM.findMax informants) > d) |
82 | if MM.size informants < searchK | 95 | -> do writeTVar searchQueued q |
83 | && (cnt > 0 || not (MM.null q)) | ||
84 | || PSQ.prio (fromJust $ MM.findMax informants) > d | ||
85 | then do | ||
86 | writeTVar searchQueued q | ||
87 | modifyTVar searchVisited $ Set.insert (nodeAddr ni) | 96 | modifyTVar searchVisited $ Set.insert (nodeAddr ni) |
88 | modifyTVar searchPendingCount succ | 97 | modifyTVar searchPendingCount succ |
89 | return $ withAsync g (sendQuery s (ni :-> d)) (const again) | 98 | return $ withAsync g (sendQuery s (ni :-> d)) (const again) |
90 | else do | 99 | _ -> do check (cnt == 0) |
91 | check (cnt == 0) | ||
92 | return $ return () | 100 | return $ return () |