summaryrefslogtreecommitdiff
path: root/src/Network/Tox.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox.hs')
-rw-r--r--src/Network/Tox.hs54
1 files changed, 28 insertions, 26 deletions
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 018361aa..9d785f67 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -258,6 +258,7 @@ netCrypto tox myseckey theirpubkey = netCryptoWithBackoff 1000000 tox myseckey t
258netCryptoWithBackoff :: Int -> Tox -> SecretKey -> PublicKey -> IO [NetCryptoSession] 258netCryptoWithBackoff :: Int -> Tox -> SecretKey -> PublicKey -> IO [NetCryptoSession]
259netCryptoWithBackoff millisecs tox myseckey theirpubkey = do 259netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
260 let mykeyAsId = key2id (toPublic myseckey) 260 let mykeyAsId = key2id (toPublic myseckey)
261 -- TODO: check status of connection here:
261 mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox))) 262 mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox)))
262 case mbContactsVar of 263 case mbContactsVar of
263 Nothing -> do 264 Nothing -> do
@@ -321,32 +322,33 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
321 , hpTheirBaseNonce = error "netCrypto: Unreachable! hpTheirBaseNonce" 322 , hpTheirBaseNonce = error "netCrypto: Unreachable! hpTheirBaseNonce"
322 , hpTheirSessionKeyPublic = error "netCrypto: Unreachable! hpTheirSessionKeyPublic" 323 , hpTheirSessionKeyPublic = error "netCrypto: Unreachable! hpTheirSessionKeyPublic"
323 } 324 }
324 myhandshake <- do 325 freshCryptoSession (toxCryptoSessions tox) saddr hp
325 n24' <- atomically $ transportNewNonce crypto 326-- myhandshake <- do
326 dput XNetCrypto ("Handshake Nonce24: " <> show n24') 327-- n24' <- atomically $ transportNewNonce crypto
327 newBaseNonce <- atomically $ transportNewNonce crypto 328-- dput XNetCrypto ("Handshake Nonce24: " <> show n24')
328 mbMyhandshakeData <- newHandShakeData crypto newBaseNonce hp saddr 329-- newBaseNonce <- atomically $ transportNewNonce crypto
329 forM mbMyhandshakeData $ \hsdata -> do 330-- mbMyhandshakeData <- newHandShakeData crypto newBaseNonce hp saddr
330 state <- lookupSharedSecret crypto myseckey theirpubkey n24' 331-- forM mbMyhandshakeData $ \hsdata -> do
331 return Handshake { handshakeCookie = cookie 332-- state <- lookupSharedSecret crypto myseckey theirpubkey n24'
332 , handshakeNonce = n24' 333-- return Handshake { handshakeCookie = cookie
333 , handshakeData = encrypt state $ encodePlain hsdata 334-- , handshakeNonce = n24'
334 } 335-- , handshakeData = encrypt state $ encodePlain hsdata
335 case myhandshake of 336-- }
336 Nothing -> hPutStrLn stderr "netCrypto: failed to create HandshakeData." >> return [] 337-- case myhandshake of
337 Just handshake -> do 338-- Nothing -> hPutStrLn stderr "netCrypto: failed to create HandshakeData." >> return []
338 sendMessage (toxCrypto tox) saddr (NetHandshake handshake) 339-- Just handshake -> do
339 let secnum :: Double 340-- sendMessage (toxCrypto tox) saddr (NetHandshake handshake)
340 secnum = fromIntegral millisecs / 1000000 341 let secnum :: Double
341 delay = (millisecs * 5 `div` 4) 342 secnum = fromIntegral millisecs / 1000000
342 if secnum < 20000000 343 delay = (millisecs * 5 `div` 4)
343 then do 344 if secnum < 20000000
344 hPutStrLn stderr $ "sent handshake, now delaying " ++ show (secnum * 1.25) ++ " second(s).." 345 then do
345 threadDelay delay 346 hPutStrLn stderr $ "sent handshake, now delaying " ++ show (secnum * 1.25) ++ " second(s).."
346 netCryptoWithBackoff delay tox myseckey theirpubkey -- hopefully it will find an active session this time. 347 threadDelay delay
347 else do 348 netCryptoWithBackoff delay tox myseckey theirpubkey -- hopefully it will find an active session this time.
348 hPutStrLn stderr "Unable to establish session..." 349 else do
349 return [] 350 hPutStrLn stderr "Unable to establish session..."
351 return []
350 352
351getContactInfo :: Tox -> IO DHT.DHTPublicKey 353getContactInfo :: Tox -> IO DHT.DHTPublicKey
352getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do 354getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do