diff options
author | Joe Crayne <joe@jerkface.net> | 2019-12-26 18:43:54 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-01 23:28:00 -0500 |
commit | d187c97aa8fd1c5385a99a8b061793d7a000fadb (patch) | |
tree | 40fd9702e7d7177bcb0c79673db37abb8beb7144 /kad | |
parent | 46c096abcb269407b0927587520dda644aca9b51 (diff) |
Reverted 6ebe91b6: abandoning the async search design for now.
Diffstat (limited to 'kad')
-rw-r--r-- | kad/src/Network/Kademlia/Search.hs | 33 |
1 files changed, 13 insertions, 20 deletions
diff --git a/kad/src/Network/Kademlia/Search.hs b/kad/src/Network/Kademlia/Search.hs index 16786d1c..5b60c303 100644 --- a/kad/src/Network/Kademlia/Search.hs +++ b/kad/src/Network/Kademlia/Search.hs | |||
@@ -40,8 +40,7 @@ import GHC.Conc (labelThread) | |||
40 | data Search nid addr tok ni r = Search | 40 | data Search nid addr tok ni r = Search |
41 | { searchSpace :: KademliaSpace nid ni | 41 | { searchSpace :: KademliaSpace nid ni |
42 | , searchNodeAddress :: ni -> addr | 42 | , searchNodeAddress :: ni -> addr |
43 | , searchQuery :: Either (nid -> ni -> IO (Maybe ([ni], [r], Maybe tok))) | 43 | , searchQuery :: nid -> ni -> IO (Maybe ([ni], [r], Maybe tok)) |
44 | (nid -> ni -> (Maybe ([ni],[r],Maybe tok) -> IO ()) -> IO ()) | ||
45 | , searchAlpha :: Int -- α = 8 | 44 | , searchAlpha :: Int -- α = 8 |
46 | -- | 'searchK' should be larger than 'searchAlpha'. How much larger depends on | 45 | -- | 'searchK' should be larger than 'searchAlpha'. How much larger depends on |
47 | -- how fast the queries are. For Tox's much slower onion-routed queries, we | 46 | -- how fast the queries are. For Tox's much slower onion-routed queries, we |
@@ -122,7 +121,7 @@ reset nearestNodes qsearch target st = do | |||
122 | writeTVar (searchPendingCount st) 0 | 121 | writeTVar (searchPendingCount st) 0 |
123 | return st | 122 | return st |
124 | 123 | ||
125 | sendAsyncQuery :: forall addr nid tok ni r. | 124 | sendQuery :: forall addr nid tok ni r. |
126 | ( Ord addr | 125 | ( Ord addr |
127 | , PSQKey nid | 126 | , PSQKey nid |
128 | , PSQKey ni | 127 | , PSQKey ni |
@@ -133,23 +132,15 @@ sendAsyncQuery :: forall addr nid tok ni r. | |||
133 | -> (r -> STM Bool) -- ^ return False to terminate the search. | 132 | -> (r -> STM Bool) -- ^ return False to terminate the search. |
134 | -> SearchState nid addr tok ni r | 133 | -> SearchState nid addr tok ni r |
135 | -> Binding ni nid | 134 | -> Binding ni nid |
136 | -> TaskGroup | ||
137 | -> IO () | 135 | -> IO () |
138 | sendAsyncQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) g = | 136 | sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) = do |
139 | case searchQuery of | 137 | myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget) |
140 | Left blockingQuery -> | 138 | reply <- searchQuery searchTarget ni `catchIOError` const (return Nothing) |
141 | forkTask g "searchQuery" $ do | 139 | -- (ns,rs) |
142 | -- forkTask will label the thread. | 140 | let tok = error "TODO: token" |
143 | -- -- myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget) | 141 | atomically $ do |
144 | reply <- blockingQuery searchTarget ni `catchIOError` const (return Nothing) | 142 | modifyTVar searchPendingCount pred |
145 | atomically $ do | 143 | maybe (return ()) go reply |
146 | modifyTVar searchPendingCount pred | ||
147 | maybe (return ()) go reply | ||
148 | Right nonblockingQuery -> do | ||
149 | nonblockingQuery searchTarget ni $ \reply -> | ||
150 | atomically $ do | ||
151 | modifyTVar searchPendingCount pred | ||
152 | maybe (return ()) go reply | ||
153 | where | 144 | where |
154 | go (ns,rs,tok) = do | 145 | go (ns,rs,tok) = do |
155 | vs <- readTVar searchVisited | 146 | vs <- readTVar searchVisited |
@@ -239,7 +230,9 @@ searchLoop sch@Search{..} target result s@SearchState{..} = do | |||
239 | modifyTVar searchVisited $ Set.insert (searchNodeAddress ni) | 230 | modifyTVar searchVisited $ Set.insert (searchNodeAddress ni) |
240 | modifyTVar searchPendingCount succ | 231 | modifyTVar searchPendingCount succ |
241 | return $ do | 232 | return $ do |
242 | sendAsyncQuery sch target result s (ni :-> d) g | 233 | forkTask g |
234 | "searchQuery" | ||
235 | $ sendQuery sch target result s (ni :-> d) | ||
243 | again | 236 | again |
244 | _ -> -- Otherwise, we are finished. | 237 | _ -> -- Otherwise, we are finished. |
245 | do check (cnt == 0) | 238 | do check (cnt == 0) |