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.hs23
1 files changed, 16 insertions, 7 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 493ae925..b47aeac1 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -589,6 +589,7 @@ freshCryptoSession sessions
589 , ncLastNMsgs = lastNQ 589 , ncLastNMsgs = lastNQ
590 , ncListeners = listeners 590 , ncListeners = listeners
591 } 591 }
592 addSessionToMapIfNotThere sessions addr netCryptoSession0
592 case mbpktoq of 593 case mbpktoq of
593 NeedHandshake -> return () 594 NeedHandshake -> return ()
594 HaveHandshake pktoq -> runUponHandshake netCryptoSession0 addr pktoq 595 HaveHandshake pktoq -> runUponHandshake netCryptoSession0 addr pktoq
@@ -610,11 +611,23 @@ createNetCryptoOutQueue sessions newsession theirSessionKey pktq ncMyPacketNonce
610 trace ("ncMyPacketNonce+1=" ++ show n24plus1 611 trace ("ncMyPacketNonce+1=" ++ show n24plus1
611 ++ "\n toWireIO: theirSessionKey = " ++ show (key2id theirSessionKey) 612 ++ "\n toWireIO: theirSessionKey = " ++ show (key2id theirSessionKey)
612 ++ "\n toWireIO: my public session key = " ++ show (key2id (toPublic newsession)) 613 ++ "\n toWireIO: my public session key = " ++ show (key2id (toPublic newsession))
613 ) $ writeTVar ncMyPacketNonce0 n24plus1 614 ) $ writeTVar ncMyPacketNonce0 n24plus1
614 return (return (f n24, n24, ncOutgoingIdMap0)) 615 return (return (f n24, n24, ncOutgoingIdMap0))
615 pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0 616 pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0
616 return (HaveHandshake pktoq) 617 return (HaveHandshake pktoq)
617 618
619-- | add this session to the lookup maps, unless its already in them
620addSessionToMapIfNotThere :: NetCryptoSessions -> SockAddr -> NetCryptoSession -> IO ()
621addSessionToMapIfNotThere sessions addr netCryptoSession = do
622 atomically $ do
623 let remotePublicKey = ncTheirPublicKey netCryptoSession
624 allsessions = netCryptoSessions sessions
625 allsessionsByKey= netCryptoSessionsByKey sessions
626 modifyTVar allsessions (Map.insert addr netCryptoSession)
627 byKeyResult <- readTVar allsessionsByKey >>= return . Map.lookup remotePublicKey
628 case byKeyResult of
629 Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession])
630 Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs))
618 631
619runUponHandshake :: NetCryptoSession -> SockAddr -> NetCryptoOutQueue -> IO () 632runUponHandshake :: NetCryptoSession -> SockAddr -> NetCryptoOutQueue -> IO ()
620runUponHandshake netCryptoSession0 addr pktoq = do 633runUponHandshake netCryptoSession0 addr pktoq = do
@@ -648,12 +661,7 @@ runUponHandshake netCryptoSession0 addr pktoq = do
648 -- update session with thread ids 661 -- update session with thread ids
649 let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine} 662 let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine}
650 -- add this session to the lookup maps 663 -- add this session to the lookup maps
651 atomically $ do 664 addSessionToMapIfNotThere sessions addr netCryptoSession
652 modifyTVar allsessions (Map.insert addr netCryptoSession)
653 byKeyResult <- readTVar allsessionsByKey >>= return . Map.lookup remotePublicKey
654 case byKeyResult of
655 Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession])
656 Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs))
657 -- run announceNewSessionHooks 665 -- run announceNewSessionHooks
658 hooks <- atomically $ readTVar (announceNewSessionHooks sessions) 666 hooks <- atomically $ readTVar (announceNewSessionHooks sessions)
659 flip fix (hooks,netCryptoSession) $ \loop (hooks,session) -> 667 flip fix (hooks,netCryptoSession) $ \loop (hooks,session) ->
@@ -762,6 +770,7 @@ decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted
762 , handshakeData = pure hsdata 770 , handshakeData = pure hsdata
763 } ) 771 } )
764 772
773toHandshakeParams :: (SecretKey, Handshake Identity) -> HandshakeParams
765toHandshakeParams (key,hs) 774toHandshakeParams (key,hs)
766 = let hd = runIdentity $ handshakeData hs 775 = let hd = runIdentity $ handshakeData hs
767 Cookie _ cd0 = handshakeCookie hs 776 Cookie _ cd0 = handshakeCookie hs