diff options
Diffstat (limited to 'dht')
-rw-r--r-- | dht/examples/dhtd.hs | 26 |
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 | |||
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 |