Adjusted relay-related debug prints.

1 files changed, 31 insertions, 25 deletions

diff --git a/dht/src/Network/Tox/Relay.hs b/dht/src/Network/Tox/Relay.hs
index 22a692a9..dd150917 100644
--- a/dht/src/Network/Tox/Relay.hs
+++ b/dht/src/Network/Tox/Relay.hs
@@ -85,7 +85,7 @@ relaySession crypto clients cons sendOnion _ conid h = do
 
     -- mhello <- fmap (>>= \h -> decryptPayload (computeSharedSecret me (helloFrom h) (helloNonce h)) h) $ hGetSized h
 
-    dput XOnion $ "Relay client session conid=" ++ show conid
+    dput XRelay $ "Relay client session conid=" ++ show conid
     (hGetSized h >>=) $ mapM_ $ \helloE -> do
 
     let me = transportSecret crypto
@@ -93,23 +93,23 @@ relaySession crypto clients cons sendOnion _ conid h = do
 
     noncef <- lookupNonceFunction crypto me them
     let mhello = decryptPayload (noncef $ helloNonce helloE) helloE
-    dput XOnion $ "Relay client (conid=" ++ show conid ++ ") decrypted hello = " ++ show mhello
     forM_ mhello $ \hello -> do
         let _ = hello :: Hello Identity
 
-        dput XOnion $ "Relay client sent hello. conid=" ++ show conid
+        -- dput XRelay $ "Relay client sent hello. conid=" ++ show conid
         (me',welcome) <- atomically $ do
             skey <- transportNewKey crypto
             dta <- HelloData (toPublic skey) <$> transportNewNonce crypto
             w24 <- transportNewNonce crypto
             return (skey, Welcome w24 $ pure dta)
 
-        dput XOnion $ unlines [ "Relay client to receive welcome. conid=" ++ show conid
+        {-
+        dput XRelay $ unlines [ "Relay to send welcome to client. conid=" ++ show conid
                               , show welcome
                               ]
+        -}
         B.hPut h $ encode $ encryptPayload (noncef $ welcomeNonce welcome) welcome
-
-        dput XOnion $ "Relay client welcome sent. conid=" ++ show conid
+        dput XRelay $ "Relay welcomes (conid=" ++ show conid ++ ") " ++ showKey256 them
 
         noncef' <- let them' = sessionPublicKey (runIdentity $ helloData hello)
                    in lookupNonceFunction crypto me' them'
@@ -158,18 +158,18 @@ relaySession crypto clients cons sendOnion _ conid h = do
          `finally` do
             atomically $ modifyTVar' clients $ IntMap.delete conid
             disconnect cons (helloFrom hello)
-            dput XOnion $ "Relay client session closed. conid=" ++ show conid
+            dput XRelay $ "Relay client session closed. conid=" ++ show conid
 
-handlePacket :: TVar (Map PublicKey (RelayPacket -> IO (), TVar RelaySession))
-                      -> Int
-                      -> PublicKey
+handlePacket :: TVar (Map PublicKey (RelayPacket -> IO (), TVar RelaySession)) -- ^ All sessions.
+                      -> Int -- ^ TCP client number.
+                      -> PublicKey -- ^ Public key of client.
                       -> TransportCrypto
-                      -> (SockAddr -> OnionRequest N1 -> IO ())
-                      -> (RelayPacket -> IO ())
-                      -> TVar RelaySession
+                      -> (SockAddr -> OnionRequest N1 -> IO ()) -- ^ Forward onion packet.
+                      -> (RelayPacket -> IO ()) -- ^ Send to this client.
+                      -> TVar RelaySession -- ^ Session for this client.
                       -> RelayPacket
                       -> IO ()
-handlePacket cons thistcp me crypto sendOnion sendToMe session = \case
+handlePacket cons thistcp thisKey crypto sendOnion sendToClient session = \case
     RoutingRequest them -> join $ atomically $ do
         mySession <- readTVar session
         mi <- case Map.lookup them (solicited mySession) of
@@ -187,28 +187,33 @@ handlePacket cons thistcp me crypto sendOnion sendToMe session = \case
             mp <- Map.lookup them <$> readTVar cons
             forM mp $ \(sendToThem,peer) -> do
                 theirSession <- readTVar peer
-                forM (Map.lookup me $ solicited theirSession) $ \reserved_id -> do
-                    let sendToThem' f = sendToThem $ f $ key2c reserved_id
-                        sendToMe'   f = sendToMe   $ f $ key2c i
+                forM (Map.lookup thisKey $ solicited theirSession) $ \reserved_id -> do
+                    let sendToThem'   f = sendToThem $ f $ key2c reserved_id
+                        sendToClient' f = sendToClient $ f $ key2c i
                     writeTVar peer theirSession
-                        { solicited  = Map.delete me (solicited theirSession)
-                        , associated = IntMap.insert reserved_id sendToMe' (associated theirSession)
+                        { solicited  = Map.delete thisKey (solicited theirSession)
+                        , associated = IntMap.insert reserved_id sendToClient' (associated theirSession)
                         }
                     writeTVar session mySession
                         { solicited  = Map.delete them (solicited mySession)
                         , associated = IntMap.insert i sendToThem' (associated mySession)
                         }
-                    return $ do sendToThem' ConnectNotification
-                                sendToMe'   ConnectNotification
-        return $ do sendToMe $ RoutingResponse (maybe badcon key2c mi) them
+                    return $ do
+                        let showSession n k = "("++ show (key2c n) ++ ")" ++ showKey256 k
+                        dput XRelay $
+                            "Relay session " ++ showSession reserved_id thisKey
+                                 ++ " <--> " ++ showSession i them
+                        sendToThem' ConnectNotification
+                        sendToClient' ConnectNotification
+        return $ do sendToClient $ RoutingResponse (maybe badcon key2c mi) them
                     sequence_ notifyConnect
 
-    RelayPing x -> sendToMe $ RelayPong x -- TODO x==0 is invalid.  Do we care?
+    RelayPing x -> sendToClient $ RelayPong x -- TODO x==0 is invalid.  Do we care?
 
     OOBSend them bs -> do
         dput XRelay $ "OOB send to " ++ showKey256 them
         m <- atomically $ Map.lookup them <$> readTVar cons
-        forM_ m $ \(sendToThem,_) -> sendToThem $ OOBRecv me bs
+        forM_ m $ \(sendToThem,_) -> sendToThem $ OOBRecv thisKey bs
 
     RelayData bs con -> do
         mySession <- atomically $ readTVar session
@@ -220,7 +225,8 @@ handlePacket cons thistcp me crypto sendOnion sendToMe session = \case
                 i <- c2key con
                 sendToThem' <- IntMap.lookup i $ associated mySession
                 return $ sendToThem' $ RelayData bs
-        dput XRelay $ "RelayData to con " ++ show con ++ maybe "to no key" (\io -> "to an associatied key") mbSendIt
+        dput XRelay $ "RelayData from " ++ showKey256 thisKey ++ " to conid="
+                      ++ show con ++ maybe " (no key)" (\io -> " (associated key)") mbSendIt
         sequence_ mbSendIt
 
     OnionPacket n24 (Addressed addr req) -> do