exponential backoff on netCrypto and more debug prints

1 files changed, 15 insertions, 3 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 149905d2..0aeb8557 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -251,7 +251,10 @@ data Tox = Tox
 
 -- | initiate a netcrypto session, blocking
 netCrypto :: Tox -> SecretKey -> PublicKey{-UserKey -} -> IO [NetCryptoSession]
-netCrypto tox myseckey theirpubkey = do
+netCrypto tox myseckey theirpubkey = netCryptoWithBackoff 1000000 tox myseckey theirpubkey
+
+-- | helper for 'netCrypto', initiate a netcrypto session, retry after specified millisecs
+netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
     let mykeyAsId = key2id (toPublic myseckey)
     mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox)))
     case mbContactsVar of
@@ -308,6 +311,7 @@ netCrypto tox myseckey theirpubkey = do
                         hPutStrLn stderr ("netCrypto: CookieRequest failed. TODO: dhtpkNodes thingy")
                         return []
                       Just cookie -> do
+                        hPutStrLn stderr "Have cookie, creating handshake packet..."
                         let hp = HParam { hpOtherCookie = cookie
                                         , hpMySecretKey = myseckey
                                         , hpCookieRemotePubkey = theirpubkey
@@ -330,8 +334,16 @@ netCrypto tox myseckey theirpubkey = do
                             Nothing -> hPutStrLn stderr "netCrypto: failed to create HandshakeData." >> return []
                             Just handshake -> do
                                 sendMessage (toxCrypto tox) saddr (NetHandshake handshake)
-                                threadDelay 1000000 -- delay 1 second
-                                netCrypto tox myseckey theirpubkey -- hopefully it will find an active session this time.
+                                let secnum :: Double
+                                    secnum = fromIntegral millisecs / 1000000
+                                if secnum < 20000000
+                                  then do
+                                    hPutStrLn stderr $ "sent handshake, now delaying " ++ show (secnum * 1.5) ++ "  second.."
+                                    threadDelay (millisecs * 3 `div` 2)
+                                    netCrypto tox myseckey theirpubkey -- hopefully it will find an active session this time.
+                                  else do
+                                    hPutStrLn stderr "Unable to establish session..."
+                                    return []
 
 getContactInfo :: Tox -> IO DHT.DHTPublicKey
 getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do