core: use ChaChaDRG as the source of randomness (#3551)

* core: use ChaChaDRG as the source of randomness

* do not use entropy directly

* dont use RNG from agent

* simplexmq

* update iOS

apps/ios/Shared/Views/Call/WebRTCClient.swift

@@ -18,6 +18,7 @@ final class WebRTCClient: NSObject, RTCVideoViewDelegate, RTCFrameEncryptorDeleg
     }()
     private static let ivTagBytes: Int = 28
     private static let enableEncryption: Bool = true
+    private var chat_ctrl = getChatCtrl()
 
     struct Call {
         var connection: RTCPeerConnection
@@ -308,7 +309,7 @@ final class WebRTCClient: NSObject, RTCVideoViewDelegate, RTCFrameEncryptorDeleg
             memcpy(pointer, (unencrypted as NSData).bytes, unencrypted.count)
             let isKeyFrame = unencrypted[0] & 1 == 0
             let clearTextBytesSize = mediaType.rawValue == 0 ? 1 : isKeyFrame ? 10 : 3
-            logCrypto("encrypt", chat_encrypt_media(&key, pointer.advanced(by: clearTextBytesSize), Int32(unencrypted.count + WebRTCClient.ivTagBytes - clearTextBytesSize)))
+            logCrypto("encrypt", chat_encrypt_media(chat_ctrl, &key, pointer.advanced(by: clearTextBytesSize), Int32(unencrypted.count + WebRTCClient.ivTagBytes - clearTextBytesSize)))
             return Data(bytes: pointer, count: unencrypted.count + WebRTCClient.ivTagBytes)
         } else {
             return nil

apps/ios/SimpleXChat/CryptoFile.swift

@@ -17,7 +17,7 @@ public func writeCryptoFile(path: String, data: Data) throws -> CryptoFileArgs {
     let ptr: UnsafeMutableRawPointer = malloc(data.count)
     memcpy(ptr, (data as NSData).bytes, data.count)
     var cPath = path.cString(using: .utf8)!
-    let cjson = chat_write_file(&cPath, ptr, Int32(data.count))!
+    let cjson = chat_write_file(getChatCtrl(), &cPath, ptr, Int32(data.count))!
     let d = fromCString(cjson).data(using: .utf8)!
     switch try jsonDecoder.decode(WriteFileResult.self, from: d) {
     case let .result(cfArgs): return cfArgs
@@ -50,7 +50,7 @@ public func readCryptoFile(path: String, cryptoArgs: CryptoFileArgs) throws -> D
 public func encryptCryptoFile(fromPath: String, toPath: String) throws -> CryptoFileArgs {
     var cFromPath = fromPath.cString(using: .utf8)!
     var cToPath = toPath.cString(using: .utf8)!
-    let cjson = chat_encrypt_file(&cFromPath, &cToPath)!
+    let cjson = chat_encrypt_file(getChatCtrl(), &cFromPath, &cToPath)!
     let d = fromCString(cjson).data(using: .utf8)!
     switch try jsonDecoder.decode(WriteFileResult.self, from: d) {
     case let .result(cfArgs): return cfArgs

apps/ios/SimpleXChat/SimpleX.h

@@ -25,11 +25,11 @@ extern char *chat_parse_markdown(char *str);
 extern char *chat_parse_server(char *str);
 extern char *chat_password_hash(char *pwd, char *salt);
 extern char *chat_valid_name(char *name);
-extern char *chat_encrypt_media(char *key, char *frame, int len);
+extern char *chat_encrypt_media(chat_ctrl ctl, char *key, char *frame, int len);
 extern char *chat_decrypt_media(char *key, char *frame, int len);
 
 // chat_write_file returns null-terminated string with JSON of WriteFileResult
-extern char *chat_write_file(char *path, char *data, int len);
+extern char *chat_write_file(chat_ctrl ctl, char *path, char *data, int len);
 
 // chat_read_file returns a buffer with:
 // result status (1 byte), then if
@@ -38,7 +38,7 @@ extern char *chat_write_file(char *path, char *data, int len);
 extern char *chat_read_file(char *path, char *key, char *nonce);
 
 // chat_encrypt_file returns null-terminated string with JSON of WriteFileResult
-extern char *chat_encrypt_file(char *fromPath, char *toPath);
+extern char *chat_encrypt_file(chat_ctrl ctl, char *fromPath, char *toPath);
 
 // chat_decrypt_file returns null-terminated string with the error message
 extern char *chat_decrypt_file(char *fromPath, char *key, char *nonce, char *toPath);

cabal.project

@@ -14,7 +14,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 8c250ebe19f56dd7d53572d984e8016cb0e4d658
+    tag: 13a60d1d3944aa175311563e661161e759b92563
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."8c250ebe19f56dd7d53572d984e8016cb0e4d658" = "080rw86yncf1h3zr5a8y65cndihq6f3ji43vxrdhr2mrb75vmw8m";
+  "https://github.com/simplex-chat/simplexmq.git"."13a60d1d3944aa175311563e661161e759b92563" = "08mvqrbjfnq7c6mhkj4hhy4cxn0cj21n49lqzh67ani71g2g1xwa";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

src/Simplex/Chat.hs

@@ -22,7 +22,6 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
-import Crypto.Random (drgNew)
 import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -208,7 +207,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
   servers <- agentServers config
   smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore
   agentAsync <- newTVarIO Nothing
-  idsDrg <- newTVarIO =<< liftIO drgNew
+  random <- liftIO C.newRandom
   inputQ <- newTBQueueIO tbqSize
   outputQ <- newTBQueueIO tbqSize
   connNetworkStatuses <- atomically TM.empty
@@ -243,7 +242,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
         agentAsync,
         chatStore,
         chatStoreChanged,
-        idsDrg,
+        random,
         inputQ,
         outputQ,
         connNetworkStatuses,
@@ -1077,8 +1076,9 @@ processChatCommand = \case
       then do
         calls <- asks currentCalls
         withChatLock "sendCallInvitation" $ do
-          callId <- CallId <$> drgRandomBytes 16
+          g <- asks random
-          dhKeyPair <- if encryptedCall callType then Just <$> liftIO C.generateKeyPair' else pure Nothing
+          callId <- atomically $ CallId <$> C.randomBytes 16 g
+          dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing
           let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair}
               callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair}
           (msg, _) <- sendDirectContactMessage ct (XCallInv callId invitation)
@@ -1600,7 +1600,7 @@ processChatCommand = \case
     processChatCommand $ APIChatItemReaction chatRef chatItemId add reaction
   APINewGroup userId incognito gProfile@GroupProfile {displayName} -> withUserId userId $ \user -> do
     checkValidName displayName
-    gVar <- asks idsDrg
+    gVar <- asks random
     -- [incognito] generate incognito profile for group membership
     incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
     groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile incognitoProfile
@@ -1621,7 +1621,7 @@ processChatCommand = \case
     let sendInvitation = sendGrpInvitation user contact gInfo
     case contactMember contact members of
       Nothing -> do
-        gVar <- asks idsDrg
+        gVar <- asks random
         subMode <- chatReadVar subscriptionMode
         (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode
         member <- withStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode
@@ -1884,7 +1884,7 @@ processChatCommand = \case
   SetFileToReceive fileId encrypted_ -> withUser $ \_ -> do
     withChatLock "setFileToReceive" . procCmd $ do
       encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles
-      cfArgs <- if encrypt then Just <$> liftIO CF.randomArgs else pure Nothing
+      cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing
       withStore' $ \db -> setRcvFileToReceive db fileId cfArgs
       ok_
   CancelFile fileId -> withUser $ \user@User {userId} ->
@@ -2030,7 +2030,7 @@ processChatCommand = \case
     -- in View.hs `r'` should be defined as `id` in this case
     -- procCmd :: m ChatResponse -> m ChatResponse
     -- procCmd action = do
-    --   ChatController {chatLock = l, smpAgent = a, outputQ = q, idsDrg = gVar} <- ask
+    --   ChatController {chatLock = l, smpAgent = a, outputQ = q, random = gVar} <- ask
     --   corrId <- liftIO $ SMP.CorrId <$> randomBytes gVar 8
     --   void . forkIO $
     --     withAgentLock a . withLock l name $
@@ -2296,7 +2296,7 @@ processChatCommand = \case
             then pure Nothing
             else Just . addUTCTime (realToFrac ttl) <$> liftIO getCurrentTime
     drgRandomBytes :: Int -> m ByteString
-    drgRandomBytes n = asks idsDrg >>= liftIO . (`randomBytes` n)
+    drgRandomBytes n = asks random >>= atomically . C.randomBytes n
     privateGetUser :: UserId -> m User
     privateGetUser userId =
       tryChatError (withStore (`getUser` userId)) >>= \case
@@ -2571,7 +2571,7 @@ toFSFilePath f =
 
 setFileToEncrypt :: ChatMonad m => RcvFileTransfer -> m RcvFileTransfer
 setFileToEncrypt ft@RcvFileTransfer {fileId} = do
-  cfArgs <- liftIO CF.randomArgs
+  cfArgs <- atomically . CF.randomArgs =<< asks random
   withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
   pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs}
 
@@ -2726,7 +2726,7 @@ acceptGroupJoinRequestAsync
   ucr@UserContactRequest {agentInvitationId = AgentInvId invId}
   gLinkMemRole
   incognitoProfile = do
-    gVar <- asks idsDrg
+    gVar <- asks random
     (groupMemberId, memberId) <- withStore $ \db -> createAcceptedMember db gVar user gInfo ucr gLinkMemRole
     let Profile {displayName} = profileToSendOnAccept user incognitoProfile
         GroupMember {memberRole = userRole, memberId = userMemberId} = membership
@@ -3407,7 +3407,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                   groupInfo <- withStore $ \db -> getGroupInfo db user groupId
                   subMode <- chatReadVar subscriptionMode
                   groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
-                  gVar <- asks idsDrg
+                  gVar <- asks random
                   withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode
             Just (gInfo, m@GroupMember {activeConn}) ->
               when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
@@ -4049,7 +4049,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
 
     probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m ()
     probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do
-      gVar <- asks idsDrg
+      gVar <- asks random
       contactMerge <- readTVarIO =<< asks contactMergeEnabled
       if contactMerge && not connectedIncognito
         then do
@@ -4073,7 +4073,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     probeMatchingMemberContact :: GroupMember -> IncognitoEnabled -> m ()
     probeMatchingMemberContact GroupMember {activeConn = Nothing} _ = pure ()
     probeMatchingMemberContact m@GroupMember {groupId, activeConn = Just conn} connectedIncognito = do
-      gVar <- asks idsDrg
+      gVar <- asks random
       contactMerge <- readTVarIO =<< asks contactMergeEnabled
       if contactMerge && not connectedIncognito
         then do
@@ -4774,7 +4774,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
       if featureAllowed SCFCalls forContact ct
         then do
-          dhKeyPair <- if encryptedCall callType then Just <$> liftIO C.generateKeyPair' else pure Nothing
+          g <- asks random
+          dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing
           ci <- saveCallItem CISCallPending
           let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair))
               callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey}
