summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/MainlineDHT.hs2
-rw-r--r--src/Network/Kademlia/Search.hs32
-rw-r--r--src/Network/Tox/DHT/Handlers.hs4
-rw-r--r--src/Network/Tox/Onion/Handlers.hs2
4 files changed, 23 insertions, 17 deletions
diff --git a/src/Network/BitTorrent/MainlineDHT.hs b/src/Network/BitTorrent/MainlineDHT.hs
index 180ae82d..83865c98 100644
--- a/src/Network/BitTorrent/MainlineDHT.hs
+++ b/src/Network/BitTorrent/MainlineDHT.hs
@@ -1074,7 +1074,7 @@ mainlineSearch :: (NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [r], Maybe tok))
1074mainlineSearch qry = Search 1074mainlineSearch qry = Search
1075 { searchSpace = mainlineSpace 1075 { searchSpace = mainlineSpace
1076 , searchNodeAddress = nodeIP &&& nodePort 1076 , searchNodeAddress = nodeIP &&& nodePort
1077 , searchQuery = qry 1077 , searchQuery = Left qry
1078 , searchAlpha = 8 1078 , searchAlpha = 8
1079 , searchK = 16 1079 , searchK = 16
1080 } 1080 }
diff --git a/src/Network/Kademlia/Search.hs b/src/Network/Kademlia/Search.hs
index e87a8618..1be1afc1 100644
--- a/src/Network/Kademlia/Search.hs
+++ b/src/Network/Kademlia/Search.hs
@@ -31,7 +31,8 @@ import GHC.Conc (labelThread)
31data Search nid addr tok ni r = Search 31data Search nid addr tok ni r = Search
32 { searchSpace :: KademliaSpace nid ni 32 { searchSpace :: KademliaSpace nid ni
33 , searchNodeAddress :: ni -> addr 33 , searchNodeAddress :: ni -> addr
34 , searchQuery :: nid -> ni -> IO (Maybe ([ni], [r], Maybe tok)) 34 , searchQuery :: Either (nid -> ni -> IO (Maybe ([ni], [r], Maybe tok)))
35 (nid -> ni -> (Maybe ([ni],[r],Maybe tok) -> IO ()) -> IO ())
35 , searchAlpha :: Int -- α = 8 36 , searchAlpha :: Int -- α = 8
36 -- | 'searchK' should be larger than 'searchAlpha'. How much larger depends on 37 -- | 'searchK' should be larger than 'searchAlpha'. How much larger depends on
37 -- how fast the queries are. For Tox's much slower onion-routed queries, we 38 -- how fast the queries are. For Tox's much slower onion-routed queries, we
@@ -112,7 +113,7 @@ reset nearestNodes qsearch target st = do
112 writeTVar (searchPendingCount st) 0 113 writeTVar (searchPendingCount st) 0
113 return st 114 return st
114 115
115sendQuery :: forall addr nid tok ni r. 116sendAsyncQuery :: forall addr nid tok ni r.
116 ( Ord addr 117 ( Ord addr
117 , PSQKey nid 118 , PSQKey nid
118 , PSQKey ni 119 , PSQKey ni
@@ -123,15 +124,22 @@ sendQuery :: forall addr nid tok ni r.
123 -> (r -> STM Bool) -- ^ return False to terminate the search. 124 -> (r -> STM Bool) -- ^ return False to terminate the search.
124 -> SearchState nid addr tok ni r 125 -> SearchState nid addr tok ni r
125 -> Binding ni nid 126 -> Binding ni nid
127 -> TaskGroup
126 -> IO () 128 -> IO ()
127sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) = do 129sendAsyncQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) g =
128 myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget) 130 case searchQuery of
129 reply <- searchQuery searchTarget ni `catchIOError` const (return Nothing) 131 Left blockingQuery ->
130 -- (ns,rs) 132 forkTask g "searchQuery" $ do
131 let tok = error "TODO: token" 133 myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget)
132 atomically $ do 134 reply <- blockingQuery searchTarget ni `catchIOError` const (return Nothing)
133 modifyTVar searchPendingCount pred 135 atomically $ do
134 maybe (return ()) go reply 136 modifyTVar searchPendingCount pred
137 maybe (return ()) go reply
138 Right nonblockingQuery -> do
139 nonblockingQuery searchTarget ni $ \reply ->
140 atomically $ do
141 modifyTVar searchPendingCount pred
142 maybe (return ()) go reply
135 where 143 where
136 go (ns,rs,tok) = do 144 go (ns,rs,tok) = do
137 vs <- readTVar searchVisited 145 vs <- readTVar searchVisited
@@ -221,9 +229,7 @@ searchLoop sch@Search{..} target result s@SearchState{..} = do
221 modifyTVar searchVisited $ Set.insert (searchNodeAddress ni) 229 modifyTVar searchVisited $ Set.insert (searchNodeAddress ni)
222 modifyTVar searchPendingCount succ 230 modifyTVar searchPendingCount succ
223 return $ do 231 return $ do
224 forkTask g 232 sendAsyncQuery sch target result s (ni :-> d) g
225 "searchQuery"
226 $ sendQuery sch target result s (ni :-> d)
227 again 233 again
228 _ -> -- Otherwise, we are finished. 234 _ -> -- Otherwise, we are finished.
229 do check (cnt == 0) 235 do check (cnt == 0)
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index afdf2cc3..abd607c3 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -194,7 +194,7 @@ newRouting addr crypto update4 update6 = do
194 nullSearch = Search 194 nullSearch = Search
195 { searchSpace = toxSpace 195 { searchSpace = toxSpace
196 , searchNodeAddress = nodeIP &&& nodePort 196 , searchNodeAddress = nodeIP &&& nodePort
197 , searchQuery = \_ _ -> return Nothing 197 , searchQuery = Left $ \_ _ -> return Nothing
198 , searchAlpha = 1 198 , searchAlpha = 1
199 , searchK = 2 199 , searchK = 2
200 } 200 }
@@ -525,7 +525,7 @@ nodeSearch :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> Search NodeI
525nodeSearch client cbvar = Search 525nodeSearch client cbvar = Search
526 { searchSpace = toxSpace 526 { searchSpace = toxSpace
527 , searchNodeAddress = nodeIP &&& nodePort 527 , searchNodeAddress = nodeIP &&& nodePort
528 , searchQuery = getNodes client cbvar 528 , searchQuery = Left $ getNodes client cbvar
529 , searchAlpha = 8 529 , searchAlpha = 8
530 , searchK = 16 530 , searchK = 16
531 531
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 52cc298d..edbbbb49 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -218,7 +218,7 @@ toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r,
218toxidSearch getTimeout crypto client = Search 218toxidSearch getTimeout crypto client = Search
219 { searchSpace = toxSpace 219 { searchSpace = toxSpace
220 , searchNodeAddress = nodeIP &&& nodePort 220 , searchNodeAddress = nodeIP &&& nodePort
221 , searchQuery = getRendezvous getTimeout crypto client 221 , searchQuery = Left $ getRendezvous getTimeout crypto client
222 , searchAlpha = 3 222 , searchAlpha = 3
223 , searchK = 6 223 , searchK = 6
224 } 224 }