summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/DHT/Search.hs30
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
71searchIsFinished :: Ord ip => IterativeSearch ip r -> STM Bool
72searchIsFinished 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
70search :: 82search ::
71 (Ord r, Ord ip) => 83 (Ord r, Ord ip) =>
72 IterativeSearch ip r -> IO () 84 IterativeSearch ip r -> IO ()
73search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do 85search 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 ()