Factored Network.Tox.Handshake out of *.Crypto.Handlers.

1 files changed, 5 insertions, 98 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 58b2b09a..c5c17e4e 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -58,6 +58,7 @@ import Text.Printf
 import Data.Bool
 import Connection (Status(..), Policy(..))
 import Network.Tox.ContactInfo
+import Network.Tox.Handshake
 
 -- | This type indicates the progress of a tox encrypted friend link
 -- connection.  Two scenarios are illustrated below.  The parenthesis show the
@@ -465,37 +466,6 @@ newSessionsState crypto unrechook hooks = do
                       , listenerIDSupply = lsupplyVar
                       }
 
-data HandshakeParams
-        = HParam
-            { hpTheirBaseNonce        :: Maybe Nonce24 -- ignore and generate your own
-            , hpOtherCookie           :: Cookie Encrypted
-            , hpTheirSessionKeyPublic :: Maybe PublicKey
-            , hpMySecretKey           :: SecretKey
-            , hpCookieRemotePubkey    :: PublicKey
-            , hpCookieRemoteDhtkey    :: PublicKey
-            }
-
-newHandShakeData :: POSIXTime -> TransportCrypto -> Nonce24 -> HandshakeParams -> SockAddr -> PublicKey -> STM (Maybe HandshakeData)
-newHandShakeData timestamp crypto basenonce (HParam {hpOtherCookie,hpMySecretKey,hpCookieRemotePubkey,hpCookieRemoteDhtkey}) addr mySessionPublic
-    = do
-    freshCookie
-      <- case  nodeInfo (key2id hpCookieRemoteDhtkey) addr  of
-            Right nodeinfo -> Just <$> createCookieSTM timestamp crypto nodeinfo hpCookieRemotePubkey
-            Left er        -> return Nothing
-    let hinit                = hashInit
-        Cookie n24 encrypted = hpOtherCookie
-        hctx                 = hashUpdate hinit n24
-        hctx'                = hashUpdate hctx encrypted
-        digest               = hashFinalize hctx'
-    return $
-      fmap (\freshCookie' ->
-            HandshakeData
-                { baseNonce   = basenonce
-                , sessionKey  = mySessionPublic
-                , cookieHash  = digest
-                , otherCookie = freshCookie'
-                }) freshCookie
-
 type XMessage = CryptoMessage -- todo
 
 -- THIS Would work if not for the IO shared secret cache...
@@ -588,18 +558,11 @@ freshCryptoSession  sessions
                                         then InProgress AwaitingSessionPacket
                                         else InProgress AwaitingHandshake)
     ncTheirBaseNonce0 <- newTVar (frmMaybe mbtheirBaseNonce)
-    n24 <- transportNewNonce crypto
-    state <- ($ n24) <$> lookupNonceFunctionSTM timestamp crypto key remotePublicKey
     newBaseNonce <- transportNewNonce crypto
-    mbMyhandshakeData <- newHandShakeData timestamp crypto newBaseNonce hp addr (toPublic newsession)
-    let encodeHandshake myhandshakeData = let plain = encodePlain myhandshakeData
-    --                                        state = computeSharedSecret key remoteDhtPublicKey n24
-                                              encrypted = encrypt state plain
-                                              in Handshake { handshakeCookie = otherCookie
-                                                           , handshakeNonce = n24
-                                                           , handshakeData = encrypted
-                                                           }
-    let myhandshake= encodeHandshake <$> mbMyhandshakeData
+    mbMyhandshakeData <- case  nodeInfo (key2id $ hpCookieRemoteDhtkey hp) addr of
+            Right nodeinfo -> Just <$> newHandShakeData timestamp crypto newBaseNonce hp nodeinfo (toPublic newsession)
+            Left er        -> return Nothing -- Unable to send handshake to non-internet socket!
+    myhandshake <- mapM (encodeHandshake timestamp crypto key remotePublicKey otherCookie) mbMyhandshakeData
     ncHandShake0 <- newTVar (frmMaybe myhandshake)
     ncMyPacketNonce0 <- newTVar newBaseNonce
     cookie0 <- newTVar (HaveCookie otherCookie)
@@ -874,62 +837,6 @@ updateCryptoSession sessions addr newsession timestamp hp session handshake = do
                 writeTVar (ncState session) {-Accepted-}(InProgress AwaitingSessionPacket)
                 return (Nothing,return ())
 
-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 (SecretKey,Handshake Identity))
-decryptHandshake crypto hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
-    (ukeys,symkey) <- atomically $ (,) <$> userKeys crypto
-                                       <*> transportSymmetric crypto
-    let seckeys = map fst ukeys
-    dput XNetCrypto "decryptHandshake: trying the following keys:"
-    now <- getPOSIXTime
-    forM_ seckeys $ \k -> dput XNetCrypto $ "  " ++ show (key2id . toPublic $ k)
-    fmap join . sequence $ do -- Either Monad
-            cd@(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,hsdata@HandshakeData { baseNonce, sessionKey, cookieHash, otherCookie }) <- decrypted
-            left (asTypeOf "cookie too old") $ guard (now - fromIntegral cookieTime < 15)
-            let hinit = hashInit
-                hctx = hashUpdate hinit n24
-                hctx' = hashUpdate hctx ecookie
-                digest = hashFinalize hctx'
-            left (asTypeOf "cookie digest mismatch") $ guard (cookieHash == digest)
-            return ( key
-                   , hshake { handshakeCookie = Cookie n24 (pure cd)
-                            , handshakeData   = pure hsdata
-                            } )
-
-toHandshakeParams :: (SecretKey, Handshake Identity) -> HandshakeParams
-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 addrRaw hshake@(Handshake (Cookie n24 ecookie) nonce24 encrypted) = do
     let addr = either id id $ either4or6 addrRaw