1 files changed, 13 insertions, 13 deletions
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index ef3f6bd4..4f83beb2 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -551,7 +551,7 @@ clientSession s@Session{..} sock cnum h = do
        ("ls", _) | Just DHT{dhtBuckets} <- Map.lookup netname dhts
                    -> cmd0 $ do
-                        bkts <- atomically $ readTVar dhtBuckets
+                        bkts <- atomically $ readTVar (refreshBuckets dhtBuckets)
                        let r = reportTable bkts
                        hPutClient h $
                            showReport $
@@ -562,7 +562,7 @@ clientSession s@Session{..} sock cnum h = do
        ("r", s) | Just DHT{dhtQuery,dhtBuckets} <- Map.lookup netname dhts
                 , Just DHTQuery{qsearch} <- Map.lookup "node" dhtQuery
                   -> cmd0 $ do
-                        ni <- atomically $ thisNode <$> readTVar dhtBuckets
+                        ni <- atomically $ thisNode <$> readTVar (refreshBuckets dhtBuckets)
                        let kad = searchSpace qsearch
                            nid = kademliaLocation kad ni
                            b = case readMaybe $ strp s of
@@ -768,7 +768,7 @@ clientSession s@Session{..} sock cnum h = do
                        -- arguments: method
                        --            nid
                        --            (optional dest-ni)
-                        self <- atomically $ thisNode <$> readTVar dhtBuckets
+                        self <- atomically $ thisNode <$> readTVar (refreshBuckets dhtBuckets)
                        let (method,xs) = break isSpace $ dropWhile isSpace s
                            (nidstr,ys) = break isSpace $ dropWhile isSpace xs
                            destination = dropWhile isSpace ys
@@ -819,7 +819,7 @@ clientSession s@Session{..} sock cnum h = do
                        --             data (jid or key)     data
                        --             dest-rendezvous(r)    token
                        --             (optional extra-text) (optional dest-ni)
-                        self <- atomically $ thisNode <$> readTVar dhtBuckets
+                        self <- atomically $ thisNode <$> readTVar (refreshBuckets dhtBuckets)
                        let (method,xs) = break isSpace $ dropWhile isSpace s
                            (dtastr,ys) = break isSpace $ dropWhile isSpace xs
                            (tokenstr,zs) = break isSpace $ dropWhile isSpace ys
@@ -941,7 +941,7 @@ clientSession s@Session{..} sock cnum h = do
                                                            (\nid -> R.kclosest (searchSpace qsearch)
                                                                                (searchK qsearch)
                                                                                nid
-                                                                     <$> readTVar dhtBuckets)
+                                                                     <$> readTVar (refreshBuckets dhtBuckets))
                                                            (announceTarget dta)
                                                            announceInterval)
                                            dta
@@ -967,7 +967,7 @@ clientSession s@Session{..} sock cnum h = do
                                                            (\nid -> R.kclosest (searchSpace qsearch)
                                                                                (searchK qsearch)
                                                                                nid
-                                                                     <$> readTVar dhtBuckets)
+                                                                     <$> readTVar (refreshBuckets dhtBuckets))
                                                            (announceTarget dta)
                                                            announceInterval)
                                            dta
@@ -1009,7 +1009,7 @@ clientSession s@Session{..} sock cnum h = do
                                join $ atomically $ do
                                    schs <- readTVar dhtSearches
                                    case Map.lookup (method,nid) schs of
-                                        Nothing  -> do forkSearch method nid qry dhtSearches dhtBuckets tid kvar
+                                        Nothing  -> do forkSearch method nid qry dhtSearches (refreshBuckets dhtBuckets) tid kvar
                                                       return $ presentSearches
                                        Just sch -> do writeTVar kvar (Just $ return ())
                                                       return $ reportSearchResults method h sch
@@ -1614,7 +1614,7 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                tcpclient = tcpKademliaClient $ Tox.toxOnionRoutes tox
                tcpRefresher = tcpBucketRefresher $ Tox.toxOnionRoutes tox
                tcpDHT = DHT
