diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/MinMaxPSQ.hs | 3 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Search.hs | 16 |
2 files changed, 16 insertions, 3 deletions
diff --git a/src/Data/MinMaxPSQ.hs b/src/Data/MinMaxPSQ.hs index f41da4a4..f385f258 100644 --- a/src/Data/MinMaxPSQ.hs +++ b/src/Data/MinMaxPSQ.hs | |||
@@ -55,9 +55,12 @@ maxView :: (PSQKey k, Ord p) => MinMaxPSQ k p -> Maybe (Binding k p, MinMaxPSQ k | |||
55 | maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (PSQ.delete k nq) xq')) | 55 | maxView (MinMaxPSQ nq xq) = fmap (\(k :-> Down p, xq') -> (k :-> p, MinMaxPSQ (PSQ.delete k nq) xq')) |
56 | $ PSQ.minView xq | 56 | $ PSQ.minView xq |
57 | 57 | ||
58 | -- | Maintains a bounded 'MinMaxPSQ' by deleting the maximum element if the | ||
59 | -- insertion would cause the queue to have too many elements. | ||
58 | insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p | 60 | insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p |
59 | insertTake n k p q = take n $ insert k p q | 61 | insertTake n k p q = take n $ insert k p q |
60 | 62 | ||
63 | -- | Truncate the 'MinMaxPSQ' to the given number of lowest priority elements. | ||
61 | take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p | 64 | take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ k p -> MinMaxPSQ k p |
62 | take !n !q | (size q <= n) = q | 65 | take !n !q | (size q <= n) = q |
63 | | null q = q | 66 | | null q = q |
diff --git a/src/Network/BitTorrent/DHT/Search.hs b/src/Network/BitTorrent/DHT/Search.hs index 91a1079b..c562b988 100644 --- a/src/Network/BitTorrent/DHT/Search.hs +++ b/src/Network/BitTorrent/DHT/Search.hs | |||
@@ -33,8 +33,12 @@ data IterativeSearch nid addr ni r = IterativeSearch | |||
33 | , searchSpace :: KademliaSpace nid ni | 33 | , searchSpace :: KademliaSpace nid ni |
34 | , searchNodeAddress :: ni -> addr | 34 | , searchNodeAddress :: ni -> addr |
35 | , searchQuery :: ni -> IO ([ni], [r]) | 35 | , searchQuery :: ni -> IO ([ni], [r]) |
36 | -- | The number of pending queries. Incremented before any query is sent | ||
37 | -- and decremented when we get a reply. | ||
36 | , searchPendingCount :: TVar Int | 38 | , searchPendingCount :: TVar Int |
39 | -- | Nodes scheduled to be queried. | ||
37 | , searchQueued :: TVar (MinMaxPSQ ni nid) | 40 | , searchQueued :: TVar (MinMaxPSQ ni nid) |
41 | -- | The nearest K nodes that issued a reply. | ||
38 | , searchInformant :: TVar (MinMaxPSQ ni nid) | 42 | , searchInformant :: TVar (MinMaxPSQ ni nid) |
39 | , searchVisited :: TVar (Set addr) | 43 | , searchVisited :: TVar (Set addr) |
40 | , searchResults :: TVar (Set r) | 44 | , searchResults :: TVar (Set r) |
@@ -127,11 +131,17 @@ search s@IterativeSearch{..} = withTaskGroup searchAlpha $ \g -> do | |||
127 | found <- MM.minView <$> readTVar searchQueued | 131 | found <- MM.minView <$> readTVar searchQueued |
128 | case found of | 132 | case found of |
129 | Just (ni :-> d, q) | 133 | Just (ni :-> d, q) |
130 | | (MM.size informants < searchK) && (cnt > 0 || not (MM.null q)) | 134 | | -- If there's fewer than /k/ informants and there's any |
135 | -- node we haven't yet got a response from. | ||
136 | (MM.size informants < searchK) && (cnt > 0 || not (MM.null q)) | ||
137 | -- Or if the closest scheduled node is nearer than the | ||
138 | -- nearest /k/ informants. | ||
131 | || (PSQ.prio (fromJust $ MM.findMax informants) > d) | 139 | || (PSQ.prio (fromJust $ MM.findMax informants) > d) |
132 | -> do writeTVar searchQueued q | 140 | -> -- Then the search continues, send a query. |
141 | do writeTVar searchQueued q | ||
133 | modifyTVar searchVisited $ Set.insert (searchNodeAddress ni) | 142 | modifyTVar searchVisited $ Set.insert (searchNodeAddress ni) |
134 | modifyTVar searchPendingCount succ | 143 | modifyTVar searchPendingCount succ |
135 | return $ withAsync g (sendQuery s (ni :-> d)) (const again) | 144 | return $ withAsync g (sendQuery s (ni :-> d)) (const again) |
136 | _ -> do check (cnt == 0) | 145 | _ -> -- Otherwise, we are finished. |
146 | do check (cnt == 0) | ||
137 | return $ return () | 147 | return $ return () |