diff options
Diffstat (limited to 'src/Network/Tox.hs')
-rw-r--r-- | src/Network/Tox.hs | 54 |
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 | |||
258 | netCryptoWithBackoff :: Int -> Tox -> SecretKey -> PublicKey -> IO [NetCryptoSession] | 258 | netCryptoWithBackoff :: Int -> Tox -> SecretKey -> PublicKey -> IO [NetCryptoSession] |
259 | netCryptoWithBackoff millisecs tox myseckey theirpubkey = do | 259 | netCryptoWithBackoff 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 | ||
351 | getContactInfo :: Tox -> IO DHT.DHTPublicKey | 353 | getContactInfo :: Tox -> IO DHT.DHTPublicKey |
352 | getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do | 354 | getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do |