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, 8 insertions, 6 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index cc2fba6d..f650a815 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -707,14 +707,16 @@ updateCryptoSession sessions addr hp session handshake = do
707 then freshCryptoSession sessions addr hp -- basenonce mismatch, trigger refresh 707 then freshCryptoSession sessions addr hp -- basenonce mismatch, trigger refresh
708 else atomically $ writeTVar (ncState session) {-Accepted-}(InProgress AwaitingSessionPacket) 708 else atomically $ writeTVar (ncState session) {-Accepted-}(InProgress AwaitingSessionPacket)
709 709
710anyRight :: Monad m => a -> [t] -> (t -> m (Either b b1)) -> m (Either a b1)
711anyRight e [] f = return $ Left e
712anyRight e (x:xs) f = f x >>= either (const $ anyRight e xs f) (return . Right)
713
710handshakeH :: NetCryptoSessions -> SockAddr -> Handshake Encrypted -> IO (Maybe a) 714handshakeH :: NetCryptoSessions -> SockAddr -> Handshake Encrypted -> IO (Maybe a)
711handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do 715handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
712 dput XNetCrypto ("RECIEVED HANDSHAKE from " ++ show addr) 716 dput XNetCrypto ("RECIEVED HANDSHAKE from " ++ show addr)
713 -- Handle Handshake Message 717 -- Handle Handshake Message
714 let crypto = transportCrypto sessions 718 let crypto = transportCrypto sessions :: TransportCrypto
715 allsessions = netCryptoSessions sessions 719 allsessions = netCryptoSessions sessions :: TVar (Map.Map SockAddr NetCryptoSession)
716 anyRight [] f = return $ Left "missing key"
717 anyRight (x:xs) f = f x >>= either (const $ anyRight xs f) (return . Right)
718 seckeys <- map fst <$> atomically (userKeys crypto) 720 seckeys <- map fst <$> atomically (userKeys crypto)
719 dput XNetCrypto "trying the following keys:" 721 dput XNetCrypto "trying the following keys:"
720 forM_ seckeys $ \k -> dput XNetCrypto $ " " ++ show (key2id . toPublic $ k) 722 forM_ seckeys $ \k -> dput XNetCrypto $ " " ++ show (key2id . toPublic $ k)
@@ -722,9 +724,9 @@ handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypte
722 now <- getPOSIXTime 724 now <- getPOSIXTime
723 dput XNetCrypto ("Decrypt cookie with n24=" ++ show n24 ++ "\n symkey= " ++ show symkey) 725 dput XNetCrypto ("Decrypt cookie with n24=" ++ show n24 ++ "\n symkey= " ++ show symkey)
724 lr <- fmap join . sequence $ do -- Either Monad 726 lr <- fmap join . sequence $ do -- Either Monad
725 (CookieData cookieTime remotePubkey remoteDhtkey) <- (decodePlain =<< decryptSymmetric symkey n24 ecookie) 727 CookieData cookieTime remotePubkey remoteDhtkey <- decodePlain =<< decryptSymmetric symkey n24 ecookie
726 Right $ do -- IO Monad 728 Right $ do -- IO Monad
727 decrypted <- anyRight seckeys $ \key -> do 729 decrypted <- anyRight "missing key" seckeys $ \key -> do
728 dput XNetCrypto $ "(NetCrypto)handshakeH: remotePubkey = " ++ show (key2id $ remotePubkey) 730 dput XNetCrypto $ "(NetCrypto)handshakeH: remotePubkey = " ++ show (key2id $ remotePubkey)
729 dput XNetCrypto $ "(NetCrypto)handshakeH: nonce24 = " ++ show nonce24 731 dput XNetCrypto $ "(NetCrypto)handshakeH: nonce24 = " ++ show nonce24
730 secret <- lookupSharedSecret crypto key remotePubkey nonce24 732 secret <- lookupSharedSecret crypto key remotePubkey nonce24