@@ -5517,7 +5518,7 @@ sendDirectMessage conn chatMsgEvent connOrGroupId = do
 
 createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> m SndMessage
 createSndMessage chatMsgEvent connOrGroupId = do
-  gVar <- asks idsDrg
+  gVar <- asks random
   ChatConfig {chatVRange} <- asks config
   withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId ->
     let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}

src/Simplex/Chat/Controller.hs

@@ -180,7 +180,7 @@ data ChatController = ChatController
     agentAsync :: TVar (Maybe (Async (), Maybe (Async ()))),
     chatStore :: SQLiteStore,
     chatStoreChanged :: TVar Bool, -- if True, chat should be fully restarted
-    idsDrg :: TVar ChaChaDRG,
+    random :: TVar ChaChaDRG,
     inputQ :: TBQueue String,
     outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse),
     connNetworkStatuses :: TMap AgentConnId NetworkStatus,

src/Simplex/Chat/Mobile.hs

@@ -94,15 +94,15 @@ foreign export ccall "chat_password_hash" cChatPasswordHash :: CString -> CStrin
 
 foreign export ccall "chat_valid_name" cChatValidName :: CString -> IO CString
 
-foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
+foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CString
 
 foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
 
-foreign export ccall "chat_write_file" cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString
+foreign export ccall "chat_write_file" cChatWriteFile :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CJSONString
 
 foreign export ccall "chat_read_file" cChatReadFile :: CString -> CString -> CString -> IO (Ptr Word8)
 
