put DRG state to IORef, split STM transaction of sending notification (#1288)

* put DRG state to IORef, split STM transaction of sending notification

* remove comment

* remove comment

* add comment

* revert version

src/Simplex/FileTransfer/Agent.hs

@@ -145,7 +145,7 @@ xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks, redi
           relSavePathRedirect = relPrefixPath </> "xftp.redirect-decrypted"
       lift $ createDirectory =<< toFSFilePath relTmpPathRedirect
       lift $ createEmptyFile =<< toFSFilePath relSavePathRedirect
-      cfArgsRedirect <- atomically $ CF.randomArgs g
+      cfArgsRedirect <- liftIO $ CF.randomArgs g
       let saveFileRedirect = CryptoFile relSavePathRedirect $ Just cfArgsRedirect
       -- create download tasks
       withStore c $ \db -> createRcvFileRedirect db g userId fd relPrefixPath relTmpPathRedirect saveFileRedirect relTmpPath saveFile approvedRelays
@@ -355,8 +355,8 @@ xftpSendFile' c userId file numRecipients = do
   prefixPath <- lift $ getPrefixPath "snd.xftp"
   createDirectory prefixPath
   let relPrefixPath = takeFileName prefixPath
-  key <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  key <- liftIO $ C.randomSbKey g
+  nonce <- liftIO $ C.randomCbNonce g
   -- saving absolute filePath will not allow to restore file encryption after app update, but it's a short window
   fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce Nothing
   lift . void $ getXFTPSndWorker True c Nothing
@@ -369,11 +369,11 @@ xftpSendDescription' c userId (ValidFileDescription fdDirect@FileDescription {si
   createDirectory prefixPath
   let relPrefixPath = takeFileName prefixPath
   let directYaml = prefixPath </> "direct.yaml"
-  cfArgs <- atomically $ CF.randomArgs g
+  cfArgs <- liftIO $ CF.randomArgs g
   let file = CryptoFile directYaml (Just cfArgs)
   liftError (FILE . FILE_IO . show) $ CF.writeFile file (LB.fromStrict $ strEncode fdDirect)
-  key <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  key <- liftIO $ C.randomSbKey g
+  nonce <- liftIO $ C.randomCbNonce g
   fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce $ Just RedirectFileInfo {size, digest}
   lift . void $ getXFTPSndWorker True c Nothing
   pure fId

src/Simplex/FileTransfer/Client.hs

@@ -236,9 +236,9 @@ uploadXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> XFTPChunkSpe
 uploadXFTPChunk c spKey fId chunkSpec =
   sendXFTPCommand c spKey fId FPUT (Just chunkSpec) >>= okResponse
 
-downloadXFTPChunk :: TVar ChaChaDRG -> XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> XFTPRcvChunkSpec -> ExceptT XFTPClientError IO ()
+downloadXFTPChunk :: IORef ChaChaDRG -> XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> XFTPRcvChunkSpec -> ExceptT XFTPClientError IO ()
 downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {filePath, chunkSize} = do
-  (rDhKey, rpDhKey) <- atomically $ C.generateKeyPair g
+  (rDhKey, rpDhKey) <- liftIO $ C.generateKeyPair g
   sendXFTPCommand c rpKey fId (FGET rDhKey) Nothing >>= \case
     (FRFile sDhKey cbNonce, HTTP2Body {bodyHead = _bg, bodySize = _bs, bodyPart}) -> case bodyPart of
       -- TODO atm bodySize is set to 0, so chunkSize will be incorrect - validate once set

src/Simplex/FileTransfer/Client/Main.hs

@@ -290,13 +290,13 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
       putStrLn "Pass file descriptions to the recipient(s):"
     forM_ fdRcvPaths putStrLn
   where
-    encryptFileForUpload :: TVar ChaChaDRG -> String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
+    encryptFileForUpload :: IORef ChaChaDRG -> String -> ExceptT CLIError IO (FilePath, FileDescription 'FRecipient, FileDescription 'FSender, [XFTPChunkSpec], Int64)
     encryptFileForUpload g fileName = do
       fileSize <- fromInteger <$> getFileSize filePath
       when (fileSize > maxFileSize) $ throwE $ CLIError $ "Files bigger than " <> maxFileSizeStr <> " are not supported"
       encPath <- getEncPath tempPath "xftp"
-      key <- atomically $ C.randomSbKey g
-      nonce <- atomically $ C.randomCbNonce g
+      key <- liftIO $ C.randomSbKey g
+      nonce <- liftIO $ C.randomCbNonce g
       let fileHdr = smpEncode FileHeader {fileName, fileExtra = Nothing}
           fileSize' = fromIntegral (B.length fileHdr) + fileSize
           chunkSizes = prepareChunkSizes $ fileSize' + fileSizeLen + authTagSize
@@ -311,7 +311,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
           fdSnd = FileDescription {party = SFSender, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = [], redirect = Nothing}
       logInfo $ "encrypted file to " <> tshow encPath
       pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
-    uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
+    uploadFile :: IORef ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
     uploadFile g chunks uploadedChunks encSize = do
       a <- liftIO $ newXFTPAgent defaultXFTPClientAgentConfig
       gen <- newTVarIO =<< liftIO newStdGen
@@ -330,8 +330,8 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
         uploadFileChunk :: XFTPClientAgent -> (Int, XFTPChunkSpec, XFTPServerWithAuth) -> ExceptT CLIError IO (Int, SentFileChunk)
         uploadFileChunk a (chunkNo, chunkSpec@XFTPChunkSpec {chunkSize}, ProtoServerWithAuth xftpServer auth) = do
           logInfo $ "uploading chunk " <> tshow chunkNo <> " to " <> showServer xftpServer <> "..."
-          (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-          rKeys <- atomically $ L.fromList <$> replicateM numRecipients (C.generateAuthKeyPair C.SEd25519 g)
+          (sndKey, spKey) <- liftIO $ C.generateAuthKeyPair C.SEd25519 g
+          rKeys <- liftIO $ L.fromList <$> replicateM numRecipients (C.generateAuthKeyPair C.SEd25519 g)
           digest <- liftIO $ getChunkDigest chunkSpec
           let ch = FileInfo {sndKey, size = chunkSize, digest}
           c <- withRetry retryCount $ getXFTPServerClient a xftpServer
@@ -451,7 +451,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       liftIO $ do
         printNoNewLine $ "File downloaded: " <> path
         removeFD yes fileDescription
-    downloadFileChunk :: TVar ChaChaDRG -> XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath)
+    downloadFileChunk :: IORef ChaChaDRG -> XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath)
     downloadFileChunk g a encPath (FileSize encSize) downloadedChunks FileChunk {chunkNo, chunkSize, digest, replicas = replica : _} = do
       let FileChunkReplica {server, replicaId, replicaKey} = replica
       logInfo $ "downloading chunk " <> tshow chunkNo <> " from " <> showServer server <> "..."
@@ -615,7 +615,7 @@ cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} = do
   where
     saveRandomFile h sz = do
       g <- C.newRandom
