summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Crypto/Tox.hs8
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs11
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
348nonce24ToWord16 :: Nonce24 -> Word16 348nonce24ToWord16 :: Nonce24 -> Word16
349nonce24ToWord16 (Nonce24 n24) = fromIntegral (B.index n24 23) + 256 * fromIntegral (B.index n24 22) 349nonce24ToWord16 (Nonce24 n24) = fromIntegral (B.index n24 23) + 256 * fromIntegral (B.index n24 22)
350 350
351addtoNonce24 :: Nonce24 -> Word -> IO Nonce24 351addtoNonce24 :: Nonce24 -> Word -> Nonce24
352addtoNonce24 (Nonce24 n24) n = Nonce24 <$> BA.copy n24 init 352addtoNonce24 (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 #-} 393incrementNonce24 :: Nonce24 -> Nonce24
394incrementNonce24 :: Nonce24 -> IO Nonce24
395incrementNonce24 nonce24 = addtoNonce24 nonce24 1 394incrementNonce24 nonce24 = addtoNonce24 nonce24 1
395{-# INLINE incrementNonce24 #-}
396 396
397quoted :: ShowS -> ShowS 397quoted :: ShowS -> ShowS
398quoted shows s = '"':shows ('"':s) 398quoted 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
24import Data.Serialize as S 24import Data.Serialize as S
25import Data.Word 25import Data.Word
26import qualified Data.Word64Map as W64 26import qualified Data.Word64Map as W64
27import GHC.Conc (unsafeIOToSTM)
28import qualified Data.Set as Set 27import qualified Data.Set as Set
29import qualified Data.Array.Unboxed as A 28import qualified Data.Array.Unboxed as A
30import SensibleDir 29import SensibleDir
@@ -36,7 +35,6 @@ import System.Directory
36import System.Random -- for ping fuzz 35import System.Random -- for ping fuzz
37import Control.Concurrent 36import Control.Concurrent
38import GHC.Conc (labelThread) 37import GHC.Conc (labelThread)
39import System.IO.Unsafe(unsafeDupablePerformIO {- unsafeIOToSTM -})
40import PingMachine 38import 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