-foreign export ccall "chat_encrypt_file" cChatEncryptFile :: CString -> CString -> IO CJSONString
+foreign export ccall "chat_encrypt_file" cChatEncryptFile :: StablePtr ChatController -> CString -> CString -> IO CJSONString
 
 foreign export ccall "chat_decrypt_file" cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString
 

src/Simplex/Chat/Mobile/File.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
@@ -31,7 +32,9 @@ import Data.Word (Word32, Word8)
 import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
 import Foreign.Ptr
+import Foreign.StablePtr
 import Foreign.Storable (poke, pokeByteOff)
+import Simplex.Chat.Controller (ChatController (..))
 import Simplex.Chat.Mobile.Shared
 import Simplex.Chat.Util (chunkSize, encryptFile)
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..))
@@ -39,7 +42,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Util (catchAll)
-import UnliftIO (Handle, IOMode (..), withFile)
+import UnliftIO (Handle, IOMode (..), atomically, withFile)
 
 data WriteFileResult
   = WFResult {cryptoArgs :: CryptoFileArgs}
@@ -47,16 +50,17 @@ data WriteFileResult
 
 $(JQ.deriveToJSON (sumTypeJSON $ dropPrefix "WF") ''WriteFileResult)
 
-cChatWriteFile :: CString -> Ptr Word8 -> CInt -> IO CJSONString
+cChatWriteFile :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CJSONString
-cChatWriteFile cPath ptr len = do
+cChatWriteFile cc cPath ptr len = do
+  c <- deRefStablePtr cc
   path <- peekCString cPath
   s <- getByteString ptr len