-      bytes <- atomically $ C.randomBytes (fromIntegral $ min mb' sz) g
+      bytes <- C.randomBytes (fromIntegral $ min mb' sz) g
       B.hPut h bytes
       when (sz > mb') $ saveRandomFile h (sz - mb')
     mb' = mb 1

src/Simplex/FileTransfer/Server.hs

@@ -130,7 +130,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
           _ -> liftIO . sendResponse $ H.responseNoBody N.ok200 [] -- shouldn't happen: means server picked handshake protocol it doesn't know about
     xftpServerHandshakeV1 :: X.CertificateChain -> C.APrivateSignKey -> TMap SessionId Handshake -> XFTPTransportRequest -> M (Maybe (THandleParams XFTPVersion 'TServer))
     xftpServerHandshakeV1 chain serverSignKey sessions XFTPTransportRequest {thParams = thParams0@THandleParams {sessionId}, reqBody = HTTP2Body {bodyHead}, sendResponse} = do
-      s <- atomically $ TM.lookup sessionId sessions
+      s <- liftIO $ TM.lookupIO sessionId sessions
       r <- runExceptT $ case s of
         Nothing -> processHello
         Just (HandshakeSent pk) -> processClientHandshake pk
@@ -139,7 +139,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
       where
         processHello = do
           unless (B.null bodyHead) $ throwE HANDSHAKE
-          (k, pk) <- atomically . C.generateKeyPair =<< asks random
+          (k, pk) <- liftIO . C.generateKeyPair =<< asks random
           atomically $ TM.insert sessionId (HandshakeSent pk) sessions
           let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
           let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey}
@@ -489,9 +489,9 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
           where
             sendFile = do
               g <- asks random
-              (sDhKey, spDhKey) <- atomically $ C.generateKeyPair g
+              (sDhKey, spDhKey) <- liftIO $ C.generateKeyPair g
               let dhSecret = C.dh' rDhKey spDhKey
-              cbNonce <- atomically $ C.randomCbNonce g
+              cbNonce <- liftIO $ C.randomCbNonce g
               case LC.cbInit dhSecret cbNonce of
                 Right sbState -> do
                   stats <- asks serverStats
@@ -557,12 +557,12 @@ expireServerFiles itemDelay expCfg = do
       incFileStat filesExpired
 
 randomId :: Int -> M ByteString
-randomId n = atomically . C.randomBytes n =<< asks random
+randomId n = liftIO . C.randomBytes n =<< asks random
 
 getFileId :: M XFTPFileId
 getFileId = do
   size <- asks (fileIdSize . config)
-  atomically . C.randomBytes size =<< asks random
+  liftIO . C.randomBytes size =<< asks random
 
 withFileLog :: (StoreLog 'WriteMode -> IO a) -> M ()
 withFileLog action = liftIO . mapM_ action =<< asks storeLog

src/Simplex/FileTransfer/Server/Env.hs

@@ -12,6 +12,7 @@ module Simplex.FileTransfer.Server.Env where
 import Control.Logger.Simple
 import Control.Monad
 import Crypto.Random
+import Data.IORef (IORef)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as M
@@ -83,7 +84,7 @@ data XFTPEnv = XFTPEnv
   { config :: XFTPServerConfig,
     store :: FileStore,
     storeLog :: Maybe (StoreLog 'WriteMode),
-    random :: TVar ChaChaDRG,
+    random :: IORef ChaChaDRG,
     serverIdentity :: C.KeyHash,
     tlsServerParams :: T.ServerParams,
     serverStats :: FileServerStats

src/Simplex/Messaging/Agent.hs

@@ -136,6 +136,7 @@ import Data.Either (isRight, rights)
 import Data.Foldable (foldl', toList)
 import Data.Functor (($>))
 import Data.Functor.Identity
+import Data.IORef (IORef)
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -821,7 +822,7 @@ startJoinInvitation userId connId sq_ enableNtfs cReqUri pqSup =
       g <- asks random
       let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
       (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
-      (_, rcDHRs) <- atomically $ C.generateKeyPair g
+      (_, rcDHRs) <- liftIO $ C.generateKeyPair g
       rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams
       maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
       let rcVs = CR.RatchetVersions {current = v, maxSupported}
@@ -1941,8 +1942,8 @@ registerNtfToken' c suppliedDeviceToken suppliedNtfMode =
           asks (rcvAuthAlg . config) >>= \case
             C.AuthAlg a -> do
               g <- asks random
-              tknKeys <- atomically $ C.generateAuthKeyPair a g
-              dhKeys <- atomically $ C.generateKeyPair g
+              tknKeys <- liftIO $ C.generateAuthKeyPair a g
+              dhKeys <- liftIO $ C.generateKeyPair g
               let tkn = newNtfToken suppliedDeviceToken ntfServer tknKeys dhKeys suppliedNtfMode
               withStore' c (`createNtfToken` tkn)
               registerToken tkn
@@ -2405,7 +2406,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                           checkDuplicateHash e encryptedMsgHash =
                             unlessM (withStore' c $ \db -> checkRcvMsgHashExists db connId encryptedMsgHash) $
                               throwE e
-                          agentClientMsg :: TVar ChaChaDRG -> ByteString -> AM (Maybe (InternalId, MsgMeta, AMessage, CR.RatchetX448))
+                          agentClientMsg :: IORef ChaChaDRG -> ByteString -> AM (Maybe (InternalId, MsgMeta, AMessage, CR.RatchetX448))
                           agentClientMsg g encryptedMsgHash = withStore c $ \db -> runExceptT $ do
                             rc <- ExceptT $ getRatchet db connId -- ratchet state pre-decryption - required for processing EREADY
                             (agentMsgBody, pqEncryption) <- agentRatchetDecrypt' g db connId rc encAgentMessage
@@ -2787,7 +2788,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                     rcParams <- liftError cryptoError $ CR.pqX3dhRcv pk1 pk2 pKem e2eOtherPartyParams
                     recreateRatchet $ CR.initRcvRatchet rcVs pk2 rcParams pqSupport
                 | otherwise = do
-                    (_, rcDHRs) <- atomically . C.generateKeyPair =<< asks random
+                    (_, rcDHRs) <- liftIO . C.generateKeyPair =<< asks random
                     rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 (CR.APRKP CR.SRKSProposed <$> pKem) e2eOtherPartyParams
                     recreateRatchet $ CR.initSndRatchet rcVs k2Rcv rcDHRs rcParams
                     void . enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} $ EREADY lastExternalSndId
@@ -2934,12 +2935,12 @@ agentRatchetEncrypt db ConnData {connId, connAgentVersion = v, pqSupport} msg ge
   pure (encMsg, CR.rcSndKEM rc')
 
 -- encoded EncAgentMessage -> encoded AgentMessage
-agentRatchetDecrypt :: TVar ChaChaDRG -> DB.Connection -> ConnId -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
+agentRatchetDecrypt :: IORef ChaChaDRG -> DB.Connection -> ConnId -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
 agentRatchetDecrypt g db connId encAgentMsg = do
   rc <- ExceptT $ getRatchet db connId
   agentRatchetDecrypt' g db connId rc encAgentMsg
 
-agentRatchetDecrypt' :: TVar ChaChaDRG -> DB.Connection -> ConnId -> CR.RatchetX448 -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
+agentRatchetDecrypt' :: IORef ChaChaDRG -> DB.Connection -> ConnId -> CR.RatchetX448 -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
 agentRatchetDecrypt' g db connId rc encAgentMsg = do
   skipped <- liftIO $ getSkippedMsgKeys db connId
   (agentMsgBody_, rc', skippedDiff) <- withExceptT (SEAgentError . cryptoError) $ CR.rcDecrypt g rc skipped encAgentMsg
@@ -2950,8 +2951,8 @@ newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> AM' (NewSndQueue,
 newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, sndSecure, dhPublicKey = rcvE2ePubDhKey})) = do
   C.AuthAlg a <- asks $ sndAuthAlg . config
   g <- asks random
-  (sndPublicKey, sndPrivateKey) <- atomically $ C.generateAuthKeyPair a g
-  (e2ePubKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
+  (sndPublicKey, sndPrivateKey) <- liftIO $ C.generateAuthKeyPair a g
+  (e2ePubKey, e2ePrivKey) <- liftIO $ C.generateKeyPair g
   let sq =
         SndQueue
           { userId,

src/Simplex/Messaging/Agent/Client.hs

@@ -182,6 +182,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight, partitionEithers)
 import Data.Functor (($>))
+import Data.IORef (IORef)
 import Data.Int (Int64)
 import Data.List (deleteFirstsBy, foldl', partition, (\\))
 import Data.List.NonEmpty (NonEmpty (..), (<|))
@@ -548,7 +549,7 @@ agentClientStore :: AgentClient -> SQLiteStore
 agentClientStore AgentClient {agentEnv = Env {store}} = store
 {-# INLINE agentClientStore #-}
 
-agentDRG :: AgentClient -> TVar ChaChaDRG
+agentDRG :: AgentClient -> IORef ChaChaDRG
 agentDRG AgentClient {agentEnv = Env {random}} = random
 {-# INLINE agentDRG #-}
 
@@ -1198,9 +1199,9 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
     let tSess = (userId, srv, Nothing)
     getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
       Right smp -> do
-        rKeys@(_, rpKey) <- atomically $ C.generateAuthKeyPair ra g
-        (sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
-        (dhKey, _) <- atomically $ C.generateKeyPair g
+        rKeys@(_, rpKey) <- liftIO $ C.generateAuthKeyPair ra g
+        (sKey, spKey) <- liftIO $ C.generateAuthKeyPair sa g
+        (dhKey, _) <- liftIO $ C.generateKeyPair g
         r <- runExceptT $ do
           SMP.QIK {rcvId, sndId, sndSecure} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp rKeys dhKey auth SMSubscribe True
           liftError (testErr TSSecureQueue) $
@@ -1228,8 +1229,8 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
     let tSess = (userId, srv, Nothing)
     X.getXFTPClient tSess cfg {xftpNetworkConfig} (\_ -> pure ()) >>= \case
       Right xftp -> withTestChunk filePath $ do
-        (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-        (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+        (sndKey, spKey) <- liftIO $ C.generateAuthKeyPair C.SEd25519 g
+        (rcvKey, rpKey) <- liftIO $ C.generateAuthKeyPair C.SEd25519 g
         digest <- liftIO $ C.sha256Hash <$> B.readFile filePath
         let file = FileInfo {sndKey, size = chSize, digest}
             chunkSpec = X.XFTPChunkSpec {filePath, chunkOffset = 0, chunkSize = chSize}
@@ -1261,7 +1262,7 @@ runXFTPServerTest c userId (ProtoServerWithAuth srv auth) = do
         (whenM (doesFileExist fp) $ removeFile fp `catchAll_` pure ())
     -- this creates a new DRG on purpose to avoid blocking the one used in the agent
     createTestChunk :: FilePath -> IO ()
-    createTestChunk fp = B.writeFile fp =<< atomically . C.randomBytes chSize =<< C.newRandom
+    createTestChunk fp = B.writeFile fp =<< liftIO . C.randomBytes chSize =<< C.newRandom
 
 runNTFServerTest :: AgentClient -> UserId -> NtfServerWithAuth -> AM' (Maybe ProtocolTestFailure)
 runNTFServerTest c userId (ProtoServerWithAuth srv _) = do
@@ -1272,8 +1273,8 @@ runNTFServerTest c userId (ProtoServerWithAuth srv _) = do
     let tSess = (userId, srv, Nothing)
     getProtocolClient g tSess cfg Nothing (\_ -> pure ()) >>= \case
       Right ntf -> do
-        (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
-        (dhKey, _) <- atomically $ C.generateKeyPair g
+        (nKey, npKey) <- liftIO $ C.generateAuthKeyPair a g
+        (dhKey, _) <- liftIO $ C.generateKeyPair g
         r <- runExceptT $ do
           let deviceToken = DeviceToken PPApnsNull "test_ntf_token"
           (tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf npKey (NewNtfTkn deviceToken nKey dhKey)
@@ -1315,9 +1316,9 @@ newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRa
 newRcvQueue c userId connId (ProtoServerWithAuth srv auth) vRange subMode senderCanSecure = do
   C.AuthAlg a <- asks (rcvAuthAlg . config)
   g <- asks random
-  rKeys@(_, rcvPrivateKey) <- atomically $ C.generateAuthKeyPair a g
-  (dhKey, privDhKey) <- atomically $ C.generateKeyPair g
-  (e2eDhKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
+  rKeys@(_, rcvPrivateKey) <- liftIO $ C.generateAuthKeyPair a g
+  (dhKey, privDhKey) <- liftIO $ C.generateKeyPair g
+  (e2eDhKey, e2ePrivKey) <- liftIO $ C.generateKeyPair g
   logServer "-->" c srv "" "NEW"
   tSess <- mkTransportSession c userId srv connId
   (sessId, QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}) <-
@@ -1705,7 +1706,7 @@ agentXFTPDownloadChunk c userId (FileDigest chunkDigest) RcvFileChunkReplica {se
 agentXFTPNewChunk :: AgentClient -> SndFileChunk -> Int -> XFTPServerWithAuth -> AM NewSndChunkReplica
 agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize}, digest = FileDigest chunkDigest} n (ProtoServerWithAuth srv auth) = do
   rKeys <- xftpRcvKeys n
-  (sndKey, replicaKey) <- atomically . C.generateAuthKeyPair C.SEd25519 =<< asks random
+  (sndKey, replicaKey) <- liftIO . C.generateAuthKeyPair C.SEd25519 =<< asks random
   let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest}
   logServer "-->" c srv "" "FNEW"
   tSess <- mkTransportSession c userId srv chunkDigest
@@ -1729,7 +1730,7 @@ agentXFTPDeleteChunk c userId DeletedSndChunkReplica {server, replicaId = ChunkR
 
 xftpRcvKeys :: Int -> AM (NonEmpty C.AAuthKeyPair)
 xftpRcvKeys n = do
-  rKeys <- atomically . replicateM n . C.generateAuthKeyPair C.SEd25519 =<< asks random
+  rKeys <- liftIO . replicateM n . C.generateAuthKeyPair C.SEd25519 =<< asks random
   case L.nonEmpty rKeys of
     Just rKeys' -> pure rKeys'
     _ -> throwE $ INTERNAL "non-positive number of recipients"
@@ -1739,7 +1740,7 @@ xftpRcvIdsKeys rIds rKeys = L.map ChunkReplicaId rIds `L.zip` L.map snd rKeys
 
 agentCbEncrypt :: SndQueue -> Maybe C.PublicKeyX25519 -> ByteString -> AM ByteString
 agentCbEncrypt SndQueue {e2eDhSecret, smpClientVersion} e2ePubKey msg = do
-  cmNonce <- atomically . C.randomCbNonce =<< asks random
+  cmNonce <- liftIO . C.randomCbNonce =<< asks random
   let paddedLen = maybe SMP.e2eEncMessageLength (const SMP.e2eEncConfirmationLength) e2ePubKey
   cmEncBody <-
     liftEither . first cryptoError $
@@ -1751,9 +1752,9 @@ agentCbEncrypt SndQueue {e2eDhSecret, smpClientVersion} e2ePubKey msg = do
 agentCbEncryptOnce :: VersionSMPC -> C.PublicKeyX25519 -> ByteString -> AM ByteString
 agentCbEncryptOnce clientVersion dhRcvPubKey msg = do
   g <- asks random
-  (dhSndPubKey, dhSndPrivKey) <- atomically $ C.generateKeyPair g
+  (dhSndPubKey, dhSndPrivKey) <- liftIO $ C.generateKeyPair g
   let e2eDhSecret = C.dh' dhRcvPubKey dhSndPrivKey
-  cmNonce <- atomically $ C.randomCbNonce g
+  cmNonce <- liftIO $ C.randomCbNonce g
   cmEncBody <-
     liftEither . first cryptoError $
       C.cbEncrypt e2eDhSecret cmNonce msg SMP.e2eEncConfirmationLength

src/Simplex/Messaging/Agent/Env/SQLite.hs

@@ -49,6 +49,7 @@ import Crypto.Random
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as JQ
 import Data.ByteArray (ScrubbedBytes)
+import Data.IORef (IORef) 
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
@@ -233,7 +234,7 @@ defaultAgentConfig =
 data Env = Env
   { config :: AgentConfig,
     store :: SQLiteStore,
-    random :: TVar ChaChaDRG,
+    random :: IORef ChaChaDRG,
     randomServer :: TVar StdGen,
     ntfSupervisor :: NtfSupervisor,
     xftpAgent :: XFTPAgent,

src/Simplex/Messaging/Agent/NtfSubSupervisor.hs

@@ -259,8 +259,8 @@ runNtfSMPWorker c srv Worker {doWork} = do
                 rq <- withStore c (`getPrimaryRcvQueue` connId)
                 C.AuthAlg a <- asks (rcvAuthAlg . config)
                 g <- asks random
-                (ntfPublicKey, ntfPrivateKey) <- atomically $ C.generateAuthKeyPair a g
-                (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- atomically $ C.generateKeyPair g
+                (ntfPublicKey, ntfPrivateKey) <- liftIO $ C.generateAuthKeyPair a g
+                (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- liftIO $ C.generateKeyPair g
                 (notifierId, rcvNtfSrvPubDhKey) <- enableQueueNotifications c rq ntfPublicKey rcvNtfPubDhKey
                 let rcvNtfDhSecret = C.dh' rcvNtfSrvPubDhKey rcvNtfPrivDhKey
                 withStore' c $ \db -> do

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -547,7 +547,7 @@ deleteUsersWithoutConns db = do
   pure userIds
 
 createConn_ ::
-  TVar ChaChaDRG ->
+  IORef ChaChaDRG ->
   ConnData ->
   (ConnId -> IO a) ->
   IO (Either StoreError (ConnId, a))
@@ -555,7 +555,7 @@ createConn_ gVar cData create = checkConstraint SEConnDuplicate $ case cData of
   ConnData {connId = ""} -> createWithRandomId' gVar create
   ConnData {connId} -> Right . (connId,) <$> create connId
 
-createNewConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> SConnectionMode c -> IO (Either StoreError ConnId)
+createNewConn :: DB.Connection -> IORef ChaChaDRG -> ConnData -> SConnectionMode c -> IO (Either StoreError ConnId)
 createNewConn db gVar cData cMode = do
   fst <$$> createConn_ gVar cData (\connId -> createConnRecord db connId cData cMode)
 
@@ -579,7 +579,7 @@ updateNewConnSnd db connId sq =
     updateConn :: IO (Either StoreError SndQueue)
     updateConn = Right <$> addConnSndQueue_ db connId sq
 
-createSndConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> NewSndQueue -> IO (Either StoreError (ConnId, SndQueue))
+createSndConn :: DB.Connection -> IORef ChaChaDRG -> ConnData -> NewSndQueue -> IO (Either StoreError (ConnId, SndQueue))
 createSndConn db gVar cData q@SndQueue {server} =
   -- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_
   ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $
@@ -828,7 +828,7 @@ smpConfirmation (senderKey, e2ePubKey, connInfo, smpReplyQueues_, smpClientVersi
       smpClientVersion = fromMaybe initialSMPClientVersion smpClientVersion_
     }
 
-createConfirmation :: DB.Connection -> TVar ChaChaDRG -> NewConfirmation -> IO (Either StoreError ConfirmationId)
+createConfirmation :: DB.Connection -> IORef ChaChaDRG -> NewConfirmation -> IO (Either StoreError ConfirmationId)
 createConfirmation db gVar NewConfirmation {connId, senderConf = SMPConfirmation {senderKey, e2ePubKey, connInfo, smpReplyQueues, smpClientVersion}, ratchetState} =
   createWithRandomId gVar $ \confirmationId ->
     DB.execute
@@ -902,7 +902,7 @@ removeConfirmations db connId =
     |]
     [":conn_id" := connId]
 
-createInvitation :: DB.Connection -> TVar ChaChaDRG -> NewInvitation -> IO (Either StoreError InvitationId)
+createInvitation :: DB.Connection -> IORef ChaChaDRG -> NewInvitation -> IO (Either StoreError InvitationId)
 createInvitation db gVar NewInvitation {contactConnId, connReq, recipientConnInfo} =
   createWithRandomId gVar $ \invitationId ->
     DB.execute
@@ -2284,10 +2284,10 @@ updateSndMsgHash db connId internalSndId internalHash =
     ]
 
 -- create record with a random ID
-createWithRandomId :: TVar ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
+createWithRandomId :: IORef ChaChaDRG -> (ByteString -> IO ()) -> IO (Either StoreError ByteString)
 createWithRandomId gVar create = fst <$$> createWithRandomId' gVar create
 
-createWithRandomId' :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError (ByteString, a))
+createWithRandomId' :: forall a. IORef ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError (ByteString, a))
 createWithRandomId' gVar create = tryCreate 3
   where
     tryCreate :: Int -> IO (Either StoreError (ByteString, a))
@@ -2300,8 +2300,8 @@ createWithRandomId' gVar create = tryCreate 3
           | SQL.sqlError e == SQL.ErrorConstraint -> tryCreate (n - 1)
           | otherwise -> pure . Left . SEInternal $ bshow e
 
-randomId :: TVar ChaChaDRG -> Int -> IO ByteString
-randomId gVar n = atomically $ U.encode <$> C.randomBytes n gVar
+randomId :: IORef ChaChaDRG -> Int -> IO ByteString
+randomId gVar n = U.encode <$> C.randomBytes n gVar
 
 ntfSubAndSMPAction :: NtfSubAction -> (Maybe NtfSubNTFAction, Maybe NtfSubSMPAction)
 ntfSubAndSMPAction (NSANtf action) = (Just action, Nothing)
@@ -2322,7 +2322,7 @@ getXFTPServerId_ db ProtocolServer {host, port, keyHash} = do
   firstRow fromOnly SEXFTPServerNotFound $
     DB.query db "SELECT xftp_server_id FROM xftp_servers WHERE xftp_host = ? AND xftp_port = ? AND xftp_key_hash = ?" (host, port, keyHash)
 
-createRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
+createRcvFile :: DB.Connection -> IORef ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
 createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath file approvedRelays = runExceptT $ do
   (rcvFileEntityId, rcvFileId) <- ExceptT $ insertRcvFile db gVar userId fd prefixPath tmpPath file Nothing Nothing approvedRelays
   liftIO $
@@ -2331,7 +2331,7 @@ createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath file
       forM_ (zip [1 ..] replicas) $ \(rno, replica) -> insertRcvFileChunkReplica db rno replica chunkId
   pure rcvFileEntityId
 
-createRcvFileRedirect :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
+createRcvFileRedirect :: DB.Connection -> IORef ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
 createRcvFileRedirect _ _ _ FileDescription {redirect = Nothing} _ _ _ _ _ _ = pure $ Left $ SEInternal "createRcvFileRedirect called without redirect"
 createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redirectChunks, redirect = Just RedirectFileInfo {size, digest}} prefixPath redirectPath redirectFile dstPath dstFile approvedRelays = runExceptT $ do
   (dstEntityId, dstId) <- ExceptT $ insertRcvFile db gVar userId dummyDst prefixPath dstPath dstFile Nothing Nothing approvedRelays
@@ -2355,7 +2355,7 @@ createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redire
           chunks = []
         }
 
-insertRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Maybe DBRcvFileId -> Maybe RcvFileId -> Bool -> IO (Either StoreError (RcvFileId, DBRcvFileId))
+insertRcvFile :: DB.Connection -> IORef ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Maybe DBRcvFileId -> Maybe RcvFileId -> Bool -> IO (Either StoreError (RcvFileId, DBRcvFileId))
 insertRcvFile db gVar userId FileDescription {size, digest, key, nonce, chunkSize, redirect} prefixPath tmpPath (CryptoFile savePath cfArgs) redirectId_ redirectEntityId_ approvedRelays = runExceptT $ do
   let (redirectDigest_, redirectSize_) = case redirect of
         Just RedirectFileInfo {digest = d, size = s} -> (Just d, Just s)
@@ -2651,7 +2651,7 @@ getRcvFilesExpired db ttl = do
     |]
     (Only cutoffTs)
 
-createSndFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> CryptoFile -> Int -> FilePath -> C.SbKey -> C.CbNonce -> Maybe RedirectFileInfo -> IO (Either StoreError SndFileId)
+createSndFile :: DB.Connection -> IORef ChaChaDRG -> UserId -> CryptoFile -> Int -> FilePath -> C.SbKey -> C.CbNonce -> Maybe RedirectFileInfo -> IO (Either StoreError SndFileId)
 createSndFile db gVar userId (CryptoFile path cfArgs) numRecipients prefixPath key nonce redirect_ =
   createWithRandomId gVar $ \sndFileEntityId ->
     DB.execute

src/Simplex/Messaging/Client.hs

@@ -118,6 +118,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
+import Data.IORef
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
@@ -163,18 +164,18 @@ data PClient v err msg = PClient
     sendPings :: TVar Bool,
     lastReceived :: TVar UTCTime,
     timeoutErrorCount :: TVar Int,
-    clientCorrId :: TVar ChaChaDRG,
+    clientCorrId :: IORef ChaChaDRG,
     sentCommands :: TMap CorrId (Request err msg),
     sndQ :: TBQueue (Maybe (TVar Bool), ByteString),
     rcvQ :: TBQueue (NonEmpty (SignedTransmission err msg)),
     msgQ :: Maybe (TBQueue (ServerTransmissionBatch v err msg))
   }
 
-smpClientStub :: TVar ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> IO SMPClient
+smpClientStub :: IORef ChaChaDRG -> ByteString -> VersionSMP -> Maybe (THandleAuth 'TClient) -> IO SMPClient
 smpClientStub g sessionId thVersion thAuth = do
   let ts = UTCTime (read "2024-03-31") 0
   connected <- newTVarIO False
-  clientCorrId <- atomically $ C.newRandomDRG g
+  clientCorrId <- C.newRandomDRG g
   sentCommands <- TM.emptyIO
   sendPings <- newTVarIO False
   lastReceived <- newTVarIO ts
@@ -448,7 +449,7 @@ type TransportSession msg = (UserId, ProtoServer msg, Maybe EntityId)
 --
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
-getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
+getProtocolClient :: forall v err msg. Protocol v err msg => IORef ChaChaDRG -> TransportSession msg -> ProtocolClientConfig v -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
 getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serverVRange, agreeSecret} msgQ disconnected = do
   case chooseTransportHost networkConfig (host srv) of
     Right useHost ->
@@ -463,7 +464,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
       sendPings <- newTVarIO False
       lastReceived <- newTVarIO ts
       timeoutErrorCount <- newTVarIO 0
-      clientCorrId <- atomically $ C.newRandomDRG g
+      clientCorrId <- C.newRandomDRG g
       sentCommands <- TM.emptyIO
       sndQ <- newTBQueueIO qSize
       rcvQ <- newTBQueueIO qSize
@@ -506,7 +507,7 @@ getProtocolClient g transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize
 
     client :: forall c. Transport c => TProxy c -> PClient v err msg -> TMVar (Either (ProtocolClientError err) (ProtocolClient v err msg)) -> c -> IO ()
     client _ c cVar h = do
-      ks <- if agreeSecret then Just <$> atomically (C.generateKeyPair g) else pure Nothing
+      ks <- if agreeSecret then Just <$> C.generateKeyPair g else pure Nothing
       runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange) >>= \case
         Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
         Right th@THandle {params} -> do
@@ -917,9 +918,9 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
   -- prepare params
   let serverThAuth = (\ta -> ta {serverPeerPubKey = serverKey}) <$> thAuth proxyThParams
       serverThParams = smpTHParamsSetVersion v proxyThParams {sessionId, thAuth = serverThAuth}
-  (cmdPubKey, cmdPrivKey) <- liftIO . atomically $ C.generateKeyPair @'C.X25519 g
+  (cmdPubKey, cmdPrivKey) <- liftIO $ C.generateKeyPair @'C.X25519 g
   let cmdSecret = C.dh' serverKey cmdPrivKey
-  nonce@(C.CbNonce corrId) <- liftIO . atomically $ C.randomCbNonce g
+  nonce@(C.CbNonce corrId) <- liftIO $ C.randomCbNonce g
   -- encode
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd SSender command)
   auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth spKey nonce tForAuth
@@ -962,7 +963,7 @@ forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorr
   sessSecret <- case thAuth thParams of
     Nothing -> throwE $ PCETransportError TENoServerAuth
     Just THAuthClient {sessSecret} -> maybe (throwE $ PCETransportError TENoServerAuth) pure sessSecret
-  nonce <- liftIO . atomically $ C.randomCbNonce g
+  nonce <- liftIO $ C.randomCbNonce g
   -- wrap
   let fwdT = FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission}
       eft = EncFwdTransmission $ C.cbEncryptNoPad sessSecret nonce (smpEncode fwdT)
@@ -1086,7 +1087,7 @@ mkTransmission c = mkTransmission_ c Nothing
 
 mkTransmission_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.CbNonce -> ClientCommand msg -> IO (PCTransmission err msg)
 mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCommands}} nonce_ (pKey_, entityId, command) = do
-  nonce@(C.CbNonce corrId) <- maybe (atomically $ C.randomCbNonce clientCorrId) pure nonce_
+  nonce@(C.CbNonce corrId) <- maybe (C.randomCbNonce clientCorrId) pure nonce_
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, entityId, command)
       auth = authTransmission (thAuth thParams) pKey_ nonce tForAuth
   r <- mkRequest (CorrId corrId)

src/Simplex/Messaging/Client/Agent.hs

@@ -23,6 +23,7 @@ import Crypto.Random (ChaChaDRG)
 import Data.Bifunctor (first)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.IORef
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
@@ -97,7 +98,7 @@ data SMPClientAgent = SMPClientAgent
     active :: TVar Bool,
     msgQ :: TBQueue (ServerTransmissionBatch SMPVersion ErrorType BrokerMsg),
     agentQ :: TBQueue SMPClientAgentEvent,
-    randomDrg :: TVar ChaChaDRG,
+    randomDrg :: IORef ChaChaDRG,
     smpClients :: TMap SMPServer SMPClientVar,
     smpSessions :: TMap SessionId (OwnServer, SMPClient),
     srvSubs :: TMap SMPServer (TMap SMPSub (SessionId, C.APrivateAuthKey)),
@@ -108,7 +109,7 @@ data SMPClientAgent = SMPClientAgent
 
 type OwnServer = Bool
 
-newSMPClientAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO SMPClientAgent
+newSMPClientAgent :: SMPClientAgentConfig -> IORef ChaChaDRG -> IO SMPClientAgent
 newSMPClientAgent agentCfg@SMPClientAgentConfig {msgQSize, agentQSize} randomDrg = do
   active <- newTVarIO True
   msgQ <- newTBQueueIO msgQSize

src/Simplex/Messaging/Crypto.hs

@@ -188,7 +188,6 @@ module Simplex.Messaging.Crypto
   )
 where
 
-import Control.Concurrent.STM
 import Control.Exception (Exception)
 import Control.Monad
 import Control.Monad.Except
@@ -218,6 +217,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Lazy (fromStrict, toStrict)
 import Data.Constraint (Dict (..))
+import Data.IORef
 import Data.Kind (Constraint, Type)
 import qualified Data.List.NonEmpty as L
 import Data.String
@@ -233,7 +233,7 @@ import Network.Transport.Internal (decodeWord16, encodeWord16)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (atomicStateIORef, (<$?>))
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -674,26 +674,26 @@ type ADhKeyPair = KeyPairType APrivateDhKey
 
 type AAuthKeyPair = KeyPairType APrivateAuthKey
 
-newRandom :: IO (TVar ChaChaDRG)
-newRandom = newTVarIO =<< drgNew
+newRandom :: IO (IORef ChaChaDRG)
+newRandom = newIORef =<< drgNew
 
-newRandomDRG :: TVar ChaChaDRG -> STM (TVar ChaChaDRG)
-newRandomDRG g = newTVar =<< stateTVar g (`withDRG` drgNew)
+newRandomDRG :: IORef ChaChaDRG -> IO (IORef ChaChaDRG)
+newRandomDRG g = newIORef =<< atomicStateIORef g (`withDRG` drgNew)
 
-generateAKeyPair :: AlgorithmI a => SAlgorithm a -> TVar ChaChaDRG -> STM AKeyPair
+generateAKeyPair :: AlgorithmI a => SAlgorithm a -> IORef ChaChaDRG -> IO AKeyPair
 generateAKeyPair a g = bimap (APublicKey a) (APrivateKey a) <$> generateKeyPair g
 
-generateSignatureKeyPair :: (AlgorithmI a, SignatureAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM ASignatureKeyPair
+generateSignatureKeyPair :: (AlgorithmI a, SignatureAlgorithm a) => SAlgorithm a -> IORef ChaChaDRG -> IO ASignatureKeyPair
 generateSignatureKeyPair a g = bimap (APublicVerifyKey a) (APrivateSignKey a) <$> generateKeyPair g
 
-generateAuthKeyPair :: (AlgorithmI a, AuthAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM AAuthKeyPair
+generateAuthKeyPair :: (AlgorithmI a, AuthAlgorithm a) => SAlgorithm a -> IORef ChaChaDRG -> IO AAuthKeyPair
 generateAuthKeyPair a g = bimap (APublicAuthKey a) (APrivateAuthKey a) <$> generateKeyPair g
 
-generateDhKeyPair :: (AlgorithmI a, DhAlgorithm a) => SAlgorithm a -> TVar ChaChaDRG -> STM ADhKeyPair
+generateDhKeyPair :: (AlgorithmI a, DhAlgorithm a) => SAlgorithm a -> IORef ChaChaDRG -> IO ADhKeyPair
 generateDhKeyPair a g = bimap (APublicDhKey a) (APrivateDhKey a) <$> generateKeyPair g
 
-generateKeyPair :: forall a. AlgorithmI a => TVar ChaChaDRG -> STM (KeyPair a)
-generateKeyPair g = stateTVar g (`withDRG` generateKeyPair_)
+generateKeyPair :: forall a. AlgorithmI a => IORef ChaChaDRG -> IO (KeyPair a)
+generateKeyPair g = atomicStateIORef g (`withDRG` generateKeyPair_)
 
 generateKeyPair_ :: forall a. AlgorithmI a => MonadPseudoRandom ChaChaDRG (KeyPair a)
 generateKeyPair_ = case sAlgorithm @a of
@@ -1070,10 +1070,10 @@ initAEADGCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
   AES.aeadInit AES.AEAD_GCM cipher ivBytes
 
 -- | Random AES256 key.
-randomAesKey :: TVar ChaChaDRG -> STM Key
+randomAesKey :: IORef ChaChaDRG -> IO Key
 randomAesKey = fmap Key . randomBytes aesKeySize
 
-randomGCMIV :: TVar ChaChaDRG -> STM GCMIV
+randomGCMIV :: IORef ChaChaDRG -> IO GCMIV
 randomGCMIV = fmap GCMIV . randomBytes gcmIVSize
 
 ivSize :: forall c. AES.BlockCipher c => Int
@@ -1287,11 +1287,11 @@ cbNonce s
   where
     len = B.length s
 
-randomCbNonce :: TVar ChaChaDRG -> STM CbNonce
+randomCbNonce :: IORef ChaChaDRG -> IO CbNonce
 randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
 
-randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
-randomBytes n gVar = stateTVar gVar $ randomBytesGenerate n
+randomBytes :: Int -> IORef ChaChaDRG -> IO ByteString
+randomBytes n gRef = atomicStateIORef gRef $ randomBytesGenerate n
 
 reverseNonce :: CbNonce -> CbNonce
 reverseNonce (CryptoBoxNonce s) = CryptoBoxNonce (B.reverse s)
@@ -1331,7 +1331,7 @@ sbKey s
 unsafeSbKey :: ByteString -> SbKey
 unsafeSbKey s = either error id $ sbKey s
 
-randomSbKey :: TVar ChaChaDRG -> STM SbKey
+randomSbKey :: IORef ChaChaDRG -> IO SbKey
 randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar
 
 xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString)

src/Simplex/Messaging/Crypto/File.hs

@@ -30,6 +30,7 @@ import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
+import Data.IORef (IORef)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isJust)
 import qualified Simplex.Messaging.Crypto as C
@@ -110,7 +111,7 @@ data FTCryptoError
 plain :: FilePath -> CryptoFile
 plain = (`CryptoFile` Nothing)
 
-randomArgs :: TVar ChaChaDRG -> STM CryptoFileArgs
+randomArgs :: IORef ChaChaDRG -> IO CryptoFileArgs
 randomArgs g = CFArgs <$> C.randomSbKey g <*> C.randomCbNonce g
 
 getFileContentsSize :: CryptoFile -> IO Integer

src/Simplex/Messaging/Crypto/Ratchet.hs

@@ -102,6 +102,7 @@ import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import Data.Composition ((.:), (.:.))
 import Data.Functor (($>))
+import Data.IORef (IORef)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -120,7 +121,6 @@ import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON, parseE, parseE'
 import Simplex.Messaging.Util (($>>=), (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
-import UnliftIO.STM
 
 -- e2e encryption headers version history:
 -- 1 - binary protocol encoding (1/1/2022)
@@ -369,10 +369,10 @@ data UseKEM (s :: RatchetKEMState) where
 
 data AUseKEM = forall s. RatchetKEMStateI s => AUseKEM (SRatchetKEMState s) (UseKEM s)
 
-generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s), E2ERatchetParams s a)
+generateE2EParams :: forall s a. (AlgorithmI a, DhAlgorithm a) => IORef ChaChaDRG -> VersionE2E -> Maybe (UseKEM s) -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams s), E2ERatchetParams s a)
 generateE2EParams g v useKEM_ = do
-  (k1, pk1) <- atomically $ generateKeyPair g
-  (k2, pk2) <- atomically $ generateKeyPair g
+  (k1, pk1) <- generateKeyPair g
+  (k2, pk2) <- generateKeyPair g
   kems <- kemParams
   pure (pk1, pk2, snd <$> kems, E2ERatchetParams v k1 k2 (fst <$> kems))
   where
@@ -390,7 +390,7 @@ generateE2EParams g v useKEM_ = do
       _ -> pure Nothing
 
 -- used by party initiating connection, Bob in double-ratchet spec
-generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> PQSupport -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams 'RKSProposed), E2ERatchetParams 'RKSProposed a)
+generateRcvE2EParams :: (AlgorithmI a, DhAlgorithm a) => IORef ChaChaDRG -> VersionE2E -> PQSupport -> IO (PrivateKey a, PrivateKey a, Maybe (PrivRKEMParams 'RKSProposed), E2ERatchetParams 'RKSProposed a)
 generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_
   where
     proposeKEM_ :: PQSupport -> Maybe (UseKEM 'RKSProposed)
@@ -399,7 +399,7 @@ generateRcvE2EParams g v = generateE2EParams g v . proposeKEM_
       PQSupportOff -> Nothing
 
 -- used by party accepting connection, Alice in double-ratchet spec
-generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => TVar ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams, AE2ERatchetParams a)
+generateSndE2EParams :: forall a. (AlgorithmI a, DhAlgorithm a) => IORef ChaChaDRG -> VersionE2E -> Maybe AUseKEM -> IO (PrivateKey a, PrivateKey a, Maybe APrivRKEMParams, AE2ERatchetParams a)
 generateSndE2EParams g v = \case
   Nothing -> do
     (pk1, pk2, _, e2eParams) <- generateE2EParams g v Nothing
@@ -911,7 +911,7 @@ maxSkip = 512
 rcDecrypt ::
   forall a.
   (AlgorithmI a, DhAlgorithm a) =>
-  TVar ChaChaDRG ->
+  IORef ChaChaDRG ->
   Ratchet a ->
   SkippedMsgKeys ->
   ByteString ->
@@ -965,7 +965,7 @@ rcDecrypt g rc@Ratchet {rcRcv, rcAD = Str rcAD, rcVersion} rcMKSkipped msg' = do
         ratchetStep rc'@Ratchet {rcDHRs, rcRK, rcNHKs, rcNHKr, rcSupportKEM, rcVersion = rv} MsgHeader {msgDHRs, msgKEM} = do
           (kemSS, kemSS', rcKEM') <- pqRatchetStep rc' msgKEM
           -- state.DHRs = GENERATE_DH()
-          (_, rcDHRs') <- atomically $ generateKeyPair @a g
+          (_, rcDHRs') <- liftIO $ generateKeyPair @a g
           -- state.RK, state.CKr, state.NHKr = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr) || ss)
           let (rcRK', rcCKr', rcNHKr') = rootKdf rcRK msgDHRs rcDHRs kemSS
               -- state.RK, state.CKs, state.NHKs = KDF_RK_HE(state.RK, DH(state.DHRs, state.DHRr) || state.PQRss)

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings.hs

@@ -2,13 +2,13 @@
 
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings where
 
-import Control.Concurrent.STM
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Bifunctor (bimap)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
+import Data.IORef
 import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.ToField
 import Foreign (nullPtr)
@@ -36,7 +36,7 @@ unsafeRevealKEMSharedKey (KEMSharedKey scrubbed) = show (BA.convert scrubbed ::
 
 type KEMKeyPair = (KEMPublicKey, KEMSecretKey)
 
-sntrup761Keypair :: TVar ChaChaDRG -> IO KEMKeyPair
+sntrup761Keypair :: IORef ChaChaDRG -> IO KEMKeyPair
 sntrup761Keypair drg =
   bimap KEMPublicKey KEMSecretKey
     <$> BA.allocRet
@@ -46,7 +46,7 @@ sntrup761Keypair drg =
             withDRG drg $ c_sntrup761_keypair pkPtr skPtr nullPtr
       )
 
-sntrup761Enc :: TVar ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
+sntrup761Enc :: IORef ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
 sntrup761Enc drg (KEMPublicKey pk) =
   BA.withByteArray pk $ \pkPtr ->
     bimap KEMCiphertext KEMSharedKey

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings/RNG.hs

@@ -8,17 +8,18 @@ import Control.Concurrent.STM
 import Control.Exception (bracket)
 import Crypto.Random (ChaChaDRG)
 import Data.ByteArray (ByteArrayAccess (copyByteArrayToPtr))
+import Data.IORef
 import Foreign
 import Foreign.C
 import qualified Simplex.Messaging.Crypto as C
 
-withDRG :: TVar ChaChaDRG -> (FunPtr RNGFunc -> IO a) -> IO a
+withDRG :: IORef ChaChaDRG -> (FunPtr RNGFunc -> IO a) -> IO a
 withDRG drg = bracket (createRNGFunc drg) freeHaskellFunPtr
 
-createRNGFunc :: TVar ChaChaDRG -> IO (FunPtr RNGFunc)
+createRNGFunc :: IORef ChaChaDRG -> IO (FunPtr RNGFunc)
 createRNGFunc drg =
   mkRNGFunc $ \_ctx sz buf -> do
-    bs <- atomically $ C.randomBytes (fromIntegral sz) drg
+    bs <- C.randomBytes (fromIntegral sz) drg
     copyByteArrayToPtr bs buf
 
 type RNGContext = ()

src/Simplex/Messaging/Notifications/Server.hs

@@ -90,7 +90,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do
     runClient :: Transport c => C.APrivateSignKey -> TProxy c -> c -> M ()
     runClient signKey _ h = do
       kh <- asks serverIdentity
-      ks <- atomically . C.generateKeyPair =<< asks random
+      ks <- liftIO . C.generateKeyPair =<< asks random
       NtfServerConfig {ntfServerVRange} <- asks config
       liftIO (runExceptT $ ntfServerHandshake signKey h ks kh ntfServerVRange) >>= \case
         Right th -> runNtfClientTransport th
@@ -439,7 +439,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
       NtfReqNew corrId (ANE SToken newTkn@(NewNtfTkn token _ dhPubKey)) -> do
         logDebug "TNEW - new token"
         st <- asks store
-        ks@(srvDhPubKey, srvDhPrivKey) <- atomically . C.generateKeyPair =<< asks random
+        ks@(srvDhPubKey, srvDhPrivKey) <- liftIO . C.generateKeyPair =<< asks random
         let dhSecret = C.dh' dhPubKey srvDhPrivKey
         tknId <- getId
         regCode <- getRegCode
@@ -568,7 +568,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
     getRegCode :: M NtfRegCode
     getRegCode = NtfRegCode <$> (randomBytes =<< asks (regCodeBytes . config))
     randomBytes :: Int -> M ByteString
-    randomBytes n = atomically . C.randomBytes n =<< asks random
+    randomBytes n = liftIO . C.randomBytes n =<< asks random
     cancelInvervalNotifications :: NtfTokenId -> M ()
     cancelInvervalNotifications tknId =
       atomically (TM.lookupDelete tknId intervalNotifiers)

src/Simplex/Messaging/Notifications/Server/Env.hs

@@ -11,6 +11,7 @@ import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
 import Control.Logger.Simple
 import Crypto.Random
+import Data.IORef (IORef)
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Time.Clock (getCurrentTime)
@@ -76,7 +77,7 @@ data NtfEnv = NtfEnv
     pushServer :: NtfPushServer,
     store :: NtfStore,
     storeLog :: Maybe (StoreLog 'WriteMode),
-    random :: TVar ChaChaDRG,
+    random :: IORef ChaChaDRG,
     tlsServerParams :: T.ServerParams,
     serverIdentity :: C.KeyHash,
     serverStats :: NtfServerStats
@@ -102,7 +103,7 @@ data NtfSubscriber = NtfSubscriber
     smpAgent :: SMPClientAgent
   }
 
-newNtfSubscriber :: Natural -> SMPClientAgentConfig -> TVar ChaChaDRG -> IO NtfSubscriber
+newNtfSubscriber :: Natural -> SMPClientAgentConfig -> IORef ChaChaDRG -> IO NtfSubscriber
 newNtfSubscriber qSize smpAgentCfg random = do
   smpSubscribers <- TM.emptyIO
   newSubQ <- newTBQueueIO qSize

src/Simplex/Messaging/Notifications/Server/Push/APNS.hs

@@ -33,6 +33,7 @@ import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Builder (lazyByteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.IORef (IORef)
 import Data.Int (Int64)
 import Data.Map.Strict (Map)
 import Data.Maybe (isNothing)
@@ -221,7 +222,7 @@ data APNSPushClient = APNSPushClient
     privateKey :: EC.PrivateKey,
     jwtHeader :: JWTHeader,
     jwtToken :: TVar (JWTToken, SignedJWTToken),
-    nonceDrg :: TVar ChaChaDRG,
+    nonceDrg :: IORef ChaChaDRG,
     apnsHost :: HostName,
     apnsCfg :: APNSPushClientConfig
   }
@@ -339,7 +340,7 @@ $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 apnsPushProviderClient :: APNSPushClient -> PushProviderClient
 apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {token = DeviceToken _ tknStr} pn = do
   http2 <- liftHTTPS2 $ getApnsHTTP2Client c
-  nonce <- atomically $ C.randomCbNonce nonceDrg
+  nonce <- liftIO $ C.randomCbNonce nonceDrg
   apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
   req <- liftIO $ apnsRequest c tknStr apnsNtf
   -- TODO when HTTP2 client is thread-safe, we can use sendRequestDirect

src/Simplex/Messaging/Server.hs

@@ -44,7 +44,6 @@ import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Control.Monad.Trans.Except
-import Crypto.Random
 import Control.Monad.STM (retry)
 import Data.Bifunctor (first)
 import Data.ByteString.Base64 (encode)
@@ -392,7 +391,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
     runClient :: Transport c => C.APrivateSignKey -> TProxy c -> c -> M ()
     runClient signKey tp h = do
       kh <- asks serverIdentity
-      ks <- atomically . C.generateKeyPair =<< asks random
+      ks <- liftIO . C.generateKeyPair =<< asks random
       ServerConfig {smpServerVRange, smpHandshakeTimeout} <- asks config
       labelMyThread $ "smp handshake for " <> transportName tp
       liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake signKey h ks kh smpServerVRange) >>= \case
@@ -1017,7 +1016,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
       where
         createQueue :: QueueStore -> RcvPublicAuthKey -> RcvPublicDhKey -> SubscriptionMode -> SenderCanSecure -> M (Transmission BrokerMsg)
         createQueue st recipientKey dhKey subMode sndSecure = time "NEW" $ do
-          (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
+          (rcvPublicDhKey, privDhKey) <- liftIO . C.generateKeyPair =<< asks random
           let rcvDhSecret = C.dh' dhKey privDhKey
               qik (rcvId, sndId) = QIK {rcvId, sndId, rcvPublicDhKey, sndSecure}
               qRec (recipientId, senderId) =
@@ -1074,7 +1073,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
 
         addQueueNotifier_ :: QueueStore -> NtfPublicAuthKey -> RcvNtfPublicDhKey -> M (Transmission BrokerMsg)
         addQueueNotifier_ st notifierKey dhKey = time "NKEY" $ do
-          (rcvPublicDhKey, privDhKey) <- atomically . C.generateKeyPair =<< asks random
+          (rcvPublicDhKey, privDhKey) <- liftIO . C.generateKeyPair =<< asks random
           let rcvNtfDhSecret = C.dh' dhKey privDhKey
           (corrId,entId,) <$> addNotifierRetry 3 rcvPublicDhKey rcvNtfDhSecret
           where
@@ -1255,15 +1254,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                         Just (msg, wasEmpty) -> time "SEND ok" $ do
                           when wasEmpty $ tryDeliverMessage msg
                           when (notification msgFlags) $ do
-                            forM_ (notifier qr) $ \ntf -> do
-                              asks random >>= atomically . trySendNotification ntf msg >>= \case
-                                Nothing -> do
-                                  incStat $ msgNtfNoSub stats
-                                  logWarn "No notification subscription"
-                                Just False -> do
-                                  incStat $ msgNtfLost stats
-                                  logWarn "Dropped message notification"
-                                Just True -> incStat $ msgNtfs stats
+                            mapM_ (`trySendNotification` msg) (notifier qr)
                             incStat $ msgSentNtf stats
                             liftIO $ updatePeriodStats (activeQueuesNtf stats) (recipientId qr)
                           incStat $ msgSent stats
@@ -1335,23 +1326,35 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi
                               deliver q s
                               writeTVar st NoSub
 
-            trySendNotification :: NtfCreds -> Message -> TVar ChaChaDRG -> STM (Maybe Bool)
-            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg ntfNonceDrg =
-              mapM (writeNtf notifierId msg rcvNtfDhSecret ntfNonceDrg) =<< TM.lookup notifierId notifiers
+            trySendNotification :: NtfCreds -> Message -> M ()
+            trySendNotification NtfCreds {notifierId, rcvNtfDhSecret} msg = do
+              stats <- asks serverStats
+              liftIO (TM.lookupIO notifierId notifiers) >>= \case
+                Nothing -> do
+                  incStat $ msgNtfNoSub stats
+                  logWarn "No notification subscription"
+                Just ntfClnt -> do
+                  let updateStats True = incStat $ msgNtfs stats
+                      updateStats _ = do
+                        incStat $ msgNtfLost stats
+                        logWarn "Dropped message notification"
+                  writeNtf notifierId msg rcvNtfDhSecret ntfClnt >>= mapM_ updateStats
 
-            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> TVar ChaChaDRG -> Client -> STM Bool
-            writeNtf nId msg rcvNtfDhSecret ntfNonceDrg Client {sndQ = q} =
-              ifM (isFullTBQueue q) (pure False) (sendNtf $> True)
-              where
-                sendNtf = case msg of
-                  Message {msgId, msgTs} -> do
-                    (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg
-                    writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)]
-                  _ -> pure ()
+            writeNtf :: NotifierId -> Message -> RcvNtfDhSecret -> Client -> M (Maybe Bool)
+            writeNtf nId msg rcvNtfDhSecret Client {sndQ = q} = case msg of
+              Message {msgId, msgTs} -> Just <$> do
+                (nmsgNonce, encNMsgMeta) <- mkMessageNotification msgId msgTs rcvNtfDhSecret
+                -- must be in one STM transaction to avoid the queue becoming full between the check and writing
+                atomically $
+                  ifM
+                    (isFullTBQueue q)
+                    (pure $ False)
+                    (True <$ writeTBQueue q [(CorrId "", nId, NMSG nmsgNonce encNMsgMeta)])
+              _ -> pure Nothing
 
-            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> TVar ChaChaDRG -> STM (C.CbNonce, EncNMsgMeta)
-            mkMessageNotification msgId msgTs rcvNtfDhSecret ntfNonceDrg = do
-              cbNonce <- C.randomCbNonce ntfNonceDrg
+            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M (C.CbNonce, EncNMsgMeta)
+            mkMessageNotification msgId msgTs rcvNtfDhSecret = do
+              cbNonce <- liftIO . C.randomCbNonce =<< asks random
               let msgMeta = NMsgMeta {msgId, msgTs}
                   encNMsgMeta = C.cbEncrypt rcvNtfDhSecret cbNonce (smpEncode msgMeta) 128
               pure . (cbNonce,) $ fromRight "" encNMsgMeta
@@ -1518,7 +1521,7 @@ timed name qId a = do
     sec = 1000_000000
 
 randomId :: Int -> M ByteString
-randomId n = atomically . C.randomBytes n =<< asks random
+randomId n = liftIO . C.randomBytes n =<< asks random
 
 saveServerMessages :: Bool -> M ()
 saveServerMessages keepMsgs = asks (storeMsgsFile . config) >>= mapM_ saveMessages

src/Simplex/Messaging/Server/Env/STM.hs

@@ -124,7 +124,7 @@ data Env = Env
     serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
-    random :: TVar ChaChaDRG,
+    random :: IORef ChaChaDRG,
     storeLog :: Maybe (StoreLog 'WriteMode),
     tlsServerParams :: T.ServerParams,
     serverStats :: ServerStats,
@@ -267,7 +267,7 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile,
           | isJust (storeMsgsFile config) = SPMMessages
           | otherwise = SPMQueues
 
-newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
+newSMPProxyAgent :: SMPClientAgentConfig -> IORef ChaChaDRG -> IO ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do
   smpAgent <- newSMPClientAgent smpAgentCfg random
   pure ProxyAgent {smpAgent}

src/Simplex/Messaging/Server/Main.hs

@@ -11,7 +11,6 @@
 
 module Simplex.Messaging.Server.Main where
 
-import Control.Concurrent.STM
 import Control.Logger.Simple
 import Control.Monad (void, when, (<$!>))
 import Data.ByteString.Char8 (ByteString)
@@ -135,7 +134,7 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
           where
             createServerPassword = \case
               ServerPassword s -> pure s
-              SPRandom -> BasicAuth . strEncode <$> (atomically . C.randomBytes 32 =<< C.newRandom)
+              SPRandom -> BasicAuth . strEncode <$> (C.randomBytes 32 =<< C.newRandom)
             iniFileContent host basicAuth sourceCode' =
               informationIniContent sourceCode'
                 <> "[STORE_LOG]\n\

src/Simplex/Messaging/Transport/Credentials.hs

@@ -9,11 +9,11 @@ module Simplex.Messaging.Transport.Credentials
   )
 where
 
-import Control.Concurrent.STM
 import Crypto.Random (ChaChaDRG)
 import Data.ASN1.Types (getObjectID)
 import Data.ASN1.Types.String (ASN1StringEncoding (UTF8))
 import Data.Hourglass (Hours (..), timeAdd)
+import Data.IORef
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Text (Text)
@@ -47,9 +47,9 @@ privateToTls (C.APrivateSignKey _ k) = case k of
 
 type Credentials = (C.ASignatureKeyPair, X509.SignedCertificate)
 
-genCredentials :: TVar ChaChaDRG -> Maybe Credentials -> (Hours, Hours) -> Text -> IO Credentials
+genCredentials :: IORef ChaChaDRG -> Maybe Credentials -> (Hours, Hours) -> Text -> IO Credentials
 genCredentials g parent (before, after) subjectName = do
-  subjectKeys <- atomically $ C.generateSignatureKeyPair C.SEd25519 g
+  subjectKeys <- C.generateSignatureKeyPair C.SEd25519 g
   let (issuerKeys, issuer) = case parent of
         Nothing -> (subjectKeys, subject) -- self-signed
         Just (keys, cert) -> (keys, X509.certSubjectDN . X509.signedObject $ X509.getSigned cert)

src/Simplex/Messaging/Util.hs

@@ -23,6 +23,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
 import Data.Time (NominalDiffTime)
+import Data.Tuple (swap)
 import GHC.Conc (labelThread, myThreadId, threadDelay)
 import UnliftIO hiding (atomicModifyIORef')
 import qualified UnliftIO.Exception as UE
@@ -177,6 +178,11 @@ labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
 
 atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO ()
 atomicModifyIORef'_ r f = atomicModifyIORef' r $ \v -> (f v, ())
+{-# INLINE atomicModifyIORef'_ #-}
+
+atomicStateIORef :: IORef s -> (s -> (a, s)) -> IO a
+atomicStateIORef r f = atomicModifyIORef' r $ swap . f
+{-# INLINE atomicStateIORef #-}
 
 encodeJSON :: ToJSON a => a -> Text
 encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode

src/Simplex/RemoteControl/Client.hs

@@ -78,10 +78,10 @@ helloBlockSize = 12288
 encInvitationSize :: Int
 encInvitationSize = 900
 
-newRCHostPairing :: TVar ChaChaDRG -> IO RCHostPairing
+newRCHostPairing :: IORef ChaChaDRG -> IO RCHostPairing
 newRCHostPairing drg = do
   ((_, caKey), caCert) <- genCredentials drg Nothing (-25, 24 * 999999) "ca"
-  (_, idPrivKey) <- atomically $ C.generateKeyPair drg
+  (_, idPrivKey) <- C.generateKeyPair drg
   pure RCHostPairing {caKey, caCert, idPrivKey, knownHost = Nothing}
 
 data RCHostClient = RCHostClient
@@ -98,12 +98,12 @@ data RCHClient_ = RCHClient_
 
 type RCHostConnection = (NonEmpty RCCtrlAddress, RCSignedInvitation, RCHostClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)))
 
-connectRCHost :: TVar ChaChaDRG -> RCHostPairing -> J.Value -> Bool -> Maybe RCCtrlAddress -> Maybe Word16 -> ExceptT RCErrorType IO RCHostConnection
+connectRCHost :: IORef ChaChaDRG -> RCHostPairing -> J.Value -> Bool -> Maybe RCCtrlAddress -> Maybe Word16 -> ExceptT RCErrorType IO RCHostConnection
 connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ctrlAppInfo multicast rcAddrPrefs_ port_ = do
   r <- newEmptyTMVarIO
   found@(RCCtrlAddress {address} :| _) <- findCtrlAddress
   c@RCHClient_ {startedPort, announcer} <- liftIO mkClient
-  hostKeys <- atomically genHostKeys
+  hostKeys <- liftIO genHostKeys
   action <- liftIO $ runClient c r hostKeys
   -- wait for the port to make invitation
   portNum <- atomically $ readTMVar startedPort
@@ -163,7 +163,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
               _ ->
                 pure $ TLS.CertificateUsageReject TLS.CertificateRejectUnknownCA
         }
-    genHostKeys :: STM RCHostKeys
+    genHostKeys :: IO RCHostKeys
     genHostKeys = do
       sessKeys <- C.generateKeyPair drg
       dhKeys <- C.generateKeyPair drg
@@ -185,7 +185,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
               }
       pure $ signInvitation (snd sessKeys) idPrivKey inv
 
-genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credentials
+genTLSCredentials :: IORef ChaChaDRG -> C.APrivateSignKey -> C.SignedCertificate -> IO TLS.Credentials
 genTLSCredentials drg caKey caCert = do
   let caCreds = (C.signatureKeyPair caKey, caCert)
   leaf <- genCredentials drg (Just caCreds) (0, 24 * 999999) "localhost" -- session-signing cert
@@ -202,7 +202,7 @@ cancelHostClient RCHostClient {action, client_ = RCHClient_ {announcer, endSessi
   atomically (tryTakeTMVar announcer) >>= mapM_ uninterruptibleCancel
   uninterruptibleCancel action
 
-prepareHostSession :: TVar ChaChaDRG -> C.KeyHash -> RCHostPairing -> RCHostKeys -> RCHostEncHello -> ExceptT RCErrorType IO (RCCtrlEncHello, HostSessKeys, RCHostHello, RCHostPairing)
+prepareHostSession :: IORef ChaChaDRG -> C.KeyHash -> RCHostPairing -> RCHostKeys -> RCHostEncHello -> ExceptT RCErrorType IO (RCCtrlEncHello, HostSessKeys, RCHostHello, RCHostPairing)
 prepareHostSession
   drg
   tlsHostFingerprint
@@ -220,7 +220,7 @@ prepareHostSession
     knownHost' <- updateKnownHost ca dhPubKey
     let ctrlHello = RCCtrlHello {}
     -- TODO send error response if something fails
-    nonce' <- liftIO . atomically $ C.randomCbNonce drg
+    nonce' <- liftIO $ C.randomCbNonce drg
     encBody' <- liftEitherWith (const RCEBlockSize) $ kcbEncrypt hybridKey nonce' (LB.toStrict $ J.encode ctrlHello) helloBlockSize
     let ctrlEncHello = RCCtrlEncHello {kem = kemCiphertext, nonce = nonce', encBody = encBody'}
     pure (ctrlEncHello, keys, hostHello, pairing {knownHost = Just knownHost'})
@@ -246,7 +246,7 @@ data RCCClient_ = RCCClient_
 type RCCtrlConnection = (RCCtrlClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)))
 
 -- app should determine whether it is a new or known pairing based on CA fingerprint in the invitation
-connectRCCtrl :: TVar ChaChaDRG -> RCVerifiedInvitation -> Maybe RCCtrlPairing -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
+connectRCCtrl :: IORef ChaChaDRG -> RCVerifiedInvitation -> Maybe RCCtrlPairing -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
 connectRCCtrl drg (RCVerifiedInvitation inv@RCInvitation {ca, idkey}) pairing_ hostAppInfo = do
   pairing' <- maybe (liftIO newCtrlPairing) updateCtrlPairing pairing_
   connectRCCtrl_ drg pairing' inv hostAppInfo
@@ -254,15 +254,15 @@ connectRCCtrl drg (RCVerifiedInvitation inv@RCInvitation {ca, idkey}) pairing_ h
     newCtrlPairing :: IO RCCtrlPairing
     newCtrlPairing = do
       ((_, caKey), caCert) <- genCredentials drg Nothing (0, 24 * 999999) "ca"
-      (_, dhPrivKey) <- atomically $ C.generateKeyPair drg
+      (_, dhPrivKey) <- liftIO $ C.generateKeyPair drg
       pure RCCtrlPairing {caKey, caCert, ctrlFingerprint = ca, idPubKey = idkey, dhPrivKey, prevDhPrivKey = Nothing}
     updateCtrlPairing :: RCCtrlPairing -> ExceptT RCErrorType IO RCCtrlPairing
     updateCtrlPairing pairing@RCCtrlPairing {ctrlFingerprint, idPubKey, dhPrivKey = currDhPrivKey} = do
       unless (ca == ctrlFingerprint && idPubKey == idkey) $ throwE RCEIdentity
-      (_, dhPrivKey) <- atomically $ C.generateKeyPair drg
+      (_, dhPrivKey) <- liftIO $ C.generateKeyPair drg
       pure pairing {dhPrivKey, prevDhPrivKey = Just currDhPrivKey}
 
-connectRCCtrl_ :: TVar ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
+connectRCCtrl_ :: IORef ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO RCCtrlConnection
 connectRCCtrl_ drg pairing'@RCCtrlPairing {caKey, caCert} inv@RCInvitation {ca, host, port} hostAppInfo = do
   r <- newEmptyTMVarIO
   c <- liftIO mkClient
@@ -324,7 +324,7 @@ receiveRCPacket tls = do
   b' <- liftEitherWith (const RCEBlockSize) $ C.unPad b
   liftEitherWith RCESyntax $ smpDecode b'
 
-prepareHostHello :: TVar ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO (C.DhSecretX25519, KEMSecretKey, RCHostEncHello)
+prepareHostHello :: IORef ChaChaDRG -> RCCtrlPairing -> RCInvitation -> J.Value -> ExceptT RCErrorType IO (C.DhSecretX25519, KEMSecretKey, RCHostEncHello)
 prepareHostHello
   drg
   RCCtrlPairing {caCert, dhPrivKey}
@@ -334,7 +334,7 @@ prepareHostHello
     case compatibleVersion v supportedRCPVRange of
       Nothing -> throwE RCEVersion
       Just (Compatible v') -> do
-        nonce <- liftIO . atomically $ C.randomCbNonce drg
+        nonce <- liftIO . liftIO $ C.randomCbNonce drg
         (kemPubKey, kemPrivKey) <- liftIO $ sntrup761Keypair drg
         let helloBody = RCHostHello {v = v', ca = certFingerprint caCert, app = hostAppInfo, kem = kemPubKey}
             sharedKey = C.dh' dhPubKey dhPrivKey
@@ -362,11 +362,11 @@ prepareCtrlSession
 
 -- * Multicast discovery
 
-announceRC :: TVar ChaChaDRG -> Int -> C.PrivateKeyEd25519 -> C.PublicKeyX25519 -> RCHostKeys -> RCInvitation -> ExceptT RCErrorType IO ()
+announceRC :: IORef ChaChaDRG -> Int -> C.PrivateKeyEd25519 -> C.PublicKeyX25519 -> RCHostKeys -> RCInvitation -> ExceptT RCErrorType IO ()
 announceRC drg maxCount idPrivKey knownDhPub RCHostKeys {sessKeys, dhKeys} inv = ExceptT $ withSender $ \sender -> runExceptT $ do
   replicateM_ maxCount $ do
     logDebug "Announcing..."
-    nonce <- atomically $ C.randomCbNonce drg
+    nonce <- liftIO $ C.randomCbNonce drg
     encInvitation <- liftEitherWith (const RCEEncrypt) $ C.cbEncrypt sharedKey nonce sigInvitation encInvitationSize
     liftIO . UDP.send sender $ smpEncode RCEncInvitation {dhPubKey, nonce, encInvitation}
     threadDelay 1000000
@@ -426,9 +426,9 @@ cancelCtrlClient RCCtrlClient {action, client_ = RCCClient_ {endSession}} = do
 
 -- * Session encryption
 
-rcEncryptBody :: TVar ChaChaDRG -> KEMHybridSecret -> LazyByteString -> ExceptT RCErrorType IO (C.CbNonce, LazyByteString)
+rcEncryptBody :: IORef ChaChaDRG -> KEMHybridSecret -> LazyByteString -> ExceptT RCErrorType IO (C.CbNonce, LazyByteString)
 rcEncryptBody drg hybridKey s = do
-  nonce <- atomically $ C.randomCbNonce drg
+  nonce <- liftIO $ C.randomCbNonce drg
   let len = LB.length s
   ct <- liftEitherWith (const RCEEncrypt) $ LC.kcbEncryptTailTag hybridKey nonce s len (len + 8)
   pure (nonce, ct)

tests/AgentTests/DoubleRatchetTests.hs

@@ -22,6 +22,7 @@ import Data.Aeson (FromJSON, ToJSON, (.=))
 import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.IORef (IORef)
 import qualified Data.Map.Strict as M
 import Data.Type.Equality
 import Simplex.Messaging.Crypto (Algorithm (..), AlgorithmI, CryptoError, DhAlgorithm)
@@ -99,7 +100,7 @@ fullMsgLen Ratchet {rcSupportKEM, rcVersion} = headerLenLength + fullHeaderLen v
 
 testMessageHeader :: forall a. AlgorithmI a => VersionE2E -> C.SAlgorithm a -> Expectation
 testMessageHeader v _ = do
-  (k, _) <- atomically . C.generateKeyPair @a =<< C.newRandom
+  (k, _) <- C.generateKeyPair @a =<< C.newRandom
   let hdr = MsgHeader {msgMaxVersion = v, msgDHRs = k, msgKEM = Nothing, msgPN = 0, msgNs = 0}
   parseAll (msgHeaderP v) (encodeMsgHeader v hdr) `shouldBe` Right hdr
 
@@ -117,7 +118,7 @@ testKEMParams = do
 testMessageHeaderKEM :: forall a. AlgorithmI a => C.SAlgorithm a -> Expectation
 testMessageHeaderKEM _ = do
   g <- C.newRandom
-  (k, _) <- atomically $ C.generateKeyPair @a g
+  (k, _) <- C.generateKeyPair @a g
   (kem, _) <- sntrup761Keypair g
   let msgMaxVersion = max pqRatchetE2EEncryptVersion currentE2EEncryptVersion
       msgKEM = Just . ARKP SRKSProposed $ RKParamsProposed kem
@@ -132,15 +133,15 @@ testMessageHeaderKEM _ = do
 pattern Decrypted :: ByteString -> Either CryptoError (Either CryptoError ByteString)
 pattern Decrypted msg <- Right (Right msg)
 
-type Encrypt a = TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError ByteString)
+type Encrypt a = TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError ByteString)
 
-type Decrypt a = TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString))
+type Decrypt a = TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString))
 
