summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Crypto/Handlers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Crypto/Handlers.hs')
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs14
1 files changed, 12 insertions, 2 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 13db02f3..787c69c2 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -18,6 +18,8 @@ import qualified Data.ByteString as B
18import Data.ByteString (ByteString) 18import Data.ByteString (ByteString)
19import Control.Lens 19import Control.Lens
20import Data.Function 20import Data.Function
21import qualified Data.PacketQueue as PQ
22 ;import Data.PacketQueue (PacketQueue)
21import Data.Serialize as S 23import Data.Serialize as S
22import Data.Word 24import Data.Word
23import GHC.Conc (unsafeIOToSTM) 25import GHC.Conc (unsafeIOToSTM)
@@ -63,7 +65,7 @@ data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus
63 , ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number 65 , ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number
64 , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number 66 , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number
65 , ncHandShake :: TVar (Maybe (Handshake Encrypted)) 67 , ncHandShake :: TVar (Maybe (Handshake Encrypted))
66 , ncCookie :: TVar (Maybe Cookie) 68 , ncCookie :: TVar (Maybe Cookie) -- ^ Cookie issued by remote peer
67 , ncTheirDHTKey :: PublicKey 69 , ncTheirDHTKey :: PublicKey
68 , ncTheirSessionPublic :: Maybe PublicKey 70 , ncTheirSessionPublic :: Maybe PublicKey
69 , ncSessionSecret :: SecretKey 71 , ncSessionSecret :: SecretKey
@@ -80,6 +82,8 @@ data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus
80 -- needs to possibly start another, as is 82 -- needs to possibly start another, as is
81 -- the case in group chats 83 -- the case in group chats
82 , ncView :: TVar SessionView 84 , ncView :: TVar SessionView
85 , ncPacketQueue :: PacketQueue CryptoMessage
86 , ncBufferStart :: TVar Word32
83 } 87 }
84 88
85data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession) 89data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
@@ -88,6 +92,7 @@ data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAdd
88 , defaultUnrecognizedHook :: MessageType -> NetCryptoHook 92 , defaultUnrecognizedHook :: MessageType -> NetCryptoHook
89 , sessionView :: SessionView 93 , sessionView :: SessionView
90 , msgTypeArray :: MsgTypeArray 94 , msgTypeArray :: MsgTypeArray
95 , inboundQueueCapacity :: Word32
91 } 96 }
92 97
93newSessionsState :: TransportCrypto 98newSessionsState :: TransportCrypto
@@ -120,6 +125,7 @@ newSessionsState crypto unrechook hooks = do
120 , svDownloadDir = svDownloadDir0 125 , svDownloadDir = svDownloadDir0
121 } 126 }
122 , msgTypeArray = allMsgTypes -- todo make this a parameter 127 , msgTypeArray = allMsgTypes -- todo make this a parameter
128 , inboundQueueCapacity = 200
123 } 129 }
124 130
125data HandshakeParams 131data HandshakeParams
@@ -195,6 +201,8 @@ freshCryptoSession sessions
195 ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions) 201 ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions)
196 ncMessageTypes0 <- atomically $ newTVar (msgTypeArray sessions) 202 ncMessageTypes0 <- atomically $ newTVar (msgTypeArray sessions)
197 ncView0 <- atomically $ newTVar (sessionView sessions) 203 ncView0 <- atomically $ newTVar (sessionView sessions)
204 pktq <- atomically $ PQ.new (inboundQueueCapacity sessions) 0
205 bufstart <- atomically $ newTVar 0
198 let netCryptoSession = 206 let netCryptoSession =
199 NCrypto { ncState = ncState0 207 NCrypto { ncState = ncState0
200 , ncTheirBaseNonce= ncTheirBaseNonce0 208 , ncTheirBaseNonce= ncTheirBaseNonce0
@@ -210,6 +218,8 @@ freshCryptoSession sessions
210 , ncAllSessions = sessions 218 , ncAllSessions = sessions
211 , ncMessageTypes = ncMessageTypes0 219 , ncMessageTypes = ncMessageTypes0
212 , ncView = ncView0 220 , ncView = ncView0
221 , ncPacketQueue = pktq
222 , ncBufferStart = bufstart
213 } 223 }
214 atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession) 224 atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession)
215 225
@@ -224,7 +234,7 @@ updateCryptoSession sessions addr hp session = do
224 -- duplicate handshake packet, otherwise disregard everything, and 234 -- duplicate handshake packet, otherwise disregard everything, and
225 -- refresh all state. 235 -- refresh all state.
226 -- 236 --
227 then when ( Just ncTheirBaseNonce0 /= hpTheirBaseNonce hp 237 then when ( Just ncTheirBaseNonce0 /= hpTheirBaseNonce hp -- XXX: Do we really want to compare base nonce here?
228 || ncTheirDHTKey session /= hpCookieRemoteDhtkey hp 238 || ncTheirDHTKey session /= hpCookieRemoteDhtkey hp
229 ) $ freshCryptoSession sessions addr hp 239 ) $ freshCryptoSession sessions addr hp
230 else if ( Just ncTheirBaseNonce0 /= hpTheirBaseNonce hp) 240 else if ( Just ncTheirBaseNonce0 /= hpTheirBaseNonce hp)