Made the BucketRefresher state accessible from CommonAPI.

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