-type EncryptDecryptSpec a = (TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys), ByteString) -> TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> Expectation
+type EncryptDecryptSpec a = (TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys), ByteString) -> TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> Expectation
 
 type TestRatchets a =
-  TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) ->
-  TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) ->
+  TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) ->
+  TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) ->
   Encrypt a ->
   Decrypt a ->
   EncryptDecryptSpec a ->
@@ -167,7 +168,7 @@ instance Eq ARKEMParams where
 
 deriving instance Eq (MsgHeader a)
 
-initRatchetKEM :: (AlgorithmI a, DhAlgorithm a) => TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> IO ()
+initRatchetKEM :: (AlgorithmI a, DhAlgorithm a) => TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> IO ()
 initRatchetKEM s r = encryptDecrypt (Just $ PQEncOn) (const ()) (const ()) (s, "initialising ratchet") r
 
 testEncryptDecrypt :: (AlgorithmI a, DhAlgorithm a) => Bool -> TestRatchets a
@@ -338,7 +339,7 @@ testEnableKEMStrict alice bob _ _ _ = do
 
 testKeyJSON :: forall a. AlgorithmI a => C.SAlgorithm a -> IO ()
 testKeyJSON _ = do
-  (k, pk) <- atomically . C.generateKeyPair @a =<< C.newRandom
+  (k, pk) <- C.generateKeyPair @a =<< C.newRandom
   testEncodeDecode k
   testEncodeDecode pk
 