-  r <- chatWriteFile path s
+  r <- chatWriteFile c path s
   newCStringFromLazyBS $ J.encode r
 
-chatWriteFile :: FilePath -> ByteString -> IO WriteFileResult
+chatWriteFile :: ChatController -> FilePath -> ByteString -> IO WriteFileResult
-chatWriteFile path s = do
+chatWriteFile ChatController {random} path s = do
-  cfArgs <- CF.randomArgs
+  cfArgs <- atomically $ CF.randomArgs random
   let file = CryptoFile path $ Just cfArgs
   either WFError (\_ -> WFResult cfArgs)
     <$> runCatchExceptT (withExceptT show $ CF.writeFile file $ LB.fromStrict s)
@@ -87,19 +91,20 @@ chatReadFile path keyStr nonceStr = runCatchExceptT $ do
   let file = CryptoFile path $ Just $ CFArgs key nonce
   withExceptT show $ CF.readFile file
 
-cChatEncryptFile :: CString -> CString -> IO CJSONString
+cChatEncryptFile :: StablePtr ChatController -> CString -> CString -> IO CJSONString
-cChatEncryptFile cFromPath cToPath = do
+cChatEncryptFile cc cFromPath cToPath = do
+  c <- deRefStablePtr cc
   fromPath <- peekCString cFromPath
   toPath <- peekCString cToPath
-  r <- chatEncryptFile fromPath toPath
+  r <- chatEncryptFile c fromPath toPath
   newCAString . LB'.unpack $ J.encode r
 
-chatEncryptFile :: FilePath -> FilePath -> IO WriteFileResult
+chatEncryptFile :: ChatController -> FilePath -> FilePath -> IO WriteFileResult
-chatEncryptFile fromPath toPath =
+chatEncryptFile ChatController {random} fromPath toPath =
   either WFError WFResult <$> runCatchExceptT encrypt
   where
     encrypt = do
-      cfArgs <- liftIO CF.randomArgs
+      cfArgs <- atomically $ CF.randomArgs random
       encryptFile fromPath toPath cfArgs
       pure cfArgs
 

