summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs15
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
419runCryptoHook :: NetCryptoSession -> CryptoData -> IO (Maybe (x -> x)) 420runCryptoHook :: NetCryptoSession -> CryptoData -> IO (Maybe (x -> x))
420runCryptoHook session@(NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce,ncMessageTypes}) 421runCryptoHook 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