1 files changed, 15 insertions, 9 deletions

diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs
index 36200586..adb42514 100644
--- a/src/Network/Tox/TCP.hs
+++ b/src/Network/Tox/TCP.hs
@@ -132,18 +132,22 @@ tcpStream crypto = StreamHandshake
                                         dput XTCP $ "TCP exception: " ++ show e
                                         return Nothing
             , streamEncode = \y -> do
+                dput XTCP $ "TCP(acquire nonce):" ++ show addr ++ " <-- " ++ show y
                 n24 <- takeMVar nsend
-                dput XTCP $ "TCP:" ++ 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
                 putMVar nsend (incrementNonce24 n24)
+                dput XTCP $ "TCP(finished): " ++ show addr ++ " <-- " ++ show y
             }
     , streamAddr = nodeAddr
     }
 
-toxTCP :: TransportCrypto -> IO (TransportA err NodeInfo RelayPacket (Bool,RelayPacket))
+toxTCP :: TransportCrypto -> IO ( TCPCache (SessionProtocol RelayPacket RelayPacket)
+                                , TransportA err NodeInfo RelayPacket (Bool,RelayPacket) )
 toxTCP crypto = tcpTransport 30 (tcpStream crypto)
 
 tcpSpace :: KademliaSpace NodeId NodeInfo
@@ -267,13 +271,14 @@ type RelayClient = Client String PacketNumber Nonce8 NodeInfo (Bool,RelayPacket)
 newClient :: TransportCrypto
                -> (MVar (Bool,RelayPacket) -> a) -- ^ store mvar for query
                -> (a -> RelayPacket -> IO void)  -- ^ load mvar for query
-               -> IO ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a)
+               -> IO ( ( TVar (ChaChaDRG, Data.Word64Map.Word64Map a)
+                       , TCPCache (SessionProtocol RelayPacket RelayPacket) )
                      , Client String PacketNumber Nonce8 NodeInfo (Bool,RelayPacket))
 newClient crypto store load = do
-    net <- toxTCP crypto
+    (tcpcache,net) <- toxTCP crypto
     drg <- drgNew
     map_var <- atomically $ newTVar (drg, Data.Word64Map.empty)
-    return $ (,) map_var Client
+    return $ (,) (map_var,tcpcache) Client
         { clientNet = {- XXX: Client type forces this pointless layering. -} layerTransport ((Right .) . (,) . (,) False) (,) net
         , clientDispatcher = DispatchMethods
             { classifyInbound = (. snd) $ \case
@@ -284,10 +289,11 @@ newClient crypto store load = do
                 OOBRecv k bs          -> IsUnsolicited $ handleOOB k bs
                 wut                   -> IsUnknown (show wut)
             , lookupHandler   = \case
-                PingPacket -> Just MethodHandler
-                    { methodParse     = \(_,RelayPing n8) -> Right ()
-                    , methodSerialize = \n8 src dst () -> (False, RelayPong n8)
-                    , methodAction    = \src () -> return ()
+                PingPacket -> trace ("tcp-received-ping") $ Just MethodHandler
+                    { methodParse     = \case (_,RelayPing n8) -> Right ()
+                                              _                -> trace ("tcp-non-ping") $ Left "TCP: Non-ping?"
+                    , methodSerialize = \n8 src dst () -> trace ("tcp-made-pong-"++show n8) (False, RelayPong n8)
+                    , methodAction    = \src () -> dput XTCP $ "TCP pinged by "++show src
                     }
                 w -> trace ("tcp-lookupHandler: "++show w) $ Just NoReply
                             { methodParse = \x -> Left "tcp-lookuphandler?" -- :: x -> Either err a