summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT/Search.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/DHT/Search.hs')
-rw-r--r--src/Network/BitTorrent/DHT/Search.hs29
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 #-}
3module Network.BitTorrent.DHT.Search where 4module Network.BitTorrent.DHT.Search where
4 5
5import Control.Concurrent 6import Control.Concurrent
@@ -21,20 +22,23 @@ import qualified Data.MinMaxPSQ as MM
21 ;import Data.MinMaxPSQ (MinMaxPSQ) 22 ;import Data.MinMaxPSQ (MinMaxPSQ)
22import qualified Data.Wrapper.PSQ as PSQ 23import qualified Data.Wrapper.PSQ as PSQ
23 ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ) 24 ;import Data.Wrapper.PSQ (pattern (:->), Binding, PSQ)
24import Network.BitTorrent.Address 25import Network.BitTorrent.Address hiding (NodeId)
26import Network.RPC
27import Network.KRPC.Message (KMessageOf)
28import Network.DHT.Mainline ()
25 29
26data IterativeSearch ip r = IterativeSearch 30data 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
36newSearch :: Eq ip => (NodeInfo ip -> IO ([NodeInfo ip], [r])) 40newSearch :: 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)
38newSearch qry target ns = atomically $ do 42newSearch 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
49searchK :: Int 53searchK :: Int
50searchK = 8 54searchK = 8
51 55
52sendQuery :: (Ord a, Ord t) => 56sendQuery :: 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 ()
56sendQuery IterativeSearch{..} (ni :-> d) = do 60sendQuery 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