summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/Tox/Transport.hs18
1 files changed, 17 insertions, 1 deletions
diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs
index 57f07aad..12ebb6d6 100644
--- a/src/Network/Tox/Transport.hs
+++ b/src/Network/Tox/Transport.hs
@@ -15,6 +15,10 @@ import Network.Tox.DHT.Transport
15import Network.Tox.Onion.Transport 15import Network.Tox.Onion.Transport
16import Network.Tox.Crypto.Transport 16import Network.Tox.Crypto.Transport
17import OnionRouter 17import OnionRouter
18import Data.ByteString (ByteString)
19import Control.Concurrent
20import Control.Concurrent.STM
21import Control.Concurrent.STM.TChan
18 22
19import Network.Socket 23import Network.Socket
20 24
@@ -29,8 +33,18 @@ toxTransport ::
29 , Transport String AnnouncedRendezvous (PublicKey,OnionData) 33 , Transport String AnnouncedRendezvous (PublicKey,OnionData)
30 , Transport String SockAddr (Handshake Encrypted)) 34 , Transport String SockAddr (Handshake Encrypted))
31toxTransport crypto orouter closeLookup udp = do 35toxTransport crypto orouter closeLookup udp = do
36 delayerChan <- newTChanIO
37 let delayerLoop = do
38 action <- atomically $ readTChan delayerChan
39 threadDelay 1000
40 action
41 delayerLoop
42 let delayer = atomically . writeTChan delayerChan
43 delayer' = (fmap.fmap) delayer
44 forkIO delayerLoop
32 (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp 45 (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp
33 (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto udp0 46 (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto
47 (modifySendMessage delayer' udp0)
34 (onion1,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter) 48 (onion1,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter)
35 (encodeOnionAddr crypto $ lookupRoute orouter) 49 (encodeOnionAddr crypto $ lookupRoute orouter)
36 udp1 50 udp1
@@ -42,6 +56,8 @@ toxTransport crypto orouter closeLookup udp = do
42 , dta 56 , dta
43 , handshakes 57 , handshakes
44 ) 58 )
59 where
60 modifySendMessage mod t@Transport{..} = Transport awaitMessage (mod sendMessage) closeTransport
45 61
46 62
47-- instance (Sized a, Sized b) => Sized (a,b) where size = _todo 63-- instance (Sized a, Sized b) => Sized (a,b) where size = _todo