addtoNonce24: unsafeDupablePerformIO at def, not call sites.

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
 nonce24ToWord16 :: Nonce24 -> Word16
 nonce24ToWord16 (Nonce24 n24) = fromIntegral (B.index n24 23) + 256 * fromIntegral (B.index n24 22)
 
-addtoNonce24 :: Nonce24 -> Word -> IO Nonce24
-addtoNonce24 (Nonce24 n24) n = Nonce24 <$> BA.copy n24 init
+addtoNonce24 :: Nonce24 -> Word -> Nonce24
+addtoNonce24 (Nonce24 n24) n = unsafeDupablePerformIO $ Nonce24 <$> BA.copy n24 init
     where
         init :: Ptr Word -> IO ()
         init ptr | fitsInInt (Proxy :: Proxy Word64) = do
@@ -390,9 +390,9 @@ addtoNonce24 (Nonce24 n24) n = Nonce24 <$> BA.copy n24 init
             pokeElemOff ptr 5 $ tBE32 (W# sum_)
         init _ = error "incrementNonce24: I only support 64 and 32 bits"
 
-{-# INLINE incrementNonce24 #-}
-incrementNonce24 :: Nonce24 -> IO Nonce24
+incrementNonce24 :: Nonce24 -> Nonce24
 incrementNonce24 nonce24 = addtoNonce24 nonce24 1
+{-# INLINE incrementNonce24 #-}
 
 quoted :: ShowS -> ShowS
 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
 import Data.Serialize             as S
 import Data.Word
 import qualified Data.Word64Map as W64
-import GHC.Conc (unsafeIOToSTM)
 import qualified Data.Set         as Set
 import qualified Data.Array.Unboxed as A
 import SensibleDir
@@ -36,7 +35,6 @@ import System.Directory
 import System.Random -- for ping fuzz
 import Control.Concurrent
 import GHC.Conc (labelThread)
-import System.IO.Unsafe(unsafeDupablePerformIO {- unsafeIOToSTM -})
 import PingMachine
 
 -- util, todo: move to another module
@@ -341,7 +339,7 @@ freshCryptoSession  sessions
             f <- lookupNonceFunction crypto newsession theirSessionKey
             atomically $ do
                 n24 <- readTVar ncMyPacketNonce0
-                let n24plus1 = unsafeDupablePerformIO (incrementNonce24 n24)
+                let n24plus1 = incrementNonce24 n24
                 writeTVar ncMyPacketNonce0 n24plus1
                 return (return (f n24, n24, ncOutgoingIdMap0))
     pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0
@@ -488,8 +486,8 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
             theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce
             -- Try to decrypt message
             let diff :: Word16
-                diff = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16
-            tempNonce <- addtoNonce24 theirBaseNonce (fromIntegral diff) -- expanding to Word
+                diff      = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16
+                tempNonce = addtoNonce24 theirBaseNonce (fromIntegral diff)    -- expanding to Word
             lr <- fmap join $ sequence $ do -- Either Monad --
                         pubkey <- maybeToEither ncTheirSessionPublic
                         Right $ do -- IO Monad
@@ -508,8 +506,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
                     when (diff > 2 * dATA_NUM_THRESHOLD)$
                         atomically $ do
                             y <- readTVar ncTheirBaseNonce
-                            -- all because Storable forces IO...
-                            x <- unsafeIOToSTM $ addtoNonce24 y (fromIntegral dATA_NUM_THRESHOLD)
+                            let x = addtoNonce24 y (fromIntegral dATA_NUM_THRESHOLD)
                             writeTVar ncTheirBaseNonce y
                     -- then set session confirmed,
                     atomically $ writeTVar ncState Confirmed