From 0e799f254da5856d4ac929088df006f9497ac219 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Tue, 19 Jun 2018 15:39:43 -0400 Subject: introduce udp send delaying in toxTransport --- src/Network/Tox/Transport.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) 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 import Network.Tox.Onion.Transport import Network.Tox.Crypto.Transport import OnionRouter +import Data.ByteString (ByteString) +import Control.Concurrent +import Control.Concurrent.STM +import Control.Concurrent.STM.TChan import Network.Socket @@ -29,8 +33,18 @@ toxTransport :: , Transport String AnnouncedRendezvous (PublicKey,OnionData) , Transport String SockAddr (Handshake Encrypted)) toxTransport crypto orouter closeLookup udp = do + delayerChan <- newTChanIO + let delayerLoop = do + action <- atomically $ readTChan delayerChan + threadDelay 1000 + action + delayerLoop + let delayer = atomically . writeTChan delayerChan + delayer' = (fmap.fmap) delayer + forkIO delayerLoop (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp - (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto udp0 + (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) $ forwardOnions crypto + (modifySendMessage delayer' udp0) (onion1,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter) (encodeOnionAddr crypto $ lookupRoute orouter) udp1 @@ -42,6 +56,8 @@ toxTransport crypto orouter closeLookup udp = do , dta , handshakes ) + where + modifySendMessage mod t@Transport{..} = Transport awaitMessage (mod sendMessage) closeTransport -- instance (Sized a, Sized b) => Sized (a,b) where size = _todo -- cgit v1.2.3