1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Data.Bits
import Network.Kademlia
import Network.Kademlia.Bootstrap
import Network.Kademlia.CommonAPI
import Network.Kademlia.Persistence
import Network.Kademlia.Routing
import Network.Kademlia.Search
import qualified Data.MinMaxPSQ as MM
import qualified Data.Set as Set
makeSchResults :: TVar (Maybe (SearchState Int Int () Int Int)) -> TVar Int -> IO (Maybe ([Int],[Int],Maybe ()))
makeSchResults mbv var = do
threadDelay 200000
(r,io) <- atomically $ do
n <- readTVar var
let ns = take 4 [n .. ]
writeTVar var $! n + 4
let r = Just (ns, ns, Just ()) -- Maybe ([ni], [r], Maybe tok)
stmio = if n > 490
then do
ms <- readTVar mbv
case ms of
Just s -> do report <- showSearchState s
return $ putStrLn $ "cnt=" ++ show n ++ " " ++ report
_ -> return $ return ()
else return $ return ()
io <- stmio
return (r,io)
io
return r
kad :: KademliaSpace Int Int
kad = KademliaSpace
{ kademliaLocation = id
, kademliaTestBit = \x i -> testBit i x
, kademliaXor = \x y -> abs (x - y)
, kademliaSample = \_ x _ -> pure x
}
sch :: TVar (Maybe (SearchState Int Int () Int Int)) -> TVar Int -> Search Int Int () Int Int
sch mbv var = Search
{ searchSpace = kad
, searchNodeAddress = id
, searchQuery = \_ _ -> makeSchResults mbv var
, searchAlpha = 4
, searchK = 8
}
onResult :: Int -> STM Bool
onResult k = return (k < 50000)
showSearchState st = do
pc <- readTVar (searchPendingCount st)
q <- readTVar (searchQueued st)
inf <- readTVar (searchInformant st)
vset <- readTVar (searchVisited st)
return $ unwords
[ "pending=" ++ show pc
, "|q|=" ++ show (maybe 0 MM.size q)
, "|inf|=" ++ show (MM.size inf)
, "|visited|=" ++ show (Set.size vset)
]
main = do
var <- newTVarIO 5
fin <- newTVarIO False
mbstvar <- newTVarIO Nothing
s <- atomically $ newSearch (sch mbstvar var) maxBound [1..4]
atomically $ writeTVar mbstvar (Just s)
t <- forkIO $ do searchLoop (sch mbstvar var) maxBound onResult s
atomically $ writeTVar fin True
putStrLn "Waiting on counter."
(done,n) <- atomically $ do
done <- readTVar fin
n <- readTVar var
if (not done && n < 500)
then retry
else return (done,n)
putStrLn $ "(done,n) = " ++ show (done,n)
report <- atomically $ do
report <- showSearchState s
searchCancel s
return report
putStrLn report
putStrLn "Canceled. Awaiting fin. The program should quit shortly without much output after this."
forkIO $
let loop = do
(x,report) <- atomically $ (,) <$> readTVar var <*> showSearchState s
putStrLn $ "query after cancel! " ++ show x ++ " " ++ report
atomically $ readTVar var >>= \y -> if x == y then retry else return ()
loop
in loop
atomically $ check =<< readTVar fin
|
