diff options
-rw-r--r-- | src/Crypto/Tox.hs | 8 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 11 |
2 files changed, 8 insertions, 11 deletions
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs index 624da233..9a365daa 100644 --- a/src/Crypto/Tox.hs +++ b/src/Crypto/Tox.hs | |||
@@ -348,8 +348,8 @@ newtype Nonce24 = Nonce24 ByteString | |||
348 | nonce24ToWord16 :: Nonce24 -> Word16 | 348 | nonce24ToWord16 :: Nonce24 -> Word16 |
349 | nonce24ToWord16 (Nonce24 n24) = fromIntegral (B.index n24 23) + 256 * fromIntegral (B.index n24 22) | 349 | nonce24ToWord16 (Nonce24 n24) = fromIntegral (B.index n24 23) + 256 * fromIntegral (B.index n24 22) |
350 | 350 | ||
351 | addtoNonce24 :: Nonce24 -> Word -> IO Nonce24 | 351 | addtoNonce24 :: Nonce24 -> Word -> Nonce24 |
352 | addtoNonce24 (Nonce24 n24) n = Nonce24 <$> BA.copy n24 init | 352 | addtoNonce24 (Nonce24 n24) n = unsafeDupablePerformIO $ Nonce24 <$> BA.copy n24 init |
353 | where | 353 | where |
354 | init :: Ptr Word -> IO () | 354 | init :: Ptr Word -> IO () |
355 | init ptr | fitsInInt (Proxy :: Proxy Word64) = do | 355 | init ptr | fitsInInt (Proxy :: Proxy Word64) = do |
@@ -390,9 +390,9 @@ addtoNonce24 (Nonce24 n24) n = Nonce24 <$> BA.copy n24 init | |||
390 | pokeElemOff ptr 5 $ tBE32 (W# sum_) | 390 | pokeElemOff ptr 5 $ tBE32 (W# sum_) |
391 | init _ = error "incrementNonce24: I only support 64 and 32 bits" | 391 | init _ = error "incrementNonce24: I only support 64 and 32 bits" |
392 | 392 | ||
393 | {-# INLINE incrementNonce24 #-} | 393 | incrementNonce24 :: Nonce24 -> Nonce24 |
394 | incrementNonce24 :: Nonce24 -> IO Nonce24 | ||
395 | incrementNonce24 nonce24 = addtoNonce24 nonce24 1 | 394 | incrementNonce24 nonce24 = addtoNonce24 nonce24 1 |
395 | {-# INLINE incrementNonce24 #-} | ||
396 | 396 | ||
397 | quoted :: ShowS -> ShowS | 397 | quoted :: ShowS -> ShowS |
398 | quoted shows s = '"':shows ('"':s) | 398 | quoted shows s = '"':shows ('"':s) |
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 6e1623de..13ee0ed2 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs | |||
@@ -24,7 +24,6 @@ import qualified Data.PacketQueue as PQ | |||
24 | import Data.Serialize as S | 24 | import Data.Serialize as S |
25 | import Data.Word | 25 | import Data.Word |
26 | import qualified Data.Word64Map as W64 | 26 | import qualified Data.Word64Map as W64 |
27 | import GHC.Conc (unsafeIOToSTM) | ||
28 | import qualified Data.Set as Set | 27 | import qualified Data.Set as Set |
29 | import qualified Data.Array.Unboxed as A | 28 | import qualified Data.Array.Unboxed as A |
30 | import SensibleDir | 29 | import SensibleDir |
@@ -36,7 +35,6 @@ import System.Directory | |||
36 | import System.Random -- for ping fuzz | 35 | import System.Random -- for ping fuzz |
37 | import Control.Concurrent | 36 | import Control.Concurrent |
38 | import GHC.Conc (labelThread) | 37 | import GHC.Conc (labelThread) |
39 | import System.IO.Unsafe(unsafeDupablePerformIO {- unsafeIOToSTM -}) | ||
40 | import PingMachine | 38 | import PingMachine |
41 | 39 | ||
42 | -- util, todo: move to another module | 40 | -- util, todo: move to another module |
@@ -341,7 +339,7 @@ freshCryptoSession sessions | |||
341 | f <- lookupNonceFunction crypto newsession theirSessionKey | 339 | f <- lookupNonceFunction crypto newsession theirSessionKey |
342 | atomically $ do | 340 | atomically $ do |
343 | n24 <- readTVar ncMyPacketNonce0 | 341 | n24 <- readTVar ncMyPacketNonce0 |
344 | let n24plus1 = unsafeDupablePerformIO (incrementNonce24 n24) | 342 | let n24plus1 = incrementNonce24 n24 |
345 | writeTVar ncMyPacketNonce0 n24plus1 | 343 | writeTVar ncMyPacketNonce0 n24plus1 |
346 | return (return (f n24, n24, ncOutgoingIdMap0)) | 344 | return (return (f n24, n24, ncOutgoingIdMap0)) |
347 | pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0 | 345 | pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0 |
@@ -488,8 +486,8 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do | |||
488 | theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce | 486 | theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce |
489 | -- Try to decrypt message | 487 | -- Try to decrypt message |
490 | let diff :: Word16 | 488 | let diff :: Word16 |
491 | diff = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16 | 489 | diff = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16 |
492 | tempNonce <- addtoNonce24 theirBaseNonce (fromIntegral diff) -- expanding to Word | 490 | tempNonce = addtoNonce24 theirBaseNonce (fromIntegral diff) -- expanding to Word |
493 | lr <- fmap join $ sequence $ do -- Either Monad -- | 491 | lr <- fmap join $ sequence $ do -- Either Monad -- |
494 | pubkey <- maybeToEither ncTheirSessionPublic | 492 | pubkey <- maybeToEither ncTheirSessionPublic |
495 | Right $ do -- IO Monad | 493 | Right $ do -- IO Monad |
@@ -508,8 +506,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do | |||
508 | when (diff > 2 * dATA_NUM_THRESHOLD)$ | 506 | when (diff > 2 * dATA_NUM_THRESHOLD)$ |
509 | atomically $ do | 507 | atomically $ do |
510 | y <- readTVar ncTheirBaseNonce | 508 | y <- readTVar ncTheirBaseNonce |
511 | -- all because Storable forces IO... | 509 | let x = addtoNonce24 y (fromIntegral dATA_NUM_THRESHOLD) |
512 | x <- unsafeIOToSTM $ addtoNonce24 y (fromIntegral dATA_NUM_THRESHOLD) | ||
513 | writeTVar ncTheirBaseNonce y | 510 | writeTVar ncTheirBaseNonce y |
514 | -- then set session confirmed, | 511 | -- then set session confirmed, |
515 | atomically $ writeTVar ncState Confirmed | 512 | atomically $ writeTVar ncState Confirmed |