diff options
-rw-r--r-- | src/Network/Tox/Transport.hs | 18 |
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 | |||
15 | import Network.Tox.Onion.Transport | 15 | import Network.Tox.Onion.Transport |
16 | import Network.Tox.Crypto.Transport | 16 | import Network.Tox.Crypto.Transport |
17 | import OnionRouter | 17 | import OnionRouter |
18 | import Data.ByteString (ByteString) | ||
19 | import Control.Concurrent | ||
20 | import Control.Concurrent.STM | ||
21 | import Control.Concurrent.STM.TChan | ||
18 | 22 | ||
19 | import Network.Socket | 23 | import 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)) |
31 | toxTransport crypto orouter closeLookup udp = do | 35 | toxTransport 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 |