diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 14 |
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 | |||
18 | import Data.ByteString (ByteString) | 18 | import Data.ByteString (ByteString) |
19 | import Control.Lens | 19 | import Control.Lens |
20 | import Data.Function | 20 | import Data.Function |
21 | import qualified Data.PacketQueue as PQ | ||
22 | ;import Data.PacketQueue (PacketQueue) | ||
21 | import Data.Serialize as S | 23 | import Data.Serialize as S |
22 | import Data.Word | 24 | import Data.Word |
23 | import GHC.Conc (unsafeIOToSTM) | 25 | import 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 | ||
85 | data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession) | 89 | data 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 | ||
93 | newSessionsState :: TransportCrypto | 98 | newSessionsState :: 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 | ||
125 | data HandshakeParams | 131 | data 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) |