diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Search.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Search.hs | 29 |
1 files changed, 18 insertions, 11 deletions
diff --git a/src/Network/BitTorrent/DHT/Search.hs b/src/Network/BitTorrent/DHT/Search.hs index 79cc9489..854f26c7 100644 --- a/src/Network/BitTorrent/DHT/Search.hs +++ b/src/Network/BitTorrent/DHT/Search.hs | |||
@@ -1,5 +1,6 @@ | |||
1 | {-# LANGUAGE PatternSynonyms #-} | 1 | {-# LANGUAGE PatternSynonyms #-} |
2 | {-# LANGUAGE RecordWildCards #-} | 2 | {-# LANGUAGE RecordWildCards #-} |
3 | {-# LANGUAGE ScopedTypeVariables #-} | ||
3 | module Network.BitTorrent.DHT.Search where | 4 | module Network.BitTorrent.DHT.Search where |
4 | 5 | ||
5 | import Control.Concurrent | 6 | import Control.Concurrent |
@@ -21,20 +22,23 @@ import qualified Data.MinMaxPSQ as MM | |||
21 | ;import Data.MinMaxPSQ (MinMaxPSQ) | 22 | ;import Data.MinMaxPSQ (MinMaxPSQ) |
22 | import qualified Data.Wrapper.PSQ as PSQ | 23 | import qualified Data.Wrapper.PSQ as PSQ |
23 | ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ) | 24 | ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ) |
24 | import Network.BitTorrent.Address | 25 | import Network.BitTorrent.Address hiding (NodeId) |
26 | import Network.RPC | ||
27 | import Network.KRPC.Message (KMessageOf) | ||
28 | import Network.DHT.Mainline () | ||
25 | 29 | ||
26 | data IterativeSearch ip r = IterativeSearch | 30 | data IterativeSearch ip r = IterativeSearch |
27 | { searchTarget :: NodeId | 31 | { searchTarget :: NodeId KMessageOf |
28 | , searchQuery :: NodeInfo ip -> IO ([NodeInfo ip], [r]) | 32 | , searchQuery :: NodeInfo KMessageOf ip () -> IO ([NodeInfo KMessageOf ip ()], [r]) |
29 | , searchPendingCount :: TVar Int | 33 | , searchPendingCount :: TVar Int |
30 | , searchQueued :: TVar (MinMaxPSQ (NodeInfo ip) NodeDistance) | 34 | , searchQueued :: TVar (MinMaxPSQ (NodeInfo KMessageOf ip ()) (NodeDistance (NodeId KMessageOf))) |
31 | , searchInformant :: TVar (MinMaxPSQ (NodeInfo ip) NodeDistance) | 35 | , searchInformant :: TVar (MinMaxPSQ (NodeInfo KMessageOf ip ()) (NodeDistance (NodeId KMessageOf))) |
32 | , searchVisited :: TVar (Set (NodeAddr ip)) | 36 | , searchVisited :: TVar (Set (NodeAddr ip)) |
33 | , searchResults :: TVar (Set r) | 37 | , searchResults :: TVar (Set r) |
34 | } | 38 | } |
35 | 39 | ||
36 | newSearch :: Eq ip => (NodeInfo ip -> IO ([NodeInfo ip], [r])) | 40 | newSearch :: Eq ip => (NodeInfo KMessageOf ip () -> IO ([NodeInfo KMessageOf ip ()], [r])) |
37 | -> NodeId -> [NodeInfo ip] -> IO (IterativeSearch ip r) | 41 | -> NodeId KMessageOf -> [NodeInfo KMessageOf ip ()] -> IO (IterativeSearch ip r) |
38 | newSearch qry target ns = atomically $ do | 42 | newSearch qry target ns = atomically $ do |
39 | c <- newTVar 0 | 43 | c <- newTVar 0 |
40 | q <- newTVar $ MM.fromList $ map (\n -> n :-> distance target (nodeId n)) ns | 44 | q <- newTVar $ MM.fromList $ map (\n -> n :-> distance target (nodeId n)) ns |
@@ -49,9 +53,9 @@ searchAlpha = 3 | |||
49 | searchK :: Int | 53 | searchK :: Int |
50 | searchK = 8 | 54 | searchK = 8 |
51 | 55 | ||
52 | sendQuery :: (Ord a, Ord t) => | 56 | sendQuery :: forall a ip. (Ord a, Ord ip) => |
53 | IterativeSearch t a | 57 | IterativeSearch ip a |
54 | -> Binding (NodeInfo t) NodeDistance | 58 | -> Binding (NodeInfo KMessageOf ip ()) (NodeDistance (NodeId KMessageOf)) |
55 | -> IO () | 59 | -> IO () |
56 | sendQuery IterativeSearch{..} (ni :-> d) = do | 60 | sendQuery IterativeSearch{..} (ni :-> d) = do |
57 | (ns,rs) <- handle (\(SomeException e) -> return ([],[])) | 61 | (ns,rs) <- handle (\(SomeException e) -> return ([],[])) |
@@ -60,7 +64,10 @@ sendQuery IterativeSearch{..} (ni :-> d) = do | |||
60 | modifyTVar searchPendingCount pred | 64 | modifyTVar searchPendingCount pred |
61 | vs <- readTVar searchVisited | 65 | vs <- readTVar searchVisited |
62 | -- We only queue a node if it is not yet visited | 66 | -- We only queue a node if it is not yet visited |
63 | let insertFoundNode n q | 67 | let insertFoundNode :: NodeInfo KMessageOf ip u |
68 | -> MinMaxPSQ (NodeInfo KMessageOf ip u) (NodeDistance (NodeId KMessageOf)) | ||
69 | -> MinMaxPSQ (NodeInfo KMessageOf ip u) (NodeDistance (NodeId KMessageOf)) | ||
70 | insertFoundNode n q | ||
64 | | nodeAddr n `Set.member` vs = q | 71 | | nodeAddr n `Set.member` vs = q |
65 | | otherwise = MM.insertTake searchK n (distance searchTarget $ nodeId n) q | 72 | | otherwise = MM.insertTake searchK n (distance searchTarget $ nodeId n) q |
66 | modifyTVar searchQueued $ \q -> foldr insertFoundNode q ns | 73 | modifyTVar searchQueued $ \q -> foldr insertFoundNode q ns |