@@ -519,7 +520,7 @@ initRatchets = do
   (pkAlice1, pkAlice2, _pKem@Nothing, e2eAlice) <- liftIO $ generateRcvE2EParams g v PQSupportOff
   Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 Nothing e2eAlice
   Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
-  (_, pkBob3) <- atomically $ C.generateKeyPair g
+  (_, pkBob3) <- C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
       alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOff
@@ -536,7 +537,7 @@ initRatchetsKEMProposed = do
   (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
   Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
   Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 Nothing e2eBob
-  (_, pkBob3) <- atomically $ C.generateKeyPair g
+  (_, pkBob3) <- C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
       alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn
@@ -554,7 +555,7 @@ initRatchetsKEMAccepted = do
   (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
   Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
   Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob
-  (_, pkBob3) <- atomically $ C.generateKeyPair g
+  (_, pkBob3) <- C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
       alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn
@@ -571,7 +572,7 @@ initRatchetsKEMProposedAgain = do
   (pkBob1, pkBob2, pKemParams_@(Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams g v (Just useKem)
   Right paramsBob <- pure $ pqX3dhSnd pkBob1 pkBob2 pKemParams_ e2eAlice
   Right paramsAlice <- runExceptT $ pqX3dhRcv pkAlice1 pkAlice2 pKem_ e2eBob
-  (_, pkBob3) <- atomically $ C.generateKeyPair g
+  (_, pkBob3) <- C.generateKeyPair g
   let vs = testRatchetVersions
       bob = initSndRatchet vs (C.publicKey pkAlice2) pkBob3 paramsBob
       alice = initRcvRatchet vs pkAlice2 paramsAlice PQSupportOn
@@ -582,7 +583,7 @@ testRatchetVersions =
   let v = maxVersion supportedE2EEncryptVRange
    in RatchetVersions v v
 
-encrypt_ :: AlgorithmI a => Maybe PQEncryption -> (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (ByteString, Ratchet a, SkippedMsgDiff))
+encrypt_ :: AlgorithmI a => Maybe PQEncryption -> (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (ByteString, Ratchet a, SkippedMsgDiff))
 encrypt_ pqEnc_ (_, rc, _) msg =
   -- print msg >>
   runExceptT (rcEncrypt rc paddedMsgLen msg pqEnc_ currentE2EEncryptVersion)
@@ -592,7 +593,7 @@ encrypt_ pqEnc_ (_, rc, _) msg =
       B.length msg' `shouldBe` fullMsgLen rc'
       pure $ Right (msg', rc', SMDNoChange)
 
-decrypt_ :: (AlgorithmI a, DhAlgorithm a) => (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff))
+decrypt_ :: (AlgorithmI a, DhAlgorithm a) => (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either CryptoError (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff))
 decrypt_ (g, rc, smks) msg = runExceptT $ rcDecrypt g rc smks msg
 
 encrypt' :: AlgorithmI a => (Ratchet a -> ()) -> Encrypt a
@@ -619,9 +620,9 @@ hasRcvKEM _ = error "rcv ratchet has no KEM"
 
 withTVar ::
   AlgorithmI a =>
-  ((TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either e (r, Ratchet a, SkippedMsgDiff))) ->
+  ((IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) -> ByteString -> IO (Either e (r, Ratchet a, SkippedMsgDiff))) ->
   (Ratchet a -> ()) ->
-  TVar (TVar ChaChaDRG, Ratchet a, SkippedMsgKeys) ->
+  TVar (IORef ChaChaDRG, Ratchet a, SkippedMsgKeys) ->
   ByteString ->
   IO (Either e r)
 withTVar op valid rcVar msg = do

tests/AgentTests/FunctionalAPITests.hs

@@ -718,7 +718,7 @@ testEnablePQEncryption =
     (a, 2, "msg 1") \#>\ b
     (b, 3, "msg 2") \#>\ a
     -- 45 bytes is used by agent message envelope inside double ratchet message envelope
-    let largeMsg g' pqEnc = atomically $ C.randomBytes (e2eEncAgentMsgLength pqdrSMPAgentVersion pqEnc - 45) g'
+    let largeMsg g' pqEnc = liftIO $ C.randomBytes (e2eEncAgentMsgLength pqdrSMPAgentVersion pqEnc - 45) g'
     lrg <- largeMsg g PQSupportOff
     (a, 4, lrg) \#>\ b
     (b, 5, lrg) \#>\ a

tests/AgentTests/SQLiteTests.hs

@@ -18,13 +18,13 @@ module AgentTests.SQLiteTests (storeTests) where
 import AgentTests.EqInstances ()
 import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.MVar
-import Control.Concurrent.STM
 import Control.Exception (SomeException)
 import Control.Monad (replicateM_)
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import Data.ByteArray (ScrubbedBytes)
 import Data.ByteString.Char8 (ByteString)
+import Data.IORef (IORef)
 import Data.List (isInfixOf)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -254,7 +254,7 @@ sndQueue1 =
       smpClientVersion = VersionSMPC 1
     }
 
-createRcvConn :: DB.Connection -> TVar ChaChaDRG -> ConnData -> NewRcvQueue -> SConnectionMode c -> IO (Either StoreError (ConnId, RcvQueue))
+createRcvConn :: DB.Connection -> IORef ChaChaDRG -> ConnData -> NewRcvQueue -> SConnectionMode c -> IO (Either StoreError (ConnId, RcvQueue))
 createRcvConn db g cData rq cMode = runExceptT $ do
   connId <- ExceptT $ createNewConn db g cData cMode
   rq' <- ExceptT $ updateNewConnRcv db connId rq

tests/CoreTests/BatchingTests.hs

@@ -8,11 +8,11 @@
 
 module CoreTests.BatchingTests (batchingTests) where
 
-import Control.Concurrent.STM
 import Control.Monad
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
+import Data.IORef (IORef)
 import qualified Data.List.NonEmpty as L
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
@@ -47,7 +47,7 @@ batchingTests = do
 
 testBatchSubscriptions :: IO ()
 testBatchSubscriptions = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  sessId <- C.randomBytes 32 =<< C.newRandom
   subs <- replicateM 250 $ randomSUB sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
@@ -60,7 +60,7 @@ testBatchSubscriptions = do
 
 testBatchSubscriptionsV7 :: IO ()
 testBatchSubscriptionsV7 = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  sessId <- C.randomBytes 32 =<< C.newRandom
   subs <- replicateM 300 $ randomSUBv7 sessId
   let batches1 = batchTransmissions False smpBlockSize $ L.fromList subs
   all lenOk1 batches1 `shouldBe` True
@@ -73,7 +73,7 @@ testBatchSubscriptionsV7 = do
 
 testBatchWithMessage :: IO ()
 testBatchWithMessage = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  sessId <- C.randomBytes 32 =<< C.newRandom
   subs1 <- replicateM 60 $ randomSUB sessId
   send <- randomSEND sessId 8000
   subs2 <- replicateM 40 $ randomSUB sessId
@@ -89,7 +89,7 @@ testBatchWithMessage = do
 
 testBatchWithMessageV7 :: IO ()
 testBatchWithMessageV7 = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  sessId <- C.randomBytes 32 =<< C.newRandom
   subs1 <- replicateM 60 $ randomSUBv7 sessId
   send <- randomSENDv7 sessId 8000
   subs2 <- replicateM 40 $ randomSUBv7 sessId
@@ -105,7 +105,7 @@ testBatchWithMessageV7 = do
 
 testBatchWithLargeMessage :: IO ()
 testBatchWithLargeMessage = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  sessId <- C.randomBytes 32 =<< C.newRandom
   subs1 <- replicateM 50 $ randomSUB sessId
   send <- randomSEND sessId 17000
   subs2 <- replicateM 150 $ randomSUB sessId
@@ -124,7 +124,7 @@ testBatchWithLargeMessage = do
 
 testBatchWithLargeMessageV7 :: IO ()
 testBatchWithLargeMessageV7 = do
-  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  sessId <- C.randomBytes 32 =<< C.newRandom
   subs1 <- replicateM 60 $ randomSUBv7 sessId
   send <- randomSENDv7 sessId 17000
   subs2 <- replicateM 150 $ randomSUBv7 sessId
@@ -276,14 +276,14 @@ testClientBatchWithLargeMessageV7 = do
 testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStub = do
   g <- C.newRandom
-  sessId <- atomically $ C.randomBytes 32 g
+  sessId <- C.randomBytes 32 g
   smpClientStub g sessId subModeSMPVersion Nothing
 
 clientStubV7 :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 clientStubV7 = do
   g <- C.newRandom
-  sessId <- atomically $ C.randomBytes 32 g
-  (rKey, _) <- atomically $ C.generateAuthKeyPair C.SX25519 g
+  sessId <- C.randomBytes 32 g
+  (rKey, _) <- C.generateAuthKeyPair C.SX25519 g
   thAuth_ <- testTHandleAuth authCmdsSMPVersion g rKey
   smpClientStub g sessId authCmdsSMPVersion thAuth_
 
@@ -296,9 +296,9 @@ randomSUBv7 = randomSUB_ C.SEd25519 authCmdsSMPVersion
 randomSUB_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSUB_ a v sessId = do
   g <- C.newRandom
-  rId <- atomically $ C.randomBytes 24 g
-  nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
-  (rKey, rpKey) <- atomically $ C.generateAuthKeyPair a g
+  rId <- C.randomBytes 24 g
+  nonce@(C.CbNonce corrId) <- C.randomCbNonce g
+  (rKey, rpKey) <- C.generateAuthKeyPair a g
   thAuth_ <- testTHandleAuth v g rKey
   let thParams = testTHandleParams v sessId
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, rId, Cmd SRecipient SUB)
@@ -313,14 +313,14 @@ randomSUBCmdV7 = randomSUBCmd_ C.SEd25519 -- same as v6
 randomSUBCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
 randomSUBCmd_ a c = do
   g <- C.newRandom
-  rId <- atomically $ C.randomBytes 24 g
-  (_, rpKey) <- atomically $ C.generateAuthKeyPair a g
+  rId <- C.randomBytes 24 g
+  (_, rpKey) <- C.generateAuthKeyPair a g
   mkTransmission c (Just rpKey, rId, Cmd SRecipient SUB)
 
 randomENDCmd :: IO (Transmission BrokerMsg)
 randomENDCmd = do
   g <- C.newRandom
-  rId <- atomically $ C.randomBytes 24 g
+  rId <- C.randomBytes 24 g
   pure (CorrId "", rId, END)
 
 randomSEND :: ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
@@ -332,11 +332,11 @@ randomSENDv7 = randomSEND_ C.SX25519 authCmdsSMPVersion
 randomSEND_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> VersionSMP -> ByteString -> Int -> IO (Either TransportError (Maybe TransmissionAuth, ByteString))
 randomSEND_ a v sessId len = do
   g <- C.newRandom
-  sId <- atomically $ C.randomBytes 24 g
-  nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
-  (sKey, spKey) <- atomically $ C.generateAuthKeyPair a g
+  sId <- C.randomBytes 24 g
+  nonce@(C.CbNonce corrId) <- C.randomCbNonce g
+  (sKey, spKey) <- C.generateAuthKeyPair a g
   thAuth_ <- testTHandleAuth v g sKey
-  msg <- atomically $ C.randomBytes len g
+  msg <- C.randomBytes len g
   let thParams = testTHandleParams v sessId
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, sId, Cmd SSender $ SEND noMsgFlags msg)
   pure $ (,tToSend) <$> authTransmission thAuth_ (Just spKey) nonce tForAuth