src/Simplex/Chat/Mobile/WebRTC.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Simplex.Chat.Mobile.WebRTC
   ( cChatEncryptMedia,
@@ -21,11 +22,14 @@ import Data.Either (fromLeft)
 import Data.Word (Word8)
 import Foreign.C (CInt, CString, newCAString)
 import Foreign.Ptr (Ptr)
+import Foreign.StablePtr
+import Simplex.Chat.Controller (ChatController (..))
 import Simplex.Chat.Mobile.Shared
 import qualified Simplex.Messaging.Crypto as C
+import UnliftIO (atomically)
 
-cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
+cChatEncryptMedia :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CString
-cChatEncryptMedia = cTransformMedia chatEncryptMedia
+cChatEncryptMedia = cTransformMedia . chatEncryptMedia
 
 cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString
 cChatDecryptMedia = cTransformMedia chatDecryptMedia
@@ -39,11 +43,12 @@ cTransformMedia f cKey cFrame cFrameLen = do
     putFrame s = when (B.length s <= fromIntegral cFrameLen) $ putByteString cFrame s
 {-# INLINE cTransformMedia #-}
 
-chatEncryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString
+chatEncryptMedia :: StablePtr ChatController -> ByteString -> ByteString -> ExceptT String IO ByteString
-chatEncryptMedia keyStr frame = do
+chatEncryptMedia cc keyStr frame = do
+  ChatController {random} <- liftIO $ deRefStablePtr cc
   len <- checkFrameLen frame
   key <- decodeKey keyStr
-  iv <- liftIO C.randomGCMIV
+  iv <- atomically $ C.randomGCMIV random
   (tag, frame') <- withExceptT show $ C.encryptAESNoPad key iv $ B.take len frame
   pure $ frame' <> BA.convert (C.unAuthTag tag) <> C.unGCMIV iv
 

src/Simplex/Chat/Remote.hs

@@ -142,7 +142,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
     Just (rhId, multicast) -> do
       rh@RemoteHost {hostPairing} <- withStore $ \db -> getRemoteHost db rhId
       pure (RHId rhId, multicast, Just $ remoteHostInfo rh $ Just RHSStarting, hostPairing) -- get from the database, start multicast if requested
-    Nothing -> (RHNew,False,Nothing,) <$> rcNewHostPairing
+    Nothing -> withAgent $ \a -> (RHNew,False,Nothing,) <$> rcNewHostPairing a
   sseq <- startRemoteHostSession rhKey
   ctrlAppInfo <- mkCtrlAppInfo
   (localAddrs, invitation, rchClient, vars) <- handleConnectError rhKey sseq . withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast rcAddrPrefs_ port_
@@ -352,7 +352,7 @@ storeRemoteFile rhId encrypted_ localPath = do
       tmpDir <- getChatTempDirectory
       createDirectoryIfMissing True tmpDir
       tmpFile <- tmpDir `uniqueCombine` takeFileName localPath
-      cfArgs <- liftIO CF.randomArgs
+      cfArgs <- atomically . CF.randomArgs =<< asks random
       liftError (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs
       pure $ CryptoFile tmpFile $ Just cfArgs
 

src/Simplex/Chat/Remote/Protocol.hs

@@ -78,7 +78,7 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 mkRemoteHostClient :: ChatMonad m => HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> m RemoteHostClient
 mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {encoding, deviceName, encryptFiles} = do
-  drg <- asks $ agentDRG . smpAgent
+  drg <- asks random
   counter <- newTVarIO 1
   let HostSessKeys {hybridKey, idPrivKey, sessPrivKey} = sessionKeys
       signatures = RSSign {idPrivKey, sessPrivKey}
@@ -95,7 +95,7 @@ mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {enc
 
 mkCtrlRemoteCrypto :: ChatMonad m => CtrlSessKeys -> SessionCode -> m RemoteCrypto
 mkCtrlRemoteCrypto CtrlSessKeys {hybridKey, idPubKey, sessPubKey} sessionCode = do
-  drg <- asks $ agentDRG . smpAgent
+  drg <- asks random
   counter <- newTVarIO 1
   let signatures = RSVerify {idPubKey, sessPubKey}
   pure RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures}

src/Simplex/Chat/Remote/Transport.hs

@@ -24,7 +24,7 @@ type EncryptedFile = ((Handle, Word32), C.CbNonce, LC.SbState)
 
 prepareEncryptedFile :: RemoteCrypto -> (Handle, Word32) -> ExceptT RemoteProtocolError IO EncryptedFile
 prepareEncryptedFile RemoteCrypto {drg, hybridKey} f = do
-  nonce <- atomically $ C.pseudoRandomCbNonce drg
+  nonce <- atomically $ C.randomCbNonce drg
   sbState <- liftEitherWith (const $ PRERemoteControl RCEEncrypt) $ LC.kcbInit hybridKey nonce
   pure (f, nonce, sbState)
 

src/Simplex/Chat/Store/Shared.hs

@@ -15,7 +15,7 @@ import qualified Control.Exception as E
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
-import Crypto.Random (ChaChaDRG, randomBytesGenerate)
+import Crypto.Random (ChaChaDRG)
 import qualified Data.Aeson.TH as J
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
@@ -35,6 +35,7 @@ import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Protocol (SubscriptionMode (..))
 import Simplex.Messaging.Util (allFinally)
@@ -389,7 +390,4 @@ createWithRandomBytes size gVar create = tryCreate 3
           | otherwise -> throwError . SEInternalError $ show e
 
 encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
-encodedRandomBytes gVar = fmap B64.encode . randomBytes gVar
+encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar
-
-randomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
-randomBytes gVar = atomically . stateTVar gVar . randomBytesGenerate

tests/ChatTests/Files.hs

@@ -1094,7 +1094,7 @@ testXFTPFileTransferEncrypted =
     let srcPath = "./tests/tmp/alice/test.pdf"
     createDirectoryIfMissing True "./tests/tmp/alice/"
     createDirectoryIfMissing True "./tests/tmp/bob/"
-    WFResult cfArgs <- chatWriteFile srcPath src
+    WFResult cfArgs <- chatWriteFile (chatController alice) srcPath src
     let fileJSON = LB.unpack $ J.encode $ CryptoFile srcPath $ Just cfArgs
     withXFTPServer $ do
       connectUsers alice bob

tests/MobileTests.hs

@@ -8,8 +8,8 @@
 module MobileTests where
 
 import ChatTests.Utils
+import Control.Concurrent.STM
 import Control.Monad.Except
-import Crypto.Random (getRandomBytes)
 import Data.Aeson (FromJSON)
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
@@ -22,8 +22,10 @@ import Data.Word (Word8, Word32)
 import Foreign.C
 import Foreign.Marshal.Alloc (mallocBytes)
 import Foreign.Ptr
+import Foreign.StablePtr
 import Foreign.Storable (peek)
 import GHC.IO.Encoding (setLocaleEncoding, setFileSystemEncoding, setForeignEncoding)
+import Simplex.Chat.Controller (ChatController (..))
 import Simplex.Chat.Mobile
 import Simplex.Chat.Mobile.File
 import Simplex.Chat.Mobile.Shared
@@ -226,25 +228,29 @@ testChatApi tmp = do
   chatParseMarkdown "*hello*" `shouldBe` parsedMarkdown
 
 testMediaApi :: HasCallStack => FilePath -> IO ()
-testMediaApi _ = do
+testMediaApi tmp = do
-  key :: ByteString <- getRandomBytes 32
+  Right c@ChatController {random = g} <- chatMigrateInit (tmp </> "1") "" "yesUp"
-  frame <- getRandomBytes 100
+  cc <- newStablePtr c
+  key <- atomically $ C.randomBytes 32 g
+  frame <- atomically $ C.randomBytes 100 g
   let keyStr = strEncode key
       reserved = B.replicate (C.authTagSize + C.gcmIVSize) 0
       frame' = frame <> reserved
-  Right encrypted <- runExceptT $ chatEncryptMedia keyStr frame'
+  Right encrypted <- runExceptT $ chatEncryptMedia cc keyStr frame'
   encrypted `shouldNotBe` frame'
   B.length encrypted `shouldBe` B.length frame'
   runExceptT (chatDecryptMedia keyStr encrypted) `shouldReturn` Right frame'
 
 testMediaCApi :: HasCallStack => FilePath -> IO ()
-testMediaCApi _ = do
+testMediaCApi tmp = do
-  key :: ByteString <- getRandomBytes 32
+  Right c@ChatController {random = g} <- chatMigrateInit (tmp </> "1") "" "yesUp"
-  frame <- getRandomBytes 100
+  cc <- newStablePtr c
+  key <- atomically $ C.randomBytes 32 g
+  frame <- atomically $ C.randomBytes 100 g
   let keyStr = strEncode key
       reserved = B.replicate (C.authTagSize + C.gcmIVSize) 0
       frame' = frame <> reserved
-  encrypted <- test cChatEncryptMedia keyStr frame'
+  encrypted <- test (cChatEncryptMedia cc) keyStr frame'
   encrypted `shouldNotBe` frame'
   test cChatDecryptMedia keyStr encrypted `shouldReturn` frame'
   where
@@ -266,6 +272,7 @@ instance FromJSON ReadFileResult where
 
 testFileCApi :: FilePath -> FilePath -> IO ()
 testFileCApi fileName tmp = do
+  cc <- mkCCPtr tmp
   src <- B.readFile "./tests/fixtures/test.pdf"
   let path = tmp </> (fileName <> ".pdf")
   cPath <- newCString path
@@ -273,7 +280,7 @@ testFileCApi fileName tmp = do
       cLen = fromIntegral len
   ptr <- mallocBytes $ B.length src
   putByteString ptr src
-  r <- peekCAString =<< cChatWriteFile cPath ptr cLen
+  r <- peekCAString =<< cChatWriteFile cc cPath ptr cLen
   Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r
   let encryptedFile = CryptoFile path $ Just cfArgs
   CF.getFileContentsSize encryptedFile `shouldReturn` fromIntegral (B.length src)
@@ -292,7 +299,7 @@ testMissingFileCApi :: FilePath -> IO ()
 testMissingFileCApi tmp = do
   let path = tmp </> "missing_file"
   cPath <- newCString path
-  CFArgs key nonce <- CF.randomArgs
+  CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom
   cKey <- encodedCString key
   cNonce <- encodedCString nonce
   ptr <- cChatReadFile cPath cKey cNonce
@@ -302,13 +309,14 @@ testMissingFileCApi tmp = do
 
 testFileEncryptionCApi :: FilePath -> FilePath -> IO ()
 testFileEncryptionCApi fileName tmp = do
+  cc <- mkCCPtr tmp
   let fromPath = tmp </> (fileName <> ".source.pdf")
   copyFile "./tests/fixtures/test.pdf" fromPath
   src <- B.readFile fromPath
   cFromPath <- newCString fromPath
   let toPath = tmp </> (fileName <> ".encrypted.pdf")
   cToPath <- newCString toPath
-  r <- peekCAString =<< cChatEncryptFile cFromPath cToPath
+  r <- peekCAString =<< cChatEncryptFile cc cFromPath cToPath
   Just (WFResult cfArgs@(CFArgs key nonce)) <- jDecode r
   CF.getFileContentsSize (CryptoFile toPath $ Just cfArgs) `shouldReturn` fromIntegral (B.length src)
   cKey <- encodedCString key
@@ -320,14 +328,15 @@ testFileEncryptionCApi fileName tmp = do
 
 testMissingFileEncryptionCApi :: FilePath -> IO ()
 testMissingFileEncryptionCApi tmp = do
+  cc <- mkCCPtr tmp
   let fromPath = tmp </> "missing_file.source.pdf"
       toPath = tmp </> "missing_file.encrypted.pdf"
   cFromPath <- newCString fromPath
   cToPath <- newCString toPath
-  r <- peekCAString =<< cChatEncryptFile cFromPath cToPath
+  r <- peekCAString =<< cChatEncryptFile cc cFromPath cToPath
   Just (WFError err) <- jDecode r
   err `shouldContain` fromPath
-  CFArgs key nonce <- CF.randomArgs
+  CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom
   cKey <- encodedCString key
   cNonce <- encodedCString nonce
   let toPath' = tmp </> "missing_file.decrypted.pdf"
@@ -335,6 +344,9 @@ testMissingFileEncryptionCApi tmp = do
   err' <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath'
   err' `shouldContain` toPath
 
+mkCCPtr :: FilePath -> IO (StablePtr ChatController)
+mkCCPtr tmp = either (error . show) newStablePtr =<< chatMigrateInit (tmp </> "1") "" "yesUp"
+
 testValidNameCApi :: FilePath -> IO ()
 testValidNameCApi _ = do
   let goodName = "Джон Доу 👍"

tests/RemoteTests.hs

@@ -11,18 +11,14 @@ import Control.Logger.Simple
 import qualified Data.Aeson as J
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy.Char8 as LB
-import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
-import qualified Network.TLS as TLS
 import Simplex.Chat.Archive (archiveFilesFolder)
 import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..), versionNumber)
 import qualified Simplex.Chat.Controller as Controller
 import Simplex.Chat.Mobile.File
 import Simplex.Chat.Remote.Types
-import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Encoding.String (strEncode)
-import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials)
 import Simplex.Messaging.Util
 import System.FilePath ((</>))
 import Test.Hspec
@@ -571,12 +567,6 @@ contactBob desktop bob = do
     (desktop <## "bob (Bob): contact is connected")
     (bob <## "alice (Alice): contact is connected")
 
-genTestCredentials :: IO (C.KeyHash, TLS.Credentials)
-genTestCredentials = do
-  caCreds <- liftIO $ genCredentials Nothing (0, 24) "CA"
-  sessionCreds <- liftIO $ genCredentials (Just caCreds) (0, 24) "Session"
-  pure . tlsCredentials $ sessionCreds :| [caCreds]
-
 stopDesktop :: HasCallStack => TestCC -> TestCC -> IO ()
 stopDesktop mobile desktop = do
   logWarn "stopping via desktop"

tests/Test.hs

@@ -26,7 +26,7 @@ main = do
     describe "JSON Tests" jsonTests
     describe "SimpleX chat view" viewTests
     describe "SimpleX chat protocol" protocolTests
-    describe "WebRTC encryption" webRTCTests
+    around tmpBracket $ describe "WebRTC encryption" webRTCTests
     describe "Valid names" validNameTests
     around testBracket $ do
       describe "Mobile API Tests" mobileTests
@@ -35,10 +35,11 @@ main = do
       xdescribe'' "SimpleX Directory service bot" directoryServiceTests
       describe "Remote session" remoteTests
   where
-    testBracket test = do
+    testBracket test = withSmpServer $ tmpBracket test
+    tmpBracket test = do
       t <- getSystemTime
       let ts = show (systemSeconds t) <> show (systemNanoseconds t)
-      withSmpServer $ withTmpFiles $ withTempDirectory "tests/tmp" ts test
+      withTmpFiles $ withTempDirectory "tests/tmp" ts test
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}

tests/WebRTCTests.hs

@@ -1,36 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module WebRTCTests where
 
 import Control.Monad.Except
 import Crypto.Random (getRandomBytes)
 import qualified Data.ByteString.Base64.URL as U
 import qualified Data.ByteString.Char8 as B
+import Foreign.StablePtr
+import Simplex.Chat.Mobile
 import Simplex.Chat.Mobile.WebRTC
 import qualified Simplex.Messaging.Crypto as C
+import System.FilePath ((</>))
 import Test.Hspec
 
-webRTCTests :: Spec
+webRTCTests :: SpecWith FilePath
 webRTCTests = describe "WebRTC crypto" $ do
-  it "encrypts and decrypts media" $ do
+  it "encrypts and decrypts media" $ \tmp -> do
+    Right c <- chatMigrateInit (tmp </> "1") "" "yesUp"
+    cc <- newStablePtr c
     key <- U.encode <$> getRandomBytes 32
     frame <- getRandomBytes 1000
-    Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL'
+    Right frame' <- runExceptT $ chatEncryptMedia cc key $ frame <> B.replicate reservedSize '\NUL'
     B.length frame' `shouldBe` B.length frame + reservedSize
     Right frame'' <- runExceptT $ chatDecryptMedia key frame'
     frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL'
-  it "should fail on invalid frame size" $ do
+  it "should fail on invalid frame size" $ \tmp -> do
+    Right c <- chatMigrateInit (tmp </> "1") "" "yesUp"
+    cc <- newStablePtr c
     key <- U.encode <$> getRandomBytes 32
     frame <- getRandomBytes 10
-    runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "frame has no [reserved space for] IV and/or auth tag"
+    runExceptT (chatEncryptMedia cc key frame) `shouldReturn` Left "frame has no [reserved space for] IV and/or auth tag"
     runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "frame has no [reserved space for] IV and/or auth tag"
-  it "should fail on invalid key" $ do
+  it "should fail on invalid key" $ \tmp -> do
+    Right c <- chatMigrateInit (tmp </> "1") "" "yesUp"
+    cc <- newStablePtr c
     let key = B.replicate 32 '#'
     frame <- (<> B.replicate reservedSize '\NUL') <$> getRandomBytes 100
-    runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0"
+    runExceptT (chatEncryptMedia cc key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0"
     runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0"
-  it "should fail on invalid auth tag" $ do
+  it "should fail on invalid auth tag" $ \tmp -> do
+    Right c <- chatMigrateInit (tmp </> "1") "" "yesUp"
+    cc <- newStablePtr c
     key <- U.encode <$> getRandomBytes 32
     frame <- getRandomBytes 1000
-    Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL'
+    Right frame' <- runExceptT $ chatEncryptMedia cc key $ frame <> B.replicate reservedSize '\NUL'
     Right frame'' <- runExceptT $ chatDecryptMedia key frame'
     frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL'
     let (encFrame, rest) = B.splitAt (B.length frame' - reservedSize) frame