summaryrefslogtreecommitdiff
path: root/src/Network/Kademlia
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Kademlia')
-rw-r--r--src/Network/Kademlia/Search.hs32
1 files changed, 19 insertions, 13 deletions
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)