summaryrefslogtreecommitdiff
path: root/dht/examples/dhtd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'dht/examples/dhtd.hs')
-rw-r--r--dht/examples/dhtd.hs26
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