-                    { dhtBuckets = refreshBuckets tcpRefresher
+                    { dhtBuckets = tcpRefresher
                    , dhtSecretKey = return $ Just $ transportSecret (Tox.toxCryptoKeys tox)
                    , dhtPing = Map.singleton "ping" DHTPing
                                    { pingQuery = noArgPing $ TCP.tcpPing (TCP.tcpClient tcpclient)
@@ -1639,9 +1639,9 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                    , dhtShowHexId = Just Tox.showHexId
                    }
                dhts = Map.fromList $
-                        ("tox4", toxDHT Tox.routing4 Want_IP4)
+                        ("tox4", toxDHT Tox.refresher4 Want_IP4)
                        : (if ip6tox opts
-                            then ( ("tox6", toxDHT Tox.routing6 Want_IP6) :)
+                            then ( ("tox6", toxDHT Tox.refresher6 Want_IP6) :)
                            else id)
                          (if enableTCPDHT opts
                            then [ ("toxtcp", tcpDHT) ]
@@ -1674,7 +1674,7 @@ initJabber opts ssvar announcer mbtox toxchat = case portxmpp opts of
            let lookupBkts :: String -> Map.Map String DHT -> Maybe (String,TVar (BucketList Tox.NodeInfo))
                lookupBkts name m = case Map.lookup name m of
                    Nothing              -> Nothing
-                    Just DHT{dhtBuckets} -> cast (name, dhtBuckets)
+                    Just DHT{dhtBuckets} -> cast (name, refreshBuckets dhtBuckets)
            sv <- xmppServer Tcp.noCleanUp (Just sport)
            tcp <- xmppConnections sv -- :: IO ( Manager TCPStatus T.Text )
            let tman = toxman ssvar announcer <$> mbtox
@@ -1795,9 +1795,9 @@ main = do
                    , dhtShowHexId = Nothing
                    }
                dhts = Map.fromList $
-                        ("bt4", mainlineDHT Mainline.routing4 Want_IP4)
+                        ("bt4", mainlineDHT Mainline.refresher4 Want_IP4)
                        : if ip6bt opts
-                            then [ ("bt6", mainlineDHT Mainline.routing6 Want_IP6) ]
+                            then [ ("bt6", mainlineDHT Mainline.refresher6 Want_IP6) ]
                            else []
                ips :: IO [SockAddr]
                ips = readExternals Mainline.nodeAddr

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs index ef3f6bd4..4f83beb2 100644 --- a/dht/examples/dhtd.hs +++ b/dht/examples/dhtd.hs
@@ -551,7 +551,7 @@ clientSession s@Session{..} sock cnum h = do
551		551
552	("ls", _) \| Just DHT{dhtBuckets} <- Map.lookup netname dhts	552	("ls", _) \| Just DHT{dhtBuckets} <- Map.lookup netname dhts
553	-> cmd0 $ do	553	-> cmd0 $ do
554	bkts <- atomically $ readTVar dhtBuckets	554	bkts <- atomically $ readTVar (refreshBuckets dhtBuckets)
555	let r = reportTable bkts	555	let r = reportTable bkts
556	hPutClient h $	556	hPutClient h $
557	showReport $	557	showReport $
@@ -562,7 +562,7 @@ clientSession s@Session{..} sock cnum h = do
562	("r", s) \| Just DHT{dhtQuery,dhtBuckets} <- Map.lookup netname dhts	562	("r", s) \| Just DHT{dhtQuery,dhtBuckets} <- Map.lookup netname dhts
563	, Just DHTQuery{qsearch} <- Map.lookup "node" dhtQuery	563	, Just DHTQuery{qsearch} <- Map.lookup "node" dhtQuery
564	-> cmd0 $ do	564	-> cmd0 $ do
565	ni <- atomically $ thisNode <$> readTVar dhtBuckets	565	ni <- atomically $ thisNode <$> readTVar (refreshBuckets dhtBuckets)
566	let kad = searchSpace qsearch	566	let kad = searchSpace qsearch
567	nid = kademliaLocation kad ni	567	nid = kademliaLocation kad ni
568	b = case readMaybe $ strp s of	568	b = case readMaybe $ strp s of
@@ -768,7 +768,7 @@ clientSession s@Session{..} sock cnum h = do
768	-- arguments: method	768	-- arguments: method
769	-- nid	769	-- nid
770	-- (optional dest-ni)	770	-- (optional dest-ni)
771	self <- atomically $ thisNode <$> readTVar dhtBuckets	771	self <- atomically $ thisNode <$> readTVar (refreshBuckets dhtBuckets)
772	let (method,xs) = break isSpace $ dropWhile isSpace s	772	let (method,xs) = break isSpace $ dropWhile isSpace s
773	(nidstr,ys) = break isSpace $ dropWhile isSpace xs	773	(nidstr,ys) = break isSpace $ dropWhile isSpace xs
774	destination = dropWhile isSpace ys	774	destination = dropWhile isSpace ys
@@ -819,7 +819,7 @@ clientSession s@Session{..} sock cnum h = do
819	-- data (jid or key) data	819	-- data (jid or key) data
820	-- dest-rendezvous(r) token	820	-- dest-rendezvous(r) token
821	-- (optional extra-text) (optional dest-ni)	821	-- (optional extra-text) (optional dest-ni)
822	self <- atomically $ thisNode <$> readTVar dhtBuckets	822	self <- atomically $ thisNode <$> readTVar (refreshBuckets dhtBuckets)
823	let (method,xs) = break isSpace $ dropWhile isSpace s	823	let (method,xs) = break isSpace $ dropWhile isSpace s
824	(dtastr,ys) = break isSpace $ dropWhile isSpace xs	824	(dtastr,ys) = break isSpace $ dropWhile isSpace xs
825	(tokenstr,zs) = break isSpace $ dropWhile isSpace ys	825	(tokenstr,zs) = break isSpace $ dropWhile isSpace ys
@@ -941,7 +941,7 @@ clientSession s@Session{..} sock cnum h = do
941	(\nid -> R.kclosest (searchSpace qsearch)	941	(\nid -> R.kclosest (searchSpace qsearch)
942	(searchK qsearch)	942	(searchK qsearch)
943	nid	943	nid
944	<$> readTVar dhtBuckets)	944	<$> readTVar (refreshBuckets dhtBuckets))
945	(announceTarget dta)	945	(announceTarget dta)
946	announceInterval)	946	announceInterval)
947	dta	947	dta
@@ -967,7 +967,7 @@ clientSession s@Session{..} sock cnum h = do
967	(\nid -> R.kclosest (searchSpace qsearch)	967	(\nid -> R.kclosest (searchSpace qsearch)
968	(searchK qsearch)	968	(searchK qsearch)
969	nid	969	nid
970	<$> readTVar dhtBuckets)	970	<$> readTVar (refreshBuckets dhtBuckets))
971	(announceTarget dta)	971	(announceTarget dta)
972	announceInterval)	972	announceInterval)
973	dta	973	dta
@@ -1009,7 +1009,7 @@ clientSession s@Session{..} sock cnum h = do
1009	join $ atomically $ do	1009	join $ atomically $ do
1010	schs <- readTVar dhtSearches	1010	schs <- readTVar dhtSearches
1011	case Map.lookup (method,nid) schs of	1011	case Map.lookup (method,nid) schs of
1012	Nothing -> do forkSearch method nid qry dhtSearches dhtBuckets tid kvar	1012	Nothing -> do forkSearch method nid qry dhtSearches (refreshBuckets dhtBuckets) tid kvar
1013	return $ presentSearches	1013	return $ presentSearches
1014	Just sch -> do writeTVar kvar (Just $ return ())	1014	Just sch -> do writeTVar kvar (Just $ return ())
1015	return $ reportSearchResults method h sch	1015	return $ reportSearchResults method h sch
@@ -1614,7 +1614,7 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
1614	tcpclient = tcpKademliaClient $ Tox.toxOnionRoutes tox	1614	tcpclient = tcpKademliaClient $ Tox.toxOnionRoutes tox
1615	tcpRefresher = tcpBucketRefresher $ Tox.toxOnionRoutes tox	1615	tcpRefresher = tcpBucketRefresher $ Tox.toxOnionRoutes tox
1616	tcpDHT = DHT	1616	tcpDHT = DHT
1617	{ dhtBuckets = refreshBuckets tcpRefresher	1617	{ dhtBuckets = tcpRefresher
1618	, dhtSecretKey = return $ Just $ transportSecret (Tox.toxCryptoKeys tox)	1618	, dhtSecretKey = return $ Just $ transportSecret (Tox.toxCryptoKeys tox)
1619	, dhtPing = Map.singleton "ping" DHTPing	1619	, dhtPing = Map.singleton "ping" DHTPing
1620	{ pingQuery = noArgPing $ TCP.tcpPing (TCP.tcpClient tcpclient)	1620	{ pingQuery = noArgPing $ TCP.tcpPing (TCP.tcpClient tcpclient)
@@ -1639,9 +1639,9 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
1639	, dhtShowHexId = Just Tox.showHexId	1639	, dhtShowHexId = Just Tox.showHexId
1640	}	1640	}
1641	dhts = Map.fromList $	1641	dhts = Map.fromList $
1642	("tox4", toxDHT Tox.routing4 Want_IP4)	1642	("tox4", toxDHT Tox.refresher4 Want_IP4)
1643	: (if ip6tox opts	1643	: (if ip6tox opts
1644	then ( ("tox6", toxDHT Tox.routing6 Want_IP6) :)	1644	then ( ("tox6", toxDHT Tox.refresher6 Want_IP6) :)
1645	else id)	1645	else id)
1646	(if enableTCPDHT opts	1646	(if enableTCPDHT opts
1647	then [ ("toxtcp", tcpDHT) ]	1647	then [ ("toxtcp", tcpDHT) ]
@@ -1674,7 +1674,7 @@ initJabber opts ssvar announcer mbtox toxchat = case portxmpp opts of
1674	let lookupBkts :: String -> Map.Map String DHT -> Maybe (String,TVar (BucketList Tox.NodeInfo))	1674	let lookupBkts :: String -> Map.Map String DHT -> Maybe (String,TVar (BucketList Tox.NodeInfo))
1675	lookupBkts name m = case Map.lookup name m of	1675	lookupBkts name m = case Map.lookup name m of
1676	Nothing -> Nothing	1676	Nothing -> Nothing
1677	Just DHT{dhtBuckets} -> cast (name, dhtBuckets)	1677	Just DHT{dhtBuckets} -> cast (name, refreshBuckets dhtBuckets)
1678	sv <- xmppServer Tcp.noCleanUp (Just sport)	1678	sv <- xmppServer Tcp.noCleanUp (Just sport)
1679	tcp <- xmppConnections sv -- :: IO ( Manager TCPStatus T.Text )	1679	tcp <- xmppConnections sv -- :: IO ( Manager TCPStatus T.Text )
1680	let tman = toxman ssvar announcer <$> mbtox	1680	let tman = toxman ssvar announcer <$> mbtox
@@ -1795,9 +1795,9 @@ main = do
1795	, dhtShowHexId = Nothing	1795	, dhtShowHexId = Nothing
1796	}	1796	}
1797	dhts = Map.fromList $	1797	dhts = Map.fromList $
1798	("bt4", mainlineDHT Mainline.routing4 Want_IP4)	1798	("bt4", mainlineDHT Mainline.refresher4 Want_IP4)
1799	: if ip6bt opts	1799	: if ip6bt opts
1800	then [ ("bt6", mainlineDHT Mainline.routing6 Want_IP6) ]	1800	then [ ("bt6", mainlineDHT Mainline.refresher6 Want_IP6) ]
1801	else []	1801	else []
1802	ips :: IO [SockAddr]	1802	ips :: IO [SockAddr]
1803	ips = readExternals Mainline.nodeAddr	1803	ips = readExternals Mainline.nodeAddr