@@ -353,14 +353,14 @@ testTHandleParams v sessionId =
       batch = True
     }
 
-testTHandleAuth :: VersionSMP -> TVar ChaChaDRG -> C.APublicAuthKey -> IO (Maybe (THandleAuth 'TClient))
+testTHandleAuth :: VersionSMP -> IORef ChaChaDRG -> C.APublicAuthKey -> IO (Maybe (THandleAuth 'TClient))
 testTHandleAuth v g (C.APublicAuthKey a serverPeerPubKey) = case a of
   C.SX25519 | v >= authCmdsSMPVersion -> do
     ca <- head <$> XS.readCertificates "tests/fixtures/ca.crt"
     serverCert <- head <$> XS.readCertificates "tests/fixtures/server.crt"
     serverKey <- head <$> XF.readKeyFile "tests/fixtures/server.key"
     signKey <- either error pure $ C.x509ToPrivate (serverKey, []) >>= C.privKey @C.APrivateSignKey
-    (serverAuthPub, _) <- atomically $ C.generateKeyPair @'C.X25519 g
+    (serverAuthPub, _) <- C.generateKeyPair @'C.X25519 g
     let serverCertKey = (X.CertificateChain [serverCert, ca], C.signX509 signKey $ C.toPubKey C.publicToX509 serverAuthPub)
     pure $ Just THAuthClient {serverPeerPubKey, serverCertKey, sessSecret = Nothing}
   _ -> pure Nothing
@@ -374,9 +374,9 @@ randomSENDCmdV7 = randomSENDCmd_ C.SX25519
 randomSENDCmd_ :: (C.AlgorithmI a, C.AuthAlgorithm a) => C.SAlgorithm a -> ProtocolClient SMPVersion ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
 randomSENDCmd_ a c len = do
   g <- C.newRandom
-  sId <- atomically $ C.randomBytes 24 g
-  (_, rpKey) <- atomically $ C.generateAuthKeyPair a g
-  msg <- atomically $ C.randomBytes len g
+  sId <- C.randomBytes 24 g
+  (_, rpKey) <- C.generateAuthKeyPair a g
+  msg <- C.randomBytes len g
   mkTransmission c (Just rpKey, sId, Cmd SSender $ SEND noMsgFlags msg)
 
 lenOk :: ByteString -> Bool

tests/CoreTests/CryptoFileTests.hs

@@ -3,11 +3,11 @@
 module CoreTests.CryptoFileTests (cryptoFileTests) where
 
 import AgentTests.FunctionalAPITests (runRight_)
-import Control.Concurrent.STM
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString.Lazy as LB
+import Data.IORef (IORef)
 import GHC.IO.IOMode (IOMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), FTCryptoError (..))
@@ -29,8 +29,8 @@ testFilePath = "tests/tmp/testcryptofile"
 testWriteReadFile :: IO ()
 testWriteReadFile = do
   g <- C.newRandom
-  s <- atomically $ LB.fromStrict <$> C.randomBytes 100000 g
-  file <- atomically $ mkCryptoFile g
+  s <- LB.fromStrict <$> C.randomBytes 100000 g
+  file <- mkCryptoFile g
   runRight_ $ do
     CF.writeFile file s
     liftIO $ CF.getFileContentsSize file `shouldReturn` 100000
@@ -41,9 +41,9 @@ testWriteReadFile = do
 testPutGetFile :: IO ()
 testPutGetFile = do
   g <- C.newRandom
-  s <- atomically $ LB.fromStrict <$> C.randomBytes 50000 g
-  s' <- atomically $ LB.fromStrict <$> C.randomBytes 50000 g
-  file <- atomically $ mkCryptoFile g
+  s <- LB.fromStrict <$> C.randomBytes 50000 g
+  s' <- LB.fromStrict <$> C.randomBytes 50000 g
+  file <- mkCryptoFile g
   runRight_ $ do
     CF.withFile file WriteMode $ \h -> liftIO $ do
       CF.hPut h s
@@ -61,8 +61,8 @@ testPutGetFile = do
 testWriteGetFile :: IO ()
 testWriteGetFile = do
   g <- C.newRandom
-  s <- atomically $ LB.fromStrict <$> C.randomBytes 100000 g
-  file <- atomically $ mkCryptoFile g
+  s <- LB.fromStrict <$> C.randomBytes 100000 g
+  file <- mkCryptoFile g
   runRight_ $ do
     CF.writeFile file s
     CF.withFile file ReadMode $ \h -> do
@@ -75,9 +75,9 @@ testWriteGetFile = do
 testPutReadFile :: IO ()
 testPutReadFile = do
   g <- C.newRandom
-  s <- atomically $ LB.fromStrict <$> C.randomBytes 50000 g
-  s' <- atomically $ LB.fromStrict <$> C.randomBytes 50000 g
-  file <- atomically $ mkCryptoFile g
+  s <- LB.fromStrict <$> C.randomBytes 50000 g
+  s' <- LB.fromStrict <$> C.randomBytes 50000 g
+  file <- mkCryptoFile g
   runRight_ $ do
     CF.withFile file WriteMode $ \h -> liftIO $ do
       CF.hPut h s
@@ -94,11 +94,11 @@ testPutReadFile = do
 testSmallFile :: IO ()
 testSmallFile = do
   g <- C.newRandom
-  file <- atomically $ mkCryptoFile g
+  file <- mkCryptoFile g
   LB.writeFile testFilePath ""
   runExceptT (CF.readFile file) `shouldReturn` Left FTCEInvalidFileSize
   LB.writeFile testFilePath "123"
   runExceptT (CF.readFile file) `shouldReturn` Left FTCEInvalidFileSize
 
-mkCryptoFile :: TVar ChaChaDRG -> STM CryptoFile
+mkCryptoFile :: IORef ChaChaDRG -> IO CryptoFile
 mkCryptoFile g = CryptoFile testFilePath . Just <$> CF.randomArgs g

tests/CoreTests/CryptoTests.hs

@@ -5,7 +5,6 @@
 
 module CoreTests.CryptoTests (cryptoTests) where
 
-import Control.Concurrent.STM
 import Control.Monad.Except
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -125,15 +124,15 @@ testPadUnpadFile = do
 testSignature :: (C.AlgorithmI a, C.SignatureAlgorithm a) => C.SAlgorithm a -> Spec
 testSignature alg = it "should sign / verify string" . ioProperty $ do
   g <- C.newRandom
-  (k, pk) <- atomically $ C.generateSignatureKeyPair alg g
+  (k, pk) <- C.generateSignatureKeyPair alg g
   pure $ \s -> let b = encodeUtf8 $ T.pack s in C.verify k (C.sign pk b) b
 
 testDHCryptoBox :: Spec
 testDHCryptoBox = it "should encrypt / decrypt string with asymmetric DH keys" . ioProperty $ do
   g <- C.newRandom
-  (sk, spk) <- atomically $ C.generateKeyPair g
-  (rk, rpk) <- atomically $ C.generateKeyPair g
-  nonce <- atomically $ C.randomCbNonce g
+  (sk, spk) <- C.generateKeyPair g
+  (rk, rpk) <- C.generateKeyPair g
+  nonce <- C.randomCbNonce g
   pure $ \(s, pad) ->
     let b = encodeUtf8 $ T.pack s
         paddedLen = B.length b + abs pad + 2
@@ -144,8 +143,8 @@ testDHCryptoBox = it "should encrypt / decrypt string with asymmetric DH keys" .
 testSecretBox :: Spec
 testSecretBox = it "should encrypt / decrypt string with a random symmetric key" . ioProperty $ do
   g <- C.newRandom
-  k <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  k <- C.randomSbKey g
+  nonce <- C.randomCbNonce g
   pure $ \(s, pad) ->
     let b = encodeUtf8 $ T.pack s
         pad' = min (abs pad) 100000
@@ -157,8 +156,8 @@ testSecretBox = it "should encrypt / decrypt string with a random symmetric key"
 testLazySecretBox :: Spec
 testLazySecretBox = it "should lazily encrypt / decrypt string with a random symmetric key" . ioProperty $ do
   g <- C.newRandom
-  k <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  k <- C.randomSbKey g
+  nonce <- C.randomCbNonce g
   pure $ \(s, pad) ->
     let b = LE.encodeUtf8 $ LT.pack s
         len = LB.length b
@@ -171,8 +170,8 @@ testLazySecretBox = it "should lazily encrypt / decrypt string with a random sym
 testLazySecretBoxFile :: Spec
 testLazySecretBoxFile = it "should lazily encrypt / decrypt file with a random symmetric key" $ do
   g <- C.newRandom
-  k <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  k <- C.randomSbKey g
+  nonce <- C.randomCbNonce g
   let f = "tests/tmp/testsecretbox"
       paddedLen = 4 * 1024 * 1024
       len = 4 * 1000 * 1000 :: Int64
@@ -185,8 +184,8 @@ testLazySecretBoxFile = it "should lazily encrypt / decrypt file with a random s
 testLazySecretBoxTailTag :: Spec
 testLazySecretBoxTailTag = it "should lazily encrypt / decrypt string with a random symmetric key (tail tag)" . ioProperty $ do
   g <- C.newRandom
-  k <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  k <- C.randomSbKey g
+  nonce <- C.randomCbNonce g
   pure $ \(s, pad) ->
     let b = LE.encodeUtf8 $ LT.pack s
         len = LB.length b
@@ -199,8 +198,8 @@ testLazySecretBoxTailTag = it "should lazily encrypt / decrypt string with a ran
 testLazySecretBoxFileTailTag :: Spec
 testLazySecretBoxFileTailTag = it "should lazily encrypt / decrypt file with a random symmetric key (tail tag)" $ do
   g <- C.newRandom
-  k <- atomically $ C.randomSbKey g
-  nonce <- atomically $ C.randomCbNonce g
+  k <- C.randomSbKey g
+  nonce <- C.randomCbNonce g
   let f = "tests/tmp/testsecretbox"
       paddedLen = 4 * 1024 * 1024
       len = 4 * 1000 * 1000 :: Int64
@@ -214,9 +213,9 @@ testLazySecretBoxFileTailTag = it "should lazily encrypt / decrypt file with a r
 testAESGCM :: Spec
 testAESGCM = it "should encrypt / decrypt string with a random symmetric key" $ do
   g <- C.newRandom
-  k <- atomically $ C.randomAesKey g
-  iv <- atomically $ C.randomGCMIV g
-  s <- atomically $ C.randomBytes 100 g
+  k <- C.randomAesKey g
+  iv <- C.randomGCMIV g
+  s <- C.randomBytes 100 g
   Right (tag, cipher) <- runExceptT $ C.encryptAESNoPad k iv s
   Right plain <- runExceptT $ C.decryptAESNoPad k iv cipher tag
   cipher `shouldNotBe` plain
@@ -225,7 +224,7 @@ testAESGCM = it "should encrypt / decrypt string with a random symmetric key" $
 testEncoding :: C.AlgorithmI a => C.SAlgorithm a -> Spec
 testEncoding alg = it "should encode / decode key" . ioProperty $ do
   g <- C.newRandom
-  (k, pk) <- atomically $ C.generateAKeyPair alg g
+  (k, pk) <- C.generateAKeyPair alg g
   pure $ \(_ :: Int) ->
     C.decodePubKey (C.encodePubKey k) == Right k
       && C.decodePrivKey (C.encodePrivKey pk) == Right pk

tests/NtfServerTests.hs

@@ -99,10 +99,10 @@ testNotificationSubscription (ATransport t) =
   -- hangs on Ubuntu 20/22
   xit' "should create notification subscription and notify when message is received" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
+    (nPub, nKey) <- C.generateAuthKeyPair C.SEd25519 g
+    (tknPub, tknKey) <- C.generateAuthKeyPair C.SEd25519 g
+    (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
     let tkn = DeviceToken PPApnsTest "abcd"
     withAPNSMockServer $ \APNSMockServer {apnsQ} ->
       smpTest2 t $ \rh sh ->
@@ -121,7 +121,7 @@ testNotificationSubscription (ATransport t) =
           RespNtf "2" _ NROk <- signSendRecvNtf nh tknKey ("2", tId, TVFY code)
           RespNtf "2a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("2a", tId, TCHK)
           -- enable queue notifications
-          (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- atomically $ C.generateKeyPair g
+          (rcvNtfPubDhKey, rcvNtfPrivDhKey) <- C.generateKeyPair g
           Resp "3" _ (NID nId rcvNtfSrvPubDhKey) <- signSendRecv rh rKey ("3", rId, NKEY nPub rcvNtfPubDhKey)
           let srv = SMPServer SMP.testHost SMP.testPort SMP.testKeyHash
               q = SMPQueueNtf srv nId

tests/RemoteControl.hs

@@ -158,7 +158,7 @@ testMulticast = do
         Nothing -> fail "timeout"
         Just _ -> pure ()
 
-runCtrl :: TVar ChaChaDRG -> Bool -> RCHostPairing -> MVar RCSignedInvitation -> IO (Async RCHostPairing)
+runCtrl :: IORef ChaChaDRG -> Bool -> RCHostPairing -> MVar RCSignedInvitation -> IO (Async RCHostPairing)
 runCtrl drg multicast hp invVar = async . runRight $ do
   (_found, inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") multicast Nothing Nothing
   putMVar invVar inv
@@ -168,7 +168,7 @@ runCtrl drg multicast hp invVar = async . runRight $ do
   liftIO $ RC.cancelHostClient hc
   pure hp'
 
-runHostURI :: TVar ChaChaDRG -> Maybe RCCtrlPairing -> RCSignedInvitation -> IO (Async RCCtrlPairing)
+runHostURI :: IORef ChaChaDRG -> Maybe RCCtrlPairing -> RCSignedInvitation -> IO (Async RCCtrlPairing)
 runHostURI drg cp_ signedInv = async . runRight $ do
   inv <- maybe (fail "bad invite") pure $ verifySignedInvitation signedInv
   (rcCtrlClient, r) <- RC.connectRCCtrl drg inv cp_ (J.String "app")
@@ -178,7 +178,7 @@ runHostURI drg cp_ signedInv = async . runRight $ do
   threadDelay 250000
   pure cp'
 
-runHostMulticast :: TVar ChaChaDRG -> TMVar Int -> RCCtrlPairing -> IO (Async RCCtrlPairing)
+runHostMulticast :: IORef ChaChaDRG -> TMVar Int -> RCCtrlPairing -> IO (Async RCCtrlPairing)
 runHostMulticast drg subscribers cp = async . runRight $ do
   (pairing, inv) <- RC.discoverRCCtrl subscribers (cp :| [])
   (rcCtrlClient, r) <- RC.connectRCCtrl drg inv (Just pairing) (J.String "app")

tests/SMPProxyTests.hs

@@ -71,7 +71,7 @@ smpProxyTests = do
             relayServ = srv2
         (msg1, msg2) <- runIO $ do
           g <- C.newRandom
-          atomically $ (,) <$> C.randomBytes maxLen g <*> C.randomBytes maxLen g
+          (,) <$> C.randomBytes maxLen g <*> C.randomBytes maxLen g
         it "deliver via proxy" . twoServersFirstProxy $
           deliverMessageViaProxy proxyServ relayServ C.SEd448 "hello 1" "hello 2"
         it "max message size, Ed448 keys" . twoServersFirstProxy $
@@ -158,8 +158,8 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
   rc' <- getProtocolClient g (2, relayServ, Nothing) defaultSMPClientConfig {serverVRange = mkVersionRange batchCmdsSMPVersion authCmdsSMPVersion} (Just msgQ) (\_ -> pure ())
   rc <- either (fail . show) pure rc'
   -- prepare receiving queue
-  (rPub, rPriv) <- atomically $ C.generateAuthKeyPair alg g
-  (rdhPub, rdhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+  (rPub, rPriv) <- C.generateAuthKeyPair alg g
+  (rdhPub, rdhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
   SMP.QIK {rcvId, sndId, rcvPublicDhKey = srvDh} <- runExceptT' $ createSMPQueue rc (rPub, rPriv) rdhPub (Just "correct") SMSubscribe False
   let dec = decryptMsgV3 $ C.dh' srvDh rdhPriv
   -- get proxy session
@@ -175,7 +175,7 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
     dec msgId encBody `shouldBe` Right msg
     runExceptT' $ ackSMPMessage rc rPriv rcvId msgId
   -- secure queue
-  (sPub, sPriv) <- atomically $ C.generateAuthKeyPair alg g
+  (sPub, sPriv) <- C.generateAuthKeyPair alg g
   runExceptT' $ secureSMPQueue rc rPriv rcvId sPub
   -- send via proxy to secured queue
   waitSendRecv

tests/ServerTests.hs

@@ -132,8 +132,8 @@ testCreateSecure (ATransport t) =
   it "should create (NEW) and secure (KEY) queue" $
     smpTest2 t $ \r s -> do
       g <- C.newRandom
-      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
-      (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      (rPub, rKey) <- C.generateAuthKeyPair C.SEd448 g
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
       Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv r rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       (rId1, "") #== "creates queue"
@@ -151,7 +151,7 @@ testCreateSecure (ATransport t) =
       Resp "dabc" _ err6 <- signSendRecv r rKey ("dabc", rId, ACK mId1)
       (err6, ERR NO_MSG) #== "replies ERR when message acknowledged without messages"
 
-      (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      (sPub, sKey) <- C.generateAuthKeyPair C.SEd448 g
       Resp "abcd" sId2 err1 <- signSendRecv s sKey ("abcd", sId, _SEND "hello")
       (err1, ERR AUTH) #== "rejects signed SEND"
       (sId2, sId) #== "same queue ID in response 2"
@@ -167,7 +167,7 @@ testCreateSecure (ATransport t) =
       (rId2, rId) #== "same queue ID in response 3"
 
       Resp "abcd" _ OK <- signSendRecv r rKey ("abcd", rId, KEY sPub)
-      (sPub', _) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      (sPub', _) <- C.generateAuthKeyPair C.SEd448 g
       Resp "abcd" _ err4 <- signSendRecv r rKey ("abcd", rId, KEY sPub')
       (err4, ERR AUTH) #== "rejects if secured with different key"
 
@@ -197,13 +197,13 @@ testCreateDelete (ATransport t) =
   it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
     smpTest2 t $ \rh sh -> do
       g <- C.newRandom
-      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-      (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      (rPub, rKey) <- C.generateAuthKeyPair C.SEd25519 g
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
       Resp "abcd" rId1 (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       (rId1, "") #== "creates queue"
 
-      (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
       Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, KEY sPub)
       (ok1, OK) #== "secures queue"
 
@@ -268,8 +268,8 @@ stressTest (ATransport t) =
   it "should create many queues, disconnect and re-connect" $
     smpTest3 t $ \h1 h2 h3 -> do
       g <- C.newRandom
-      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-      (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      (rPub, rKey) <- C.generateAuthKeyPair C.SEd25519 g
+      (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair g
       rIds <- forM ([1 .. 50] :: [Int]) . const $ do
         Resp "" "" (Ids rId _ _) <- signSendRecv h1 rKey ("", "", NEW rPub dhPub Nothing SMSubscribe False)
         pure rId
@@ -287,8 +287,8 @@ testAllowNewQueues t =
     withSmpServerConfigOn (ATransport t) cfg {allowNewQueues = False} testPort $ \_ ->
       testSMPClient @c $ \h -> do
         g <- C.newRandom
-        (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
-        (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+        (rPub, rKey) <- C.generateAuthKeyPair C.SEd448 g
+        (dhPub, _ :: C.PrivateKeyX25519) <- C.generateKeyPair g
         Resp "abcd" "" (ERR AUTH) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
         pure ()
 
@@ -297,13 +297,13 @@ testDuplex (ATransport t) =
   it "should create 2 simplex connections and exchange messages" $
     smpTest2 t $ \alice bob -> do
       g <- C.newRandom
-      (arPub, arKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
-      (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      (arPub, arKey) <- C.generateAuthKeyPair C.SEd448 g
+      (aDhPub, aDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
       Resp "abcd" _ (Ids aRcv aSnd aSrvDh) <- signSendRecv alice arKey ("abcd", "", NEW arPub aDhPub Nothing SMSubscribe False)
       let aDec = decryptMsgV3 $ C.dh' aSrvDh aDhPriv
       -- aSnd ID is passed to Bob out-of-band
 
-      (bsPub, bsKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      (bsPub, bsKey) <- C.generateAuthKeyPair C.SEd448 g
       Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, _SEND $ "key " <> strEncode bsPub)
       -- "key ..." is ad-hoc, not a part of SMP protocol
 
@@ -313,8 +313,8 @@ testDuplex (ATransport t) =
       (bobKey, strEncode bsPub) #== "key received from Bob"
       Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, KEY bsPub)
 
-      (brPub, brKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
-      (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      (brPub, brKey) <- C.generateAuthKeyPair C.SEd448 g
+      (bDhPub, bDhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
       Resp "abcd" _ (Ids bRcv bSnd bSrvDh) <- signSendRecv bob brKey ("abcd", "", NEW brPub bDhPub Nothing SMSubscribe False)
       let bDec = decryptMsgV3 $ C.dh' bSrvDh bDhPriv
       Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, _SEND $ "reply_id " <> encode bSnd)
@@ -325,7 +325,7 @@ testDuplex (ATransport t) =
       Right ["reply_id", bId] <- pure $ B.words <$> aDec mId2 msg2
       (bId, encode bSnd) #== "reply queue ID received from Bob"
 
-      (asPub, asKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+      (asPub, asKey) <- C.generateAuthKeyPair C.SEd448 g
       Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, _SEND $ "key " <> strEncode asPub)
       -- "key ..." is ad-hoc, not a part of  SMP protocol
 
@@ -352,8 +352,8 @@ testSwitchSub (ATransport t) =
   it "should create simplex connections and switch subscription to another TCP connection" $
     smpTest3 t $ \rh1 rh2 sh -> do
       g <- C.newRandom
-      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
-      (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      (rPub, rKey) <- C.generateAuthKeyPair C.SEd448 g
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
       Resp "abcd" _ (Ids rId sId srvDh) <- signSendRecv rh1 rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, _SEND "test1")
@@ -392,7 +392,7 @@ testGetCommand :: forall c. Transport c => TProxy c -> Spec
 testGetCommand t =
   it "should retrieve messages from the queue using GET command" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
     smpTest t $ \sh -> do
       queue <- newEmptyTMVarIO
       testSMPClient @c $ \rh ->
@@ -411,7 +411,7 @@ testGetSubCommands :: forall c. Transport c => TProxy c -> Spec
 testGetSubCommands t =
   it "should retrieve messages with GET and receive with SUB, only one ACK would work" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
     smpTest3 t $ \rh1 rh2 sh -> do
       (sId, rId, rKey, dhShared) <- createAndSecureQueue rh1 sPub
       let dec = decryptMsgV3 dhShared
@@ -463,7 +463,7 @@ testExceedQueueQuota t =
     withSmpServerConfigOn (ATransport t) cfg {msgQueueQuota = 2} testPort $ \_ ->
       testSMPClient @c $ \sh -> testSMPClient @c $ \rh -> do
         g <- C.newRandom
-        (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+        (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
         (sId, rId, rKey, dhShared) <- createAndSecureQueue rh sPub
         let dec = decryptMsgV3 dhShared
         Resp "1" _ OK <- signSendRecv sh sKey ("1", sId, _SEND "hello 1")
@@ -488,9 +488,9 @@ testWithStoreLog :: ATransport -> Spec
 testWithStoreLog at@(ATransport t) =
   it "should store simplex queues to log and restore them after server restart" $ do
     g <- C.newRandom
-    (sPub1, sKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (sPub2, sKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub1, sKey1) <- C.generateAuthKeyPair C.SEd25519 g
+    (sPub2, sKey2) <- C.generateAuthKeyPair C.SEd25519 g
+    (nPub, nKey) <- C.generateAuthKeyPair C.SEd25519 g
     recipientId1 <- newTVarIO ""
     recipientKey1 <- newTVarIO Nothing
     dhShared1 <- newTVarIO Nothing
@@ -500,7 +500,7 @@ testWithStoreLog at@(ATransport t) =
 
     withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do
       (sId1, rId1, rKey1, dhShared) <- createAndSecureQueue h sPub1
-      (rcvNtfPubDhKey, _) <- atomically $ C.generateKeyPair g
+      (rcvNtfPubDhKey, _) <- C.generateKeyPair g
       Resp "abcd" _ (NID nId _) <- signSendRecv h rKey1 ("abcd", rId1, NKEY nPub rcvNtfPubDhKey)
       atomically $ do
         writeTVar recipientId1 rId1
@@ -579,7 +579,7 @@ testRestoreMessages at@(ATransport t) =
     removeFileIfExists testServerStatsBackupFile
 
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
     recipientId <- newTVarIO ""
     recipientKey <- newTVarIO Nothing
     dhShared <- newTVarIO Nothing
@@ -683,7 +683,7 @@ testRestoreExpireMessages :: ATransport -> Spec
 testRestoreExpireMessages at@(ATransport t) =
   it "should store messages on exit and restore on start" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
     recipientId <- newTVarIO ""
     recipientKey <- newTVarIO Nothing
     dhShared <- newTVarIO Nothing
@@ -740,8 +740,8 @@ testRestoreExpireMessages at@(ATransport t) =
 createAndSecureQueue :: Transport c => THandleSMP c 'TClient -> SndPublicAuthKey -> IO (SenderId, RecipientId, RcvPrivateAuthKey, RcvDhSecret)
 createAndSecureQueue h sPub = do
   g <- C.newRandom
-  (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
-  (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+  (rPub, rKey) <- C.generateAuthKeyPair C.SEd448 g
+  (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
   Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv h rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
   let dhShared = C.dh' srvDh dhPriv
   Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, KEY sPub)
@@ -775,16 +775,16 @@ testTiming (ATransport t) =
     testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg, Int) -> Expectation
     testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) = do
       g <- C.newRandom
-      (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
-      (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      (rPub, rKey) <- C.generateAuthKeyPair goodKeyAlg g
+      (dhPub, dhPriv :: C.PrivateKeyX25519) <- C.generateKeyPair g
       Resp "abcd" "" (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", "", NEW rPub dhPub Nothing SMSubscribe False)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
       Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, SUB)
 
-      (_, badKey) <- atomically $ C.generateAuthKeyPair badKeyAlg g
+      (_, badKey) <- C.generateAuthKeyPair badKeyAlg g
       runTimingTest rh badKey rId SUB
 
-      (sPub, sKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
+      (sPub, sKey) <- C.generateAuthKeyPair goodKeyAlg g
       Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, KEY sPub)
 
       Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, _SEND "hello")
@@ -822,12 +822,12 @@ testMessageNotifications :: ATransport -> Spec
 testMessageNotifications (ATransport t) =
   it "should create simplex connection, subscribe notifier and deliver notifications" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
+    (nPub, nKey) <- C.generateAuthKeyPair C.SEd25519 g
     smpTest4 t $ \rh sh nh1 nh2 -> do
       (sId, rId, rKey, dhShared) <- createAndSecureQueue rh sPub
       let dec = decryptMsgV3 dhShared
-      (rcvNtfPubDhKey, _) <- atomically $ C.generateKeyPair g
+      (rcvNtfPubDhKey, _) <- C.generateKeyPair g
       Resp "1" _ (NID nId' _) <- signSendRecv rh rKey ("1", rId, NKEY nPub rcvNtfPubDhKey)
       Resp "1a" _ (NID nId _) <- signSendRecv rh rKey ("1a", rId, NKEY nPub rcvNtfPubDhKey)
       nId' `shouldNotBe` nId
@@ -859,7 +859,7 @@ testMsgExpireOnSend :: forall c. Transport c => TProxy c -> Spec
 testMsgExpireOnSend t =
   it "should expire messages that are not received before messageTTL on SEND" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
     let cfg' = cfg {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 10000}}
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
@@ -880,7 +880,7 @@ testMsgExpireOnInterval t =
   -- fails on ubuntu
   xit' "should expire messages that are not received before messageTTL after expiry interval" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
     let cfg' = cfg {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do
@@ -899,7 +899,7 @@ testMsgNOTExpireOnInterval :: forall c. Transport c => TProxy c -> Spec
 testMsgNOTExpireOnInterval t =
   it "should NOT expire messages that are not received before messageTTL if expiry interval is large" $ do
     g <- C.newRandom
-    (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+    (sPub, sKey) <- C.generateAuthKeyPair C.SEd25519 g
     let cfg' = cfg {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 10000}}
     withSmpServerConfigOn (ATransport t) cfg' testPort $ \_ ->
       testSMPClient @c $ \sh -> do

tests/XFTPAgent.hs

@@ -127,7 +127,7 @@ testXFTPAgentSendReceiveEncrypted = withXFTPServer $ do
   g <- C.newRandom
   filePath <- createRandomFile
   s <- LB.readFile filePath
-  file <- atomically $ CryptoFile (senderFiles </> "encrypted_testfile") . Just <$> CF.randomArgs g
+  file <- CryptoFile (senderFiles </> "encrypted_testfile") . Just <$> CF.randomArgs g
   runRight_ $ CF.writeFile file s
   (rfd1, rfd2) <- withAgent 1 agentCfg initAgentServers testDB $ \sndr -> runRight $ do
     (sfId, _, rfd1, rfd2) <- testSendCF sndr file
@@ -139,7 +139,7 @@ testXFTPAgentSendReceiveEncrypted = withXFTPServer $ do
   where
     testReceiveDelete clientId rfd originalFilePath g =
       withAgent clientId agentCfg initAgentServers testDB2 $ \rcp -> do
-        cfArgs <- atomically $ Just <$> CF.randomArgs g
+        cfArgs <- Just <$> CF.randomArgs g
         rfId <- runRight $ testReceiveCF rcp rfd cfArgs originalFilePath
         xftpDeleteRcvFile rcp rfId
 

tests/XFTPServerTests.hs

@@ -70,7 +70,7 @@ testChunkPath = "tests/tmp/chunk1"
 createTestChunk :: FilePath -> IO ByteString
 createTestChunk fp = do
   g <- C.newRandom
-  bytes <- atomically $ C.randomBytes chSize g
+  bytes <- C.randomBytes chSize g
   B.writeFile fp bytes
   pure bytes
 
@@ -78,114 +78,118 @@ readChunk :: SenderId -> IO ByteString
 readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode sId))
 
 testFileChunkDelivery :: Expectation
-testFileChunkDelivery = xftpTest $ \c -> runRight_ $ runTestFileChunkDelivery c c
+testFileChunkDelivery = xftpTest $ \c -> runTestFileChunkDelivery c c
 
 testFileChunkDelivery2 :: Expectation
-testFileChunkDelivery2 = xftpTest2 $ \s r -> runRight_ $ runTestFileChunkDelivery s r
+testFileChunkDelivery2 = xftpTest2 $ \s r -> runTestFileChunkDelivery s r
 
-runTestFileChunkDelivery :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
+runTestFileChunkDelivery :: XFTPClient -> XFTPClient -> IO ()
 runTestFileChunkDelivery s r = do
-  g <- liftIO C.newRandom
-  (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  bytes <- liftIO $ createTestChunk testChunkPath
-  digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
+  g <- C.newRandom
+  (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey, rpKey) <- C.generateAuthKeyPair C.SEd25519 g
+  bytes <- createTestChunk testChunkPath
+  digest <- LC.sha256Hash <$> LB.readFile testChunkPath
   let file = FileInfo {sndKey, size = chSize, digest}
       chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
-  (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
-  uploadXFTPChunk s spKey sId chunkSpec
-  (sId', _) <- createXFTPChunk s spKey file {digest = digest <> "_wrong"} [rcvKey] Nothing
-  uploadXFTPChunk s spKey sId' chunkSpec
-    `catchError` (liftIO . (`shouldBe` PCEProtocolError DIGEST))
-  liftIO $ readChunk sId `shouldReturn` bytes
-  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize (digest <> "_wrong"))
-    `catchError` (liftIO . (`shouldBe` PCEResponseError DIGEST))
-  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-  liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+  runRight_ $ do
+    (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
+    uploadXFTPChunk s spKey sId chunkSpec
+    (sId', _) <- createXFTPChunk s spKey file {digest = digest <> "_wrong"} [rcvKey] Nothing
+    uploadXFTPChunk s spKey sId' chunkSpec
+      `catchError` (liftIO . (`shouldBe` PCEProtocolError DIGEST))
+    liftIO $ readChunk sId `shouldReturn` bytes
+    downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize (digest <> "_wrong"))
+      `catchError` (liftIO . (`shouldBe` PCEResponseError DIGEST))
+    downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
+    liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
 
 testFileChunkDeliveryAddRecipients :: Expectation
-testFileChunkDeliveryAddRecipients = xftpTest4 $ \s r1 r2 r3 -> runRight_ $ do
-  g <- liftIO C.newRandom
-  (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey1, rpKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey2, rpKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey3, rpKey3) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  bytes <- liftIO $ createTestChunk testChunkPath
-  digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
+testFileChunkDeliveryAddRecipients = xftpTest4 $ \s r1 r2 r3 -> do
+  g <- C.newRandom
+  (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey1, rpKey1) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey2, rpKey2) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey3, rpKey3) <- C.generateAuthKeyPair C.SEd25519 g
+  bytes <- createTestChunk testChunkPath
+  digest <- LC.sha256Hash <$> LB.readFile testChunkPath
   let file = FileInfo {sndKey, size = chSize, digest}
       chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
-  (sId, [rId1]) <- createXFTPChunk s spKey file [rcvKey1] Nothing
-  [rId2, rId3] <- addXFTPRecipients s spKey sId [rcvKey2, rcvKey3]
-  uploadXFTPChunk s spKey sId chunkSpec
-  let testReceiveChunk r rpKey rId fPath = do
-        downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec fPath chSize digest
-        liftIO $ B.readFile fPath `shouldReturn` bytes
-  testReceiveChunk r1 rpKey1 rId1 "tests/tmp/received_chunk1"
-  testReceiveChunk r2 rpKey2 rId2 "tests/tmp/received_chunk2"
-  testReceiveChunk r3 rpKey3 rId3 "tests/tmp/received_chunk3"
+  runRight_ $ do
+    (sId, [rId1]) <- createXFTPChunk s spKey file [rcvKey1] Nothing
+    [rId2, rId3] <- addXFTPRecipients s spKey sId [rcvKey2, rcvKey3]
+    uploadXFTPChunk s spKey sId chunkSpec
+    let testReceiveChunk r rpKey rId fPath = do
+          downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec fPath chSize digest
+          liftIO $ B.readFile fPath `shouldReturn` bytes
+    testReceiveChunk r1 rpKey1 rId1 "tests/tmp/received_chunk1"
+    testReceiveChunk r2 rpKey2 rId2 "tests/tmp/received_chunk2"
+    testReceiveChunk r3 rpKey3 rId3 "tests/tmp/received_chunk3"
 
 testFileChunkDelete :: Expectation
-testFileChunkDelete = xftpTest $ \c -> runRight_ $ runTestFileChunkDelete c c
+testFileChunkDelete = xftpTest $ \c -> runTestFileChunkDelete c c
 
 testFileChunkDelete2 :: Expectation
-testFileChunkDelete2 = xftpTest2 $ \s r -> runRight_ $ runTestFileChunkDelete s r
+testFileChunkDelete2 = xftpTest2 $ \s r -> runTestFileChunkDelete s r
 
-runTestFileChunkDelete :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
+runTestFileChunkDelete :: XFTPClient -> XFTPClient -> IO ()
 runTestFileChunkDelete s r = do
-  g <- liftIO C.newRandom
-  (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  bytes <- liftIO $ createTestChunk testChunkPath
-  digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
+  g <- C.newRandom
+  (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey, rpKey) <- C.generateAuthKeyPair C.SEd25519 g
+  bytes <- createTestChunk testChunkPath
+  digest <- LC.sha256Hash <$> LB.readFile testChunkPath
   let file = FileInfo {sndKey, size = chSize, digest}
       chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
-  (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
-  uploadXFTPChunk s spKey sId chunkSpec
+  runRight_ $ do
+    (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
+    uploadXFTPChunk s spKey sId chunkSpec
 
-  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-  liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
-  deleteXFTPChunk s spKey sId
-  liftIO $
-    readChunk sId
-      `shouldThrow` \(e :: SomeException) -> "does not exist" `isInfixOf` show e
-  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
-    `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
-  deleteXFTPChunk s spKey sId
-    `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
+    downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
+    liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+    deleteXFTPChunk s spKey sId
+    liftIO $
+      readChunk sId
+        `shouldThrow` \(e :: SomeException) -> "does not exist" `isInfixOf` show e
+    downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
+      `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
+    deleteXFTPChunk s spKey sId
+      `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
 
 testFileChunkAck :: Expectation
-testFileChunkAck = xftpTest $ \c -> runRight_ $ runTestFileChunkAck c c
+testFileChunkAck = xftpTest $ \c -> runTestFileChunkAck c c
 
 testFileChunkAck2 :: Expectation
-testFileChunkAck2 = xftpTest2 $ \s r -> runRight_ $ runTestFileChunkAck s r
+testFileChunkAck2 = xftpTest2 $ \s r -> runTestFileChunkAck s r
 
-runTestFileChunkAck :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
+runTestFileChunkAck :: XFTPClient -> XFTPClient -> IO ()
 runTestFileChunkAck s r = do
-  g <- liftIO C.newRandom
-  (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  bytes <- liftIO $ createTestChunk testChunkPath
-  digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
+  g <- C.newRandom
+  (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey, rpKey) <- C.generateAuthKeyPair C.SEd25519 g
+  bytes <- createTestChunk testChunkPath
+  digest <- LC.sha256Hash <$> LB.readFile testChunkPath
   let file = FileInfo {sndKey, size = chSize, digest}
       chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
-  (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
-  uploadXFTPChunk s spKey sId chunkSpec
+  runRight_ $ do
+    (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
+    uploadXFTPChunk s spKey sId chunkSpec
 
-  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-  liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
-  ackXFTPChunk r rpKey rId
-  liftIO $ readChunk sId `shouldReturn` bytes
-  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
-    `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
-  ackXFTPChunk r rpKey rId
-    `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
+    downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
+    liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+    ackXFTPChunk r rpKey rId
+    liftIO $ readChunk sId `shouldReturn` bytes
+    downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
+      `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
+    ackXFTPChunk r rpKey rId
+      `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
 
 testWrongChunkSize :: Expectation
 testWrongChunkSize = xftpTest $ \c -> do
   g <- C.newRandom
-  (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey, _rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  B.writeFile testChunkPath =<< atomically (C.randomBytes (kb 96) g)
+  (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey, _rpKey) <- C.generateAuthKeyPair C.SEd25519 g
+  B.writeFile testChunkPath =<< C.randomBytes (kb 96) g
   digest <- LC.sha256Hash <$> LB.readFile testChunkPath
   let file = FileInfo {sndKey, size = kb 96, digest}
   runRight_ $
@@ -194,25 +198,26 @@ testWrongChunkSize = xftpTest $ \c -> do
 
 testFileChunkExpiration :: Expectation
 testFileChunkExpiration = withXFTPServerCfg testXFTPServerConfig {fileExpiration} $
-  \_ -> testXFTPClient $ \c -> runRight_ $ do
-    g <- liftIO C.newRandom
-    (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    bytes <- liftIO $ createTestChunk testChunkPath
-    digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
+  \_ -> testXFTPClient $ \c -> do
+    g <- C.newRandom
+    (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+    (rcvKey, rpKey) <- C.generateAuthKeyPair C.SEd25519 g
+    bytes <- createTestChunk testChunkPath
+    digest <- LC.sha256Hash <$> LB.readFile testChunkPath
     let file = FileInfo {sndKey, size = chSize, digest}
         chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
-    (sId, [rId]) <- createXFTPChunk c spKey file [rcvKey] Nothing
-    uploadXFTPChunk c spKey sId chunkSpec
+    runRight_ $ do
+      (sId, [rId]) <- createXFTPChunk c spKey file [rcvKey] Nothing
+      uploadXFTPChunk c spKey sId chunkSpec
 
-    downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-    liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+      downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
+      liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
 
-    liftIO $ threadDelay 1000000
-    downloadXFTPChunk g c rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
-      `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
-    deleteXFTPChunk c spKey sId
-      `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
+      liftIO $ threadDelay 1000000
+      downloadXFTPChunk g c rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
+        `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
+      deleteXFTPChunk c spKey sId
+        `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
   where
     fileExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}
 
@@ -233,39 +238,40 @@ testInactiveClientExpiration = withXFTPServerCfg testXFTPServerConfig {inactiveC
 
 testFileStorageQuota :: Expectation
 testFileStorageQuota = withXFTPServerCfg testXFTPServerConfig {fileSizeQuota = Just $ chSize * 2} $
-  \_ -> testXFTPClient $ \c -> runRight_ $ do
-    g <- liftIO C.newRandom
-    (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    bytes <- liftIO $ createTestChunk testChunkPath
-    digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
+  \_ -> testXFTPClient $ \c -> do
+    g <- C.newRandom
+    (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+    (rcvKey, rpKey) <- C.generateAuthKeyPair C.SEd25519 g
+    bytes <- createTestChunk testChunkPath
+    digest <- LC.sha256Hash <$> LB.readFile testChunkPath
     let file = FileInfo {sndKey, size = chSize, digest}
         chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
         download rId = do
           downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
           liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
-    (sId1, [rId1]) <- createXFTPChunk c spKey file [rcvKey] Nothing
-    uploadXFTPChunk c spKey sId1 chunkSpec
-    download rId1
-    (sId2, [rId2]) <- createXFTPChunk c spKey file [rcvKey] Nothing
-    uploadXFTPChunk c spKey sId2 chunkSpec
-    download rId2
+    runRight_ $ do
+      (sId1, [rId1]) <- createXFTPChunk c spKey file [rcvKey] Nothing
+      uploadXFTPChunk c spKey sId1 chunkSpec
+      download rId1
+      (sId2, [rId2]) <- createXFTPChunk c spKey file [rcvKey] Nothing
+      uploadXFTPChunk c spKey sId2 chunkSpec
+      download rId2
 
-    (sId3, [rId3]) <- createXFTPChunk c spKey file [rcvKey] Nothing
-    uploadXFTPChunk c spKey sId3 chunkSpec
-      `catchError` (liftIO . (`shouldBe` PCEProtocolError QUOTA))
+      (sId3, [rId3]) <- createXFTPChunk c spKey file [rcvKey] Nothing
+      uploadXFTPChunk c spKey sId3 chunkSpec
+        `catchError` (liftIO . (`shouldBe` PCEProtocolError QUOTA))
 
-    deleteXFTPChunk c spKey sId1
-    uploadXFTPChunk c spKey sId3 chunkSpec
-    download rId3
+      deleteXFTPChunk c spKey sId1
+      uploadXFTPChunk c spKey sId3 chunkSpec
+      download rId3
 
 testFileLog :: Expectation
 testFileLog = do
   g <- C.newRandom
   bytes <- liftIO $ createTestChunk testChunkPath
-  (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey1, rpKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-  (rcvKey2, rpKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+  (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey1, rpKey1) <- C.generateAuthKeyPair C.SEd25519 g
+  (rcvKey2, rpKey2) <- C.generateAuthKeyPair C.SEd25519 g
   digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
   sIdVar <- newTVarIO ""
   rIdVar1 <- newTVarIO ""
@@ -356,8 +362,8 @@ testFileBasicAuth allowNewFiles newFileBasicAuth clntAuth success =
   withXFTPServerCfg testXFTPServerConfig {allowNewFiles, newFileBasicAuth} $
     \_ -> testXFTPClient $ \c -> do
       g <- C.newRandom
-      (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-      (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+      (rcvKey, rpKey) <- C.generateAuthKeyPair C.SEd25519 g
       bytes <- createTestChunk testChunkPath
       digest <- LC.sha256Hash <$> LB.readFile testChunkPath
       let file = FileInfo {sndKey, size = chSize, digest}
@@ -378,8 +384,8 @@ testFileSkipCommitted =
   withXFTPServerCfg testXFTPServerConfig $
     \_ -> testXFTPClient $ \c -> do
       g <- C.newRandom
-      (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-      (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (sndKey, spKey) <- C.generateAuthKeyPair C.SEd25519 g
+      (rcvKey, rpKey) <- C.generateAuthKeyPair C.SEd25519 g
       bytes <- createTestChunk testChunkPath
       digest <- LC.sha256Hash <$> LB.readFile testChunkPath
       let file = FileInfo {sndKey, size = chSize, digest}