TCP Relay: use same crypto keys as Tox UDP node.

1 files changed, 18 insertions, 7 deletions

diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs
index 13da804f..ca4ca817 100644
--- a/dht/src/Network/Tox/TCP.hs
+++ b/dht/src/Network/Tox/TCP.hs
@@ -48,7 +48,8 @@ import Network.Tox.DHT.Handlers (toxSpace)
 import Network.Tox.Onion.Transport hiding (encrypt,decrypt)
 import Network.Tox.Onion.Handlers (unwrapAnnounceResponse)
 import qualified Network.Tox.NodeId as UDP
-
+import Text.XXD
+import Data.Proxy
 
 withSize :: Sized x => (Size x -> m (p x)) -> m (p x)
 withSize f = case size of len -> f len
@@ -89,14 +90,23 @@ tcpStream crypto = StreamHandshake
         noncef <- lookupNonceFunction crypto (transportSecret crypto) (UDP.id2key $ nodeId addr)
         dput XTCP $ "TCP:" ++ show addr ++ " <-- " ++ show hello
         hPut h $ encode $ encryptPayload (noncef $ helloNonce hello) hello
-        welcomeE <- withSize $ fmap decode . hGet h . constSize
+        (welcomeE, wbs) <- do
+            let sz0 = size
+                sz = constSize sz0
+            bs <- hGet h sz
+            return ( fmap (`asProxyTypeOf` sz0) $ decode bs, bs )
         let mwelcome = welcomeE >>= \w -> decryptPayload (noncef $ welcomeNonce w) w
             nil = SessionProtocol
                 { streamGoodbye = return ()
                 , streamDecode = return Nothing
                 , streamEncode = \y -> dput XTCP $ "TCP nil <-- " ++ show y
                 }
-        either (\_ -> return nil) id $ mwelcome <&> \welcome -> do
+        either (\e -> do
+                        dput XTCP $ "welcome: " ++ show (Data.ByteString.length wbs) ++ " bytes."
+                        forM_ (xxd2 0 wbs) $ dput XTCP
+                        dput XTCP $ "TCP(fail welcome): " ++ e
+                        return nil
+                ) id $ mwelcome <&> \welcome -> do
         dput XTCP $ "TCP:" ++ show addr ++ " --> " ++ show welcome
         noncef' <- lookupNonceFunction crypto skey (sessionPublicKey $ runIdentity $ welcomeData welcome)
         nsend <- newMVar (sessionBaseNonce $ runIdentity $ helloData hello)
@@ -118,6 +128,7 @@ tcpStream crypto = StreamHandshake
                                     dput XTCP $ "TCP: Failed to decode packet."
                                     return Nothing
                                 Right x -> do
+                                    dput XTCP $ "TCP:"++ show addr ++ " --> packet!"
                                     m24 <- timeout 1000000 (takeMVar nread)
                                     fmap join $ forM m24 $ \n24 -> do
                                         let r = decrypt (noncef' n24) x >>= decodePlain
@@ -133,16 +144,16 @@ tcpStream crypto = StreamHandshake
                                         dput XTCP $ "TCP exception: " ++ show e
                                         return Nothing
             , streamEncode = \y -> do
-                dput XTCP $ "TCP(acquire nonce):" ++ show addr ++ " <-- " ++ show y
+                -- dput XTCP $ "TCP(acquire nonce):" ++ show addr ++ " <-- " ++ show y
                 n24 <- takeMVar nsend
-                dput XTCP $ "TCP(got nonce):" ++ show addr ++ " <-- " ++ show y
+                -- dput XTCP $ "TCP(got nonce):" ++ show addr ++ " <-- " ++ show y
                 let bs = encode $ encrypt (noncef' n24) $ encodePlain y
                 ($ h) -- bracket (takeMVar hvar) (putMVar hvar)
                     $ \h -> hPut h (encode (fromIntegral $ Data.ByteString.length bs :: Word16) <> bs)
                                 `catchIOError` \e -> dput XTCP $ "TCP write exception: " ++ show e
-                dput XTCP $ "TCP(incrementing nonce): " ++ show addr ++ " <-- " ++ show y
+                -- dput XTCP $ "TCP(incrementing nonce): " ++ show addr ++ " <-- " ++ show y
                 putMVar nsend (incrementNonce24 n24)
-                dput XTCP $ "TCP(finished): " ++ show addr ++ " <-- " ++ show y
+                dput XTCP $ "TCP: " ++ show addr ++ " <-- " ++ show y
             }
     , streamAddr = nodeAddr
     }