summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network/Tox.hs18
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
251 251
252-- | initiate a netcrypto session, blocking 252-- | initiate a netcrypto session, blocking
253netCrypto :: Tox -> SecretKey -> PublicKey{-UserKey -} -> IO [NetCryptoSession] 253netCrypto :: Tox -> SecretKey -> PublicKey{-UserKey -} -> IO [NetCryptoSession]
254netCrypto tox myseckey theirpubkey = do 254netCrypto tox myseckey theirpubkey = netCryptoWithBackoff 1000000 tox myseckey theirpubkey
255
256-- | helper for 'netCrypto', initiate a netcrypto session, retry after specified millisecs
257netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
255 let mykeyAsId = key2id (toPublic myseckey) 258 let mykeyAsId = key2id (toPublic myseckey)
256 mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox))) 259 mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox)))
257 case mbContactsVar of 260 case mbContactsVar of
@@ -308,6 +311,7 @@ netCrypto tox myseckey theirpubkey = do
308 hPutStrLn stderr ("netCrypto: CookieRequest failed. TODO: dhtpkNodes thingy") 311 hPutStrLn stderr ("netCrypto: CookieRequest failed. TODO: dhtpkNodes thingy")
309 return [] 312 return []
310 Just cookie -> do 313 Just cookie -> do
314 hPutStrLn stderr "Have cookie, creating handshake packet..."
311 let hp = HParam { hpOtherCookie = cookie 315 let hp = HParam { hpOtherCookie = cookie
312 , hpMySecretKey = myseckey 316 , hpMySecretKey = myseckey
313 , hpCookieRemotePubkey = theirpubkey 317 , hpCookieRemotePubkey = theirpubkey
@@ -330,8 +334,16 @@ netCrypto tox myseckey theirpubkey = do
330 Nothing -> hPutStrLn stderr "netCrypto: failed to create HandshakeData." >> return [] 334 Nothing -> hPutStrLn stderr "netCrypto: failed to create HandshakeData." >> return []
331 Just handshake -> do 335 Just handshake -> do
332 sendMessage (toxCrypto tox) saddr (NetHandshake handshake) 336 sendMessage (toxCrypto tox) saddr (NetHandshake handshake)
333 threadDelay 1000000 -- delay 1 second 337 let secnum :: Double
334 netCrypto tox myseckey theirpubkey -- hopefully it will find an active session this time. 338 secnum = fromIntegral millisecs / 1000000
339 if secnum < 20000000
340 then do
341 hPutStrLn stderr $ "sent handshake, now delaying " ++ show (secnum * 1.5) ++ " second.."
342 threadDelay (millisecs * 3 `div` 2)
343 netCrypto tox myseckey theirpubkey -- hopefully it will find an active session this time.
344 else do
345 hPutStrLn stderr "Unable to establish session..."
346 return []
335 347
336getContactInfo :: Tox -> IO DHT.DHTPublicKey 348getContactInfo :: Tox -> IO DHT.DHTPublicKey
337getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do 349getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do