diff options
Diffstat (limited to 'kad/src/Network')
-rw-r--r-- | kad/src/Network/Kademlia/Search.hs | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/kad/src/Network/Kademlia/Search.hs b/kad/src/Network/Kademlia/Search.hs index 1be1afc1..16786d1c 100644 --- a/kad/src/Network/Kademlia/Search.hs +++ b/kad/src/Network/Kademlia/Search.hs | |||
@@ -4,7 +4,16 @@ | |||
4 | {-# LANGUAGE ScopedTypeVariables #-} | 4 | {-# LANGUAGE ScopedTypeVariables #-} |
5 | {-# LANGUAGE FlexibleContexts #-} | 5 | {-# LANGUAGE FlexibleContexts #-} |
6 | {-# LANGUAGE LambdaCase #-} | 6 | {-# LANGUAGE LambdaCase #-} |
7 | module Network.Kademlia.Search where | 7 | module Network.Kademlia.Search |
8 | ( Search(..) | ||
9 | , SearchState(..) | ||
10 | , searchCancel | ||
11 | , searchIsFinished | ||
12 | , search | ||
13 | , newSearch | ||
14 | , reset | ||
15 | , searchLoop | ||
16 | ) where | ||
8 | 17 | ||
9 | import Control.Concurrent.Tasks | 18 | import Control.Concurrent.Tasks |
10 | import Control.Concurrent.STM | 19 | import Control.Concurrent.STM |
@@ -130,7 +139,8 @@ sendAsyncQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> | |||
130 | case searchQuery of | 139 | case searchQuery of |
131 | Left blockingQuery -> | 140 | Left blockingQuery -> |
132 | forkTask g "searchQuery" $ do | 141 | forkTask g "searchQuery" $ do |
133 | myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget) | 142 | -- forkTask will label the thread. |
143 | -- -- myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget) | ||
134 | reply <- blockingQuery searchTarget ni `catchIOError` const (return Nothing) | 144 | reply <- blockingQuery searchTarget ni `catchIOError` const (return Nothing) |
135 | atomically $ do | 145 | atomically $ do |
136 | modifyTVar searchPendingCount pred | 146 | modifyTVar searchPendingCount pred |
@@ -197,7 +207,7 @@ search :: | |||
197 | search sch buckets target result = do | 207 | search sch buckets target result = do |
198 | let ns = R.kclosest (searchSpace sch) (searchK sch) target buckets | 208 | let ns = R.kclosest (searchSpace sch) (searchK sch) target buckets |
199 | st <- atomically $ newSearch sch target ns | 209 | st <- atomically $ newSearch sch target ns |
200 | forkIO $ searchLoop sch target result st | 210 | t <- forkIO $ searchLoop sch target result st |
201 | return st | 211 | return st |
202 | 212 | ||
203 | searchLoop :: ( Ord addr, Ord nid, Ord ni, Show nid, Hashable nid, Hashable ni ) | 213 | searchLoop :: ( Ord addr, Ord nid, Ord ni, Show nid, Hashable nid, Hashable ni ) |