summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Crypto/Handlers.hs
diff options
context:
space:
mode:
authorjim@bo <jim@bo>2018-06-21 04:26:54 -0400
committerjim@bo <jim@bo>2018-06-21 04:31:20 -0400
commita33fd34516e405d29654dff85df235b3c26ab565 (patch)
treeb814088fd3b8be1d4083fdfa32f25b460e8584d8 /src/Network/Tox/Crypto/Handlers.hs
parentd0cad3e46bc798dfc9e5ef2f4483d9e637bf8a67 (diff)
netCrypto packet-request thread wip
Diffstat (limited to 'src/Network/Tox/Crypto/Handlers.hs')
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs27
1 files changed, 27 insertions, 0 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index ae8ce873..ea5c0f98 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -342,6 +342,10 @@ data NetCryptoSession = NCrypto
342 -- ^ a buffer in which incoming packets may be stored out of order 342 -- ^ a buffer in which incoming packets may be stored out of order
343 -- but from which they may be extracted in sequence, 343 -- but from which they may be extracted in sequence,
344 -- helps ensure lossless packets are processed in order 344 -- helps ensure lossless packets are processed in order
345 , ncRequestInterval :: TVar Int
346 -- ^ How long (in microseconds) to wait between packet requests
347 , ncRequestThread :: TVar (Maybe ThreadId)
348 -- ^ thread which sends packet requests
345 , ncDequeueThread :: TVar (Maybe ThreadId) 349 , ncDequeueThread :: TVar (Maybe ThreadId)
346 -- ^ when the thread which dequeues from ncPacketQueue 350 -- ^ when the thread which dequeues from ncPacketQueue
347 -- is started, its ThreadId is stored here 351 -- is started, its ThreadId is stored here
@@ -605,6 +609,8 @@ freshCryptoSession sessions
605 dmsg $ "freshCryptoSession: Session ncTheirBaseNonce=" ++ show theirbasenonce 609 dmsg $ "freshCryptoSession: Session ncTheirBaseNonce=" ++ show theirbasenonce
606 dmsg $ "freshCryptoSession: My Session Public =" ++ show (key2id $ toPublic newsession) 610 dmsg $ "freshCryptoSession: My Session Public =" ++ show (key2id $ toPublic newsession)
607 ncTheirSessionPublic0 <- newTVar (frmMaybe mbtheirSessionKey) 611 ncTheirSessionPublic0 <- newTVar (frmMaybe mbtheirSessionKey)
612 ncRequestInterval0 <- newTVar 250000 -- quarter of a second
613 ncRequestThread0 <- newTVar Nothing
608 ncDequeueThread0 <- newTVar Nothing 614 ncDequeueThread0 <- newTVar Nothing
609 ncDequeueOutGoingThread0 <- newTVar Nothing 615 ncDequeueOutGoingThread0 <- newTVar Nothing
610 ncPingMachine0 <- newTVar Nothing 616 ncPingMachine0 <- newTVar Nothing
@@ -631,6 +637,8 @@ freshCryptoSession sessions
631 , ncOutgoingIdMapEscapedLossless = losslessEscapeIdMap 637 , ncOutgoingIdMapEscapedLossless = losslessEscapeIdMap
632 , ncView = ncView0 638 , ncView = ncView0
633 , ncPacketQueue = pktq 639 , ncPacketQueue = pktq
640 , ncRequestInterval = ncRequestInterval0
641 , ncRequestThread = ncRequestThread0
634 , ncDequeueThread = ncDequeueThread0 642 , ncDequeueThread = ncDequeueThread0
635 , ncDequeueOutGoingThread = ncDequeueOutGoingThread0 643 , ncDequeueOutGoingThread = ncDequeueOutGoingThread0
636 , ncPingMachine = ncPingMachine0 644 , ncPingMachine = ncPingMachine0
@@ -737,6 +745,25 @@ runUponHandshake netCryptoSession0 addr pktoq = do
737 _ <- runCryptoHook netCryptoSession0 (bufferData cd) 745 _ <- runCryptoHook netCryptoSession0 (bufferData cd)
738 loop 746 loop
739 dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoDequeue." ++ show (key2id remotePublicKey) ++ sidStr 747 dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoDequeue." ++ show (key2id remotePublicKey) ++ sidStr
748 -- launch request thread
749 -- (In terms of data dependency, this thread could be launched prior to handshake)
750 threadid <- forkIO $ do
751 tid <- myThreadId
752 atomically $ writeTVar (ncDequeueThread netCryptoSession0) (Just tid)
753 labelThread tid ("NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr)
754 fix $ \loop -> do
755 atomically (readTVar (ncRequestInterval netCryptoSession0)) >>= threadDelay
756 result <- atomically $ PQ.dequeueOrGetMissing pktq
757 case result of
758 Right cd -> do
759 dput XNetCrypto $ "Dequeued(Request Thread)::" ++ show (bufferData cd) ++ " now running hook..."
760 _ <- runCryptoHook netCryptoSession0 (bufferData cd)
761 return ()
762 Left nums -> do
763 dput XNetCrypto $ "(Request Thread) Missing Packets detected:" ++ show nums
764 dput XNetCrypto $ "TODO: compose PacketRequest message and send it."
765 loop
766 dput XNetCrypto $ "runUponHandshake: " ++ show threadid ++ " = NetCryptoRequest." ++ show (key2id remotePublicKey) ++ sidStr
740 -- launch dequeueOutgoing thread 767 -- launch dequeueOutgoing thread
741 threadidOutgoing <- forkIO $ do 768 threadidOutgoing <- forkIO $ do
742 tid <- myThreadId 769 tid <- myThreadId