diff options
Diffstat (limited to 'dht/src/Network/Tox.hs')
-rw-r--r-- | dht/src/Network/Tox.hs | 47 |
1 files changed, 25 insertions, 22 deletions
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs index 5d27f34f..4898513a 100644 --- a/dht/src/Network/Tox.hs +++ b/dht/src/Network/Tox.hs | |||
@@ -34,6 +34,7 @@ import qualified Data.ByteString as B | |||
34 | ;import Data.ByteString (ByteString) | 34 | ;import Data.ByteString (ByteString) |
35 | import qualified Data.ByteString.Char8 as C8 | 35 | import qualified Data.ByteString.Char8 as C8 |
36 | import Data.Data | 36 | import Data.Data |
37 | import Data.Dependent.Sum | ||
37 | import Data.Functor.Identity | 38 | import Data.Functor.Identity |
38 | import Data.Functor.Contravariant | 39 | import Data.Functor.Contravariant |
39 | import Data.Maybe | 40 | import Data.Maybe |
@@ -45,27 +46,28 @@ import Network.Socket | |||
45 | import System.Endian | 46 | import System.Endian |
46 | import System.IO.Error | 47 | import System.IO.Error |
47 | 48 | ||
49 | import Crypto.Tox | ||
48 | import Data.TableMethods | 50 | import Data.TableMethods |
51 | import qualified Data.Tox.DHT.Multi as Multi | ||
49 | import Data.Tox.Onion (substituteLoopback) | 52 | import Data.Tox.Onion (substituteLoopback) |
50 | import Network.Tox.RelayPinger | ||
51 | import qualified Data.Word64Map | 53 | import qualified Data.Word64Map |
52 | import Network.BitTorrent.DHT.Token as Token | ||
53 | import qualified Data.Wrapper.PSQ as PSQ | ||
54 | import System.Global6 | ||
55 | import Network.Address (WantIP (..),IP,getBindAddress) | ||
56 | import qualified Network.Kademlia.Routing as R | ||
57 | import Network.QueryResponse | ||
58 | import Network.StreamServer (ServerHandle,quitListening) | ||
59 | import Crypto.Tox | ||
60 | import Data.Word64Map (fitsInInt) | ||
61 | import qualified Data.Word64Map (empty) | 54 | import qualified Data.Word64Map (empty) |
62 | import Network.Kademlia.Bootstrap (forkPollForRefresh, bootstrap) | 55 | ;import Data.Word64Map (fitsInInt) |
63 | import Network.Tox.Crypto.Transport (Handshake(..),CryptoPacket) | 56 | import qualified Data.Wrapper.PSQ as PSQ |
57 | import Network.Address (IP, WantIP (..), getBindAddress) | ||
58 | import Network.BitTorrent.DHT.Token as Token | ||
59 | import Network.Kademlia.Bootstrap (bootstrap, forkPollForRefresh) | ||
60 | import qualified Network.Kademlia.Routing as R | ||
61 | import Network.QueryResponse | ||
62 | import Network.StreamServer (ServerHandle, quitListening) | ||
63 | import Network.Tox.Crypto.Transport (CryptoPacket, Handshake (..)) | ||
64 | import qualified Network.Tox.DHT.Handlers as DHT | 64 | import qualified Network.Tox.DHT.Handlers as DHT |
65 | import qualified Network.Tox.DHT.Transport as DHT | 65 | import qualified Network.Tox.DHT.Transport as DHT |
66 | import Network.Tox.NodeId | 66 | import Network.Tox.NodeId |
67 | import qualified Network.Tox.Onion.Handlers as Onion | 67 | import qualified Network.Tox.Onion.Handlers as Onion |
68 | import qualified Network.Tox.Onion.Transport as Onion | 68 | import qualified Network.Tox.Onion.Transport as Onion |
69 | import Network.Tox.RelayPinger | ||
70 | import System.Global6 | ||
69 | import Network.Tox.Transport | 71 | import Network.Tox.Transport |
70 | import Network.Tox.TCP (tcpClient) | 72 | import Network.Tox.TCP (tcpClient) |
71 | import Network.Tox.Onion.Routes | 73 | import Network.Tox.Onion.Routes |
@@ -117,14 +119,14 @@ nonceKey (DHT.TransactionId n _) = n | |||
117 | -- | Return my own address. | 119 | -- | Return my own address. |
118 | myAddr :: TVar (R.BucketList NodeInfo) -- ^ IPv4 buckets | 120 | myAddr :: TVar (R.BucketList NodeInfo) -- ^ IPv4 buckets |
119 | -> TVar (R.BucketList NodeInfo) -- ^ IPv6 buckets | 121 | -> TVar (R.BucketList NodeInfo) -- ^ IPv6 buckets |
120 | -> Maybe NodeInfo -- ^ Interested remote address | 122 | -> Maybe Multi.NodeInfo -- ^ Interested remote address |
121 | -> IO NodeInfo | 123 | -> IO Multi.NodeInfo |
122 | myAddr routing4 routing6 maddr = atomically $ do | 124 | myAddr routing4 routing6 maddr = atomically $ do |
123 | let var = case flip DHT.prefer4or6 Nothing <$> maddr of | 125 | let var = case flip DHT.prefer4or6 Nothing <$> maddr of |
124 | Just Want_IP6 -> routing4 | 126 | Just Want_IP6 -> routing4 |
125 | _ -> routing6 | 127 | _ -> routing6 |
126 | a <- readTVar var | 128 | a <- readTVar var |
127 | return $ R.thisNode a | 129 | return $ Multi.UDP ==> R.thisNode a |
128 | 130 | ||
129 | newClient :: (DRG g, Show addr, Show meth) => | 131 | newClient :: (DRG g, Show addr, Show meth) => |
130 | g -> Transport String addr x | 132 | g -> Transport String addr x |
@@ -177,8 +179,8 @@ data Tox extra = Tox | |||
177 | { toxDHT :: DHT.Client | 179 | { toxDHT :: DHT.Client |
178 | , toxOnion :: Onion.Client RouteId | 180 | , toxOnion :: Onion.Client RouteId |
179 | , toxToRoute :: Transport String Onion.AnnouncedRendezvous (PublicKey,Onion.OnionData) | 181 | , toxToRoute :: Transport String Onion.AnnouncedRendezvous (PublicKey,Onion.OnionData) |
180 | , toxCrypto :: Transport String SockAddr (CryptoPacket Encrypted) | 182 | , toxCrypto :: Transport String Multi.SessionAddress (CryptoPacket Encrypted) |
181 | , toxHandshakes :: Transport String SockAddr (Handshake Encrypted) | 183 | , toxHandshakes :: Transport String Multi.SessionAddress (Handshake Encrypted) |
182 | , toxHandshakeCache :: HandshakeCache | 184 | , toxHandshakeCache :: HandshakeCache |
183 | , toxCryptoKeys :: TransportCrypto | 185 | , toxCryptoKeys :: TransportCrypto |
184 | , toxRouting :: DHT.Routing | 186 | , toxRouting :: DHT.Routing |
@@ -344,17 +346,18 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do | |||
344 | let lookupClose _ = return Nothing | 346 | let lookupClose _ = return Nothing |
345 | 347 | ||
346 | mkrouting <- DHT.newRouting addr crypto updateIP updateIP | 348 | mkrouting <- DHT.newRouting addr crypto updateIP updateIP |
347 | (orouter,otbl) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp) | 349 | (orouter,relaynet,otbl) <- newOnionRouter crypto (dput XRoutes) (maybe False (const True) tcp) |
348 | (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) | 350 | (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) |
349 | <- toxTransport crypto orouter lookupClose addr udp | 351 | <- toxTransport crypto orouter lookupClose addr udp relaynet |
350 | (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x)) | 352 | (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x)) |
351 | (fromMaybe (\_ _ -> return ()) tcp) | 353 | (fromMaybe (\_ _ -> return ()) tcp) |
352 | sessions <- initSessions (sendMessage cryptonet) | 354 | sessions <- initSessions (sendMessage cryptonet) |
353 | 355 | ||
354 | let dhtnet0 = layerTransportM (DHT.decrypt crypto nodeId) (DHT.encrypt crypto nodeId) dhtcrypt | 356 | let dhtnet0 = layerTransportM (DHT.decrypt crypto Multi.nodeId) (DHT.encrypt crypto Multi.nodeId) dhtcrypt |
355 | tbl4 = DHT.routing4 $ mkrouting (error "missing client") | 357 | tbl4 = DHT.routing4 $ mkrouting (error "missing client") |
356 | tbl6 = DHT.routing6 $ mkrouting (error "missing client") | 358 | tbl6 = DHT.routing6 $ mkrouting (error "missing client") |
357 | updateOnion bkts tr = hookBucketList DHT.toxSpace bkts orouter (trampolinesUDP orouter) tr | 359 | updateOnion bkts tr = hookBucketList DHT.toxSpace bkts orouter (trampolinesUDP orouter) tr |
360 | |||
358 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id | 361 | dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id |
359 | (\client net -> onInbound (DHT.updateRouting client (mkrouting client) updateOnion) net) | 362 | (\client net -> onInbound (DHT.updateRouting client (mkrouting client) updateOnion) net) |
360 | 363 | ||
@@ -370,7 +373,7 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do | |||
370 | -- This function should only initialize state. | 373 | -- This function should only initialize state. |
371 | orouter' <- forkRouteBuilder orouter | 374 | orouter' <- forkRouteBuilder orouter |
372 | $ \nid ni -> fmap (\(_,ns,_)->ns) | 375 | $ \nid ni -> fmap (\(_,ns,_)->ns) |
373 | <$> DHT.getNodes dhtclient (DHT.nodesOfInterest $ mkrouting dhtclient) nid ni | 376 | <$> DHT.getNodes dhtclient (DHT.nodesOfInterest $ mkrouting dhtclient) nid (Multi.UDP ==> ni) |
374 | 377 | ||
375 | toks <- do | 378 | toks <- do |
376 | nil <- nullSessionTokens | 379 | nil <- nullSessionTokens |
@@ -420,7 +423,7 @@ dnssdDiscover tox ni toxid = do | |||
420 | forM acts $ \act -> | 423 | forM acts $ \act -> |
421 | atomically $ setContactAddr now (id2key tid) ni act | 424 | atomically $ setContactAddr now (id2key tid) ni act |
422 | 425 | ||
423 | void $ DHT.ping (toxDHT tox) ni | 426 | void $ DHT.pingUDP (toxDHT tox) ni |
424 | 427 | ||
425 | -- | Returns: | 428 | -- | Returns: |
426 | -- | 429 | -- |