diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 306433c1..fc90d01a 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs | |||
@@ -77,7 +77,8 @@ data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatu | |||
77 | , ncSockAddr :: SockAddr | 77 | , ncSockAddr :: SockAddr |
78 | , ncHooks :: TVar (Map.Map MessageType [NetCryptoHook]) | 78 | , ncHooks :: TVar (Map.Map MessageType [NetCryptoHook]) |
79 | , ncUnrecognizedHook :: TVar (MessageType -> NetCryptoHook) | 79 | , ncUnrecognizedHook :: TVar (MessageType -> NetCryptoHook) |
80 | , ncMessageTypes :: TVar MsgTypeArray -- ^ supported messages, 0 for unsupported, | 80 | , ncIncomingTypeArray :: TVar MsgTypeArray |
81 | -- ^ supported messages, 0 for unsupported, | ||
81 | -- otherwise the messageType, some message types | 82 | -- otherwise the messageType, some message types |
82 | -- may not be in ncHooks yet, but they should appear | 83 | -- may not be in ncHooks yet, but they should appear |
83 | -- here if ncUnrecognizedHook will add them to ncHooks | 84 | -- here if ncUnrecognizedHook will add them to ncHooks |
@@ -245,7 +246,7 @@ freshCryptoSession sessions | |||
245 | newsession <- generateSecretKey | 246 | newsession <- generateSecretKey |
246 | ncHooks0 <- atomically $ newTVar (defaultHooks sessions) | 247 | ncHooks0 <- atomically $ newTVar (defaultHooks sessions) |
247 | ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions) | 248 | ncUnrecognizedHook0 <- atomically $ newTVar (defaultUnrecognizedHook sessions) |
248 | ncMessageTypes0 <- atomically $ newTVar (msgTypeArray sessions) | 249 | ncIncomingTypeArray0 <- atomically $ newTVar (msgTypeArray sessions) |
249 | ncView0 <- atomically $ newTVar (sessionView sessions) | 250 | ncView0 <- atomically $ newTVar (sessionView sessions) |
250 | pktq <- atomically $ PQ.new (inboundQueueCapacity sessions) 0 | 251 | pktq <- atomically $ PQ.new (inboundQueueCapacity sessions) 0 |
251 | bufstart <- atomically $ newTVar 0 | 252 | bufstart <- atomically $ newTVar 0 |
@@ -264,7 +265,7 @@ freshCryptoSession sessions | |||
264 | , ncHooks = ncHooks0 | 265 | , ncHooks = ncHooks0 |
265 | , ncUnrecognizedHook = ncUnrecognizedHook0 | 266 | , ncUnrecognizedHook = ncUnrecognizedHook0 |
266 | , ncAllSessions = sessions | 267 | , ncAllSessions = sessions |
267 | , ncMessageTypes = ncMessageTypes0 | 268 | , ncIncomingTypeArray = ncIncomingTypeArray0 |
268 | , ncView = ncView0 | 269 | , ncView = ncView0 |
269 | , ncPacketQueue = pktq | 270 | , ncPacketQueue = pktq |
270 | , ncBufferStart = bufstart | 271 | , ncBufferStart = bufstart |
@@ -367,7 +368,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do | |||
367 | -- Handle Encrypted Message | 368 | -- Handle Encrypted Message |
368 | case Map.lookup addr sessionsmap of | 369 | case Map.lookup addr sessionsmap of |
369 | Nothing -> return Nothing -- drop packet, we have no session | 370 | Nothing -> return Nothing -- drop packet, we have no session |
370 | Just session@(NCrypto {ncMessageTypes, ncState, ncPacketQueue, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce}) -> do | 371 | Just session@(NCrypto {ncIncomingTypeArray, ncState, ncPacketQueue, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce}) -> do |
371 | theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce | 372 | theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce |
372 | -- Try to decrypt message | 373 | -- Try to decrypt message |
373 | let diff :: Word16 | 374 | let diff :: Word16 |
@@ -396,7 +397,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do | |||
396 | writeTVar ncTheirBaseNonce y | 397 | writeTVar ncTheirBaseNonce y |
397 | -- then set session confirmed, | 398 | -- then set session confirmed, |
398 | atomically $ writeTVar ncState Confirmed | 399 | atomically $ writeTVar ncState Confirmed |
399 | msgTypes <- atomically $ readTVar ncMessageTypes | 400 | msgTypes <- atomically $ readTVar ncIncomingTypeArray |
400 | let msgTyp = cd ^. messageType | 401 | let msgTyp = cd ^. messageType |
401 | msgTypMapped16 = msgTypes A.! fromEnum8 (msgID cm) | 402 | msgTypMapped16 = msgTypes A.! fromEnum8 (msgID cm) |
402 | msgTypMapped = fromWord16 $ msgTypMapped16 | 403 | msgTypMapped = fromWord16 $ msgTypMapped16 |
@@ -417,12 +418,12 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do | |||
417 | 418 | ||
418 | -- | TODO: make this accept CrytpoMessage instead | 419 | -- | TODO: make this accept CrytpoMessage instead |
419 | runCryptoHook :: NetCryptoSession -> CryptoData -> IO (Maybe (x -> x)) | 420 | runCryptoHook :: NetCryptoSession -> CryptoData -> IO (Maybe (x -> x)) |
420 | runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce,ncMessageTypes}) | 421 | runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce,ncIncomingTypeArray}) |
421 | cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) = do | 422 | cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) = do |
422 | hookmap <- atomically $ readTVar ncHooks | 423 | hookmap <- atomically $ readTVar ncHooks |
423 | -- run hook | 424 | -- run hook |
424 | flip fix (cd,hookmap) $ \lookupAgain (cd,hookmap) -> do | 425 | flip fix (cd,hookmap) $ \lookupAgain (cd,hookmap) -> do |
425 | msgTypes <- atomically $ readTVar ncMessageTypes | 426 | msgTypes <- atomically $ readTVar ncIncomingTypeArray |
426 | let msgTyp = cd ^. messageType | 427 | let msgTyp = cd ^. messageType |
427 | msgTypMapped16 = msgTypes A.! fromEnum8 (msgID cm) | 428 | msgTypMapped16 = msgTypes A.! fromEnum8 (msgID cm) |
428 | msgTypMapped = fromWord16 $ msgTypMapped16 | 429 | msgTypMapped = fromWord16 $ msgTypMapped16 |