1 files changed, 18 insertions, 44 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 2a1461f2..307efb22 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -712,7 +712,7 @@ anyRight :: Monad m => a -> [t] -> (t -> m (Either b b1)) -> m (Either a b1)
 anyRight e []     f = return $ Left e
 anyRight e (x:xs) f = f x >>= either (const $ anyRight e xs f) (return . Right)
-decryptHandshake :: TransportCrypto -> Handshake Encrypted -> IO (Either String (Handshake Identity))
+decryptHandshake :: TransportCrypto -> Handshake Encrypted -> IO (Either String (SecretKey,Handshake Identity))
 decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
    (ukeys,symkey) <- atomically $ (,) <$> userKeys crypto
                                       <*> transportSymmetric crypto
@@ -746,9 +746,22 @@ decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted
                hctx' = hashUpdate hctx ecookie
                digest = hashFinalize hctx'
            left (asTypeOf "cookie digest mismatch") $ guard (cookieHash == digest)
-            return hshake { handshakeCookie = Cookie n24 (pure cd)
+            return ( key
-                          , handshakeData   = pure hsdata
+                   , hshake { handshakeCookie = Cookie n24 (pure cd)
-                          }
+                            , handshakeData   = pure hsdata
+                            } )
+toHandshakeParams (key,hs)
+    = let hd = runIdentity $ handshakeData hs
+          Cookie _ cd0 = handshakeCookie hs
+          CookieData _ remotePublicKey remoteDhtPublicKey = runIdentity cd0
+      in HParam { hpTheirBaseNonce        = Just $ baseNonce hd
+                , hpOtherCookie           = otherCookie hd
+                , hpTheirSessionKeyPublic = Just $ sessionKey hd
+                , hpMySecretKey           = key
+                , hpCookieRemotePubkey    = remotePublicKey
+                , hpCookieRemoteDhtkey    = remoteDhtPublicKey
+                }
 handshakeH :: NetCryptoSessions -> SockAddr -> Handshake Encrypted -> IO (Maybe a)
 handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
@@ -762,46 +775,7 @@ handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypte
    symkey <- atomically $ transportSymmetric crypto
    now <- getPOSIXTime
    dput XNetCrypto ("Decrypt cookie with n24=" ++ show n24 ++ "\n    symkey= " ++ show symkey)
-    lr <- fmap join . sequence $ do -- Either Monad
+    lr <- fmap  toHandshakeParams <$> decryptHandshake crypto hshake
-            CookieData cookieTime remotePubkey remoteDhtkey <- decodePlain =<< decryptSymmetric symkey n24 ecookie
-            Right $ do -- IO Monad
-            decrypted <- anyRight "missing key" seckeys $ \key -> do
-                            dput XNetCrypto $ "(NetCrypto)handshakeH: remotePubkey =  " ++ show (key2id $ remotePubkey)
-                            dput XNetCrypto $ "(NetCrypto)handshakeH: nonce24 =  " ++ show nonce24
-                            secret <- lookupSharedSecret crypto key remotePubkey nonce24
-                            let step1 = decrypt secret encrypted
-                            case step1 of
-                                Left s -> do
-                                    dput XNetCrypto $ "(NetCrypto)handshakeH: (decrypt) " ++ s
-                                    return (Left s)
-                                Right pln -> do
-                                    case decodePlain pln of
-                                        Left s -> do
-                                            dput XNetCrypto $ "(NetCrypto)handshakeH: (decodePlain) " ++ s
-                                            return (Left s)
-                                        Right x -> return (Right (key,x))
-            return $ do -- Either Monad
-            (key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) <- decrypted
-            -- check cookie time < 15 seconds ago
-            guard (now - fromIntegral cookieTime < 15)
-            -- cookie hash is valid? sha512 of ecookie
-            let hinit = hashInit
-                hctx = hashUpdate hinit n24
-                hctx' = hashUpdate hctx ecookie
-                digest = hashFinalize hctx'
-            guard (cookieHash == digest)
-            -- known friend?
-            -- todo TODO, see Roster.hs,
-            -- talk to not yet existent Network-Manager to ascertain current permissions
-            return
-             HParam
-                { hpTheirBaseNonce        = Just baseNonce
-                , hpOtherCookie           = otherCookie
-                , hpTheirSessionKeyPublic = Just sessionKey
-                , hpMySecretKey           = key
-                , hpCookieRemotePubkey    = remotePubkey
-                , hpCookieRemoteDhtkey    = remoteDhtkey
-                }
    case lr of
        Left s -> dput XNetCrypto ("(NetCrypto)handshakeH: " ++ s)
        Right hp@(HParam

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 2a1461f2..307efb22 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -712,7 +712,7 @@ anyRight :: Monad m => a -> [t] -> (t -> m (Either b b1)) -> m (Either a b1)
712	anyRight e [] f = return $ Left e	712	anyRight e [] f = return $ Left e
713	anyRight e (x:xs) f = f x >>= either (const $ anyRight e xs f) (return . Right)	713	anyRight e (x:xs) f = f x >>= either (const $ anyRight e xs f) (return . Right)
714		714
715	decryptHandshake :: TransportCrypto -> Handshake Encrypted -> IO (Either String (Handshake Identity))	715	decryptHandshake :: TransportCrypto -> Handshake Encrypted -> IO (Either String (SecretKey,Handshake Identity))
716	decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do	716	decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
717	(ukeys,symkey) <- atomically $ (,) <$> userKeys crypto	717	(ukeys,symkey) <- atomically $ (,) <$> userKeys crypto
718	<*> transportSymmetric crypto	718	<*> transportSymmetric crypto
@@ -746,9 +746,22 @@ decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted
746	hctx' = hashUpdate hctx ecookie	746	hctx' = hashUpdate hctx ecookie
747	digest = hashFinalize hctx'	747	digest = hashFinalize hctx'
748	left (asTypeOf "cookie digest mismatch") $ guard (cookieHash == digest)	748	left (asTypeOf "cookie digest mismatch") $ guard (cookieHash == digest)
749	return hshake { handshakeCookie = Cookie n24 (pure cd)	749	return ( key
750	, handshakeData = pure hsdata	750	, hshake { handshakeCookie = Cookie n24 (pure cd)
751	}	751	, handshakeData = pure hsdata
		752	} )
		753
		754	toHandshakeParams (key,hs)
		755	= let hd = runIdentity $ handshakeData hs
		756	Cookie _ cd0 = handshakeCookie hs
		757	CookieData _ remotePublicKey remoteDhtPublicKey = runIdentity cd0
		758	in HParam { hpTheirBaseNonce = Just $ baseNonce hd
		759	, hpOtherCookie = otherCookie hd
		760	, hpTheirSessionKeyPublic = Just $ sessionKey hd
		761	, hpMySecretKey = key
		762	, hpCookieRemotePubkey = remotePublicKey
		763	, hpCookieRemoteDhtkey = remoteDhtPublicKey
		764	}
752		765
753	handshakeH :: NetCryptoSessions -> SockAddr -> Handshake Encrypted -> IO (Maybe a)	766	handshakeH :: NetCryptoSessions -> SockAddr -> Handshake Encrypted -> IO (Maybe a)
754	handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do	767	handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
@@ -762,46 +775,7 @@ handshakeH sessions addr hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypte
762	symkey <- atomically $ transportSymmetric crypto	775	symkey <- atomically $ transportSymmetric crypto
763	now <- getPOSIXTime	776	now <- getPOSIXTime
764	dput XNetCrypto ("Decrypt cookie with n24=" ++ show n24 ++ "\n symkey= " ++ show symkey)	777	dput XNetCrypto ("Decrypt cookie with n24=" ++ show n24 ++ "\n symkey= " ++ show symkey)
765	lr <- fmap join . sequence $ do -- Either Monad	778	lr <- fmap toHandshakeParams <$> decryptHandshake crypto hshake
766	CookieData cookieTime remotePubkey remoteDhtkey <- decodePlain =<< decryptSymmetric symkey n24 ecookie
767	Right $ do -- IO Monad
768	decrypted <- anyRight "missing key" seckeys $ \key -> do
769	dput XNetCrypto $ "(NetCrypto)handshakeH: remotePubkey = " ++ show (key2id $ remotePubkey)
770	dput XNetCrypto $ "(NetCrypto)handshakeH: nonce24 = " ++ show nonce24
771	secret <- lookupSharedSecret crypto key remotePubkey nonce24
772	let step1 = decrypt secret encrypted
773	case step1 of
774	Left s -> do
775	dput XNetCrypto $ "(NetCrypto)handshakeH: (decrypt) " ++ s
776	return (Left s)
777	Right pln -> do
778	case decodePlain pln of
779	Left s -> do
780	dput XNetCrypto $ "(NetCrypto)handshakeH: (decodePlain) " ++ s
781	return (Left s)
782	Right x -> return (Right (key,x))
783	return $ do -- Either Monad
784	(key,HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) <- decrypted
785	-- check cookie time < 15 seconds ago
786	guard (now - fromIntegral cookieTime < 15)
787	-- cookie hash is valid? sha512 of ecookie
788	let hinit = hashInit
789	hctx = hashUpdate hinit n24
790	hctx' = hashUpdate hctx ecookie
791	digest = hashFinalize hctx'
792	guard (cookieHash == digest)
793	-- known friend?
794	-- todo TODO, see Roster.hs,
795	-- talk to not yet existent Network-Manager to ascertain current permissions
796	return
797	HParam
798	{ hpTheirBaseNonce = Just baseNonce
799	, hpOtherCookie = otherCookie
800	, hpTheirSessionKeyPublic = Just sessionKey
801	, hpMySecretKey = key
802	, hpCookieRemotePubkey = remotePubkey
803	, hpCookieRemoteDhtkey = remoteDhtkey
804	}
805	case lr of	779	case lr of
806	Left s -> dput XNetCrypto ("(NetCrypto)handshakeH: " ++ s)	780	Left s -> dput XNetCrypto ("(NetCrypto)handshakeH: " ++ s)
807	Right hp@(HParam	781	Right hp@(HParam