summaryrefslogtreecommitdiff
path: root/kad/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'kad/src/Network')
-rw-r--r--kad/src/Network/Kademlia/Search.hs11
1 files changed, 7 insertions, 4 deletions
diff --git a/kad/src/Network/Kademlia/Search.hs b/kad/src/Network/Kademlia/Search.hs
index 03c18d0e..8d9c997b 100644
--- a/kad/src/Network/Kademlia/Search.hs
+++ b/kad/src/Network/Kademlia/Search.hs
@@ -29,7 +29,8 @@ import qualified Data.MinMaxPSQ as MM
29 ;import Data.MinMaxPSQ (MinMaxPSQ, MinMaxPSQ') 29 ;import Data.MinMaxPSQ (MinMaxPSQ, MinMaxPSQ')
30import qualified Data.Wrapper.PSQ as PSQ 30import qualified Data.Wrapper.PSQ as PSQ
31 ;import Data.Wrapper.PSQ (pattern (:->), Binding, pattern Binding, Binding', PSQKey) 31 ;import Data.Wrapper.PSQ (pattern (:->), Binding, pattern Binding, Binding', PSQKey)
32import Network.Kademlia.Routing as R 32import Network.Kademlia.Routing as R
33import Network.QueryResponse (Result(..))
33#ifdef THREAD_DEBUG 34#ifdef THREAD_DEBUG
34import Control.Concurrent.Lifted.Instrument 35import Control.Concurrent.Lifted.Instrument
35#else 36#else
@@ -40,7 +41,7 @@ import GHC.Conc (labelThread)
40data Search nid addr tok ni r = Search 41data Search nid addr tok ni r = Search
41 { searchSpace :: KademliaSpace nid ni 42 { searchSpace :: KademliaSpace nid ni
42 , searchNodeAddress :: ni -> addr 43 , searchNodeAddress :: ni -> addr
43 , searchQuery :: nid -> ni -> IO (Maybe ([ni], [r], Maybe tok)) 44 , searchQuery :: nid -> ni -> IO (Result ([ni], [r], Maybe tok))
44 , searchAlpha :: Int -- α = 8 45 , searchAlpha :: Int -- α = 8
45 -- | 'searchK' should be larger than 'searchAlpha'. How much larger depends on 46 -- | 'searchK' should be larger than 'searchAlpha'. How much larger depends on
46 -- how fast the queries are. For Tox's much slower onion-routed queries, we 47 -- how fast the queries are. For Tox's much slower onion-routed queries, we
@@ -138,12 +139,14 @@ sendQuery :: forall addr nid tok ni r.
138 -> IO () 139 -> IO ()
139sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) = do 140sendQuery Search{..} searchTarget searchResult sch@SearchState{..} (ni :-> d) = do
140 myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget) 141 myThreadId >>= flip labelThread ("searchQuery." ++ show searchTarget)
141 reply <- searchQuery searchTarget ni `catchIOError` const (return Nothing) 142 reply <- searchQuery searchTarget ni `catchIOError` const (return Canceled)
142 -- (ns,rs) 143 -- (ns,rs)
143 let tok = error "TODO: token" 144 let tok = error "TODO: token"
144 atomically $ do 145 atomically $ do
145 modifyTVar searchPendingCount pred 146 modifyTVar searchPendingCount pred
146 maybe (return ()) go reply 147 case reply of
148 Success x -> go x
149 _ -> return ()
147 where 150 where
148 go (ns,rs,tok) = do 151 go (ns,rs,tok) = do
149 vs <- readTVar searchVisited 152 vs <- readTVar searchVisited