summaryrefslogtreecommitdiff
path: root/kad/tests/searchCancel.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kad/tests/searchCancel.hs')
-rw-r--r--kad/tests/searchCancel.hs23
1 files changed, 15 insertions, 8 deletions
diff --git a/kad/tests/searchCancel.hs b/kad/tests/searchCancel.hs
index e8aa33c7..393f10c1 100644
--- a/kad/tests/searchCancel.hs
+++ b/kad/tests/searchCancel.hs
@@ -2,6 +2,7 @@ import Control.Concurrent
2import Control.Concurrent.STM 2import Control.Concurrent.STM
3import Control.Monad 3import Control.Monad
4import Data.Bits 4import Data.Bits
5import GHC.Event
5 6
6import Network.Kademlia 7import Network.Kademlia
7import Network.Kademlia.Bootstrap 8import Network.Kademlia.Bootstrap
@@ -14,15 +15,13 @@ import Network.QueryResponse as QR
14import qualified Data.MinMaxPSQ as MM 15import qualified Data.MinMaxPSQ as MM
15import qualified Data.Set as Set 16import qualified Data.Set as Set
16 17
17makeSchResults :: TVar (Maybe (SearchState Int Int () Int Int Int)) -> TVar Int -> IO (Maybe ([Int],[Int],Maybe ())) 18makeSchResults :: TVar (Maybe (SearchState Int Int () Int Int Int)) -> TVar Int -> IO ([Int],[Int],Maybe ())
18makeSchResults mbv var = do 19makeSchResults mbv var = do
19 putStrLn "makeSchResults"
20 threadDelay 200000
21 (r,io) <- atomically $ do 20 (r,io) <- atomically $ do
22 n <- readTVar var 21 n <- readTVar var
23 let ns = take 4 [n .. ] 22 let ns = take 4 [n .. ]
24 writeTVar var $! n + 4 23 writeTVar var $! n + 4
25 let r = Just (ns, ns, Just ()) -- Maybe ([ni], [r], Maybe tok) 24 let r = (ns, ns, Just ()) -- Maybe ([ni], [r], Maybe tok)
26 stmio = if n > 490 25 stmio = if n > 490
27 then do 26 then do
28 ms <- readTVar mbv 27 ms <- readTVar mbv
@@ -48,10 +47,18 @@ sch :: TVar (Maybe (SearchState Int Int () Int Int Int)) -> TVar Int -> Search I
48sch mbv var = Search 47sch mbv var = Search
49 { searchSpace = kad 48 { searchSpace = kad
50 , searchNodeAddress = id 49 , searchNodeAddress = id
51 , searchQuery = \_ _ f -> do r <- makeSchResults mbv var 50 -- searchQuery :: nid -> ni -> (qk -> Result ([ni], [r], Maybe tok) -> IO ()) -> IO qk
52 let qk = maybe 0 (\(ns,_,_) -> head ns) r 51 , searchQuery = \_ _ f -> do
53 f qk $ maybe TimedOut Success r 52 val <- atomically $ do
54 return qk 53 n <- readTVar var
54 writeTVar var $! n + 1
55 return n
56 tm <- getSystemTimerManager
57 k <- registerTimeout tm 200000 $ do
58 putStrLn $ "makeSchResults " ++ show val
59 r <- makeSchResults mbv var
60 f val (Success r)
61 return val
55 , searchQueryCancel = \_ _ -> return () 62 , searchQueryCancel = \_ _ -> return ()
56 , searchAlpha = 4 63 , searchAlpha = 4
57 , searchK = 8 64 , searchK = 8