From c3d1cdb4cf73b584708293d3440ff76fe57f7bb1 Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 2 Jun 2018 05:55:41 -0400
Subject: tox refactor: handshakeH uses decryptHandshake.

---
 src/Network/Tox/Crypto/Handlers.hs | 62 +++++++++++---------------------------
 1 file 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)
-                          , handshakeData   = pure hsdata
-                          }
+            return ( key
+                   , 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
-            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
-                }
+    lr <- fmap  toHandshakeParams <$> decryptHandshake crypto hshake
     case lr of
         Left s -> dput XNetCrypto ("(NetCrypto)handshakeH: " ++ s)
         Right hp@(HParam
-- 
cgit v1.2.3