From c418e91970a123c067034f1b864c300bcd0b2db6 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Thu, 29 Aug 2024 11:45:28 +0100 Subject: [PATCH] core: move DRG state to IORefs --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 17 +++++++++-------- src/Simplex/Chat/Controller.hs | 3 ++- src/Simplex/Chat/Mobile/File.hs | 6 +++--- src/Simplex/Chat/Mobile/WebRTC.hs | 3 +-- src/Simplex/Chat/Remote.hs | 2 +- src/Simplex/Chat/Remote/Transport.hs | 2 +- src/Simplex/Chat/Remote/Types.hs | 3 ++- src/Simplex/Chat/Store/Groups.hs | 12 ++++++------ src/Simplex/Chat/Store/Messages.hs | 3 ++- src/Simplex/Chat/Store/Shared.hs | 14 +++++++------- tests/ChatClient.hs | 1 + tests/ChatTests/Utils.hs | 4 ++-- tests/MobileTests.hs | 13 ++++++------- 15 files changed, 45 insertions(+), 42 deletions(-) diff --git a/cabal.project b/cabal.project index 9bf39c2841..7067d48be9 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 56986f82c89b04beae84a61208db8b55eb0098e3 + tag: f940ce234ebc3831c3bbedb3fc653907cdb7a064 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 0569199515..cf46df031f 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."56986f82c89b04beae84a61208db8b55eb0098e3" = "0vqvdnm560xrfq7kjsghdbpk67vn4hcdpp58dfqgh9l2c9f79bin"; + "https://github.com/simplex-chat/simplexmq.git"."f940ce234ebc3831c3bbedb3fc653907cdb7a064" = "16y4ix3v7sd8qd1qfrxk0nshvh0p1a415y2sw5am2jhx0mjr8w1q"; "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"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index ac1d0ac601..0725ab1de8 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -40,6 +40,7 @@ import Data.Either (fromRight, lefts, partitionEithers, rights) import Data.Fixed (div') import Data.Functor (($>)) import Data.Functor.Identity +import Data.IORef (IORef) import Data.Int (Int64) import Data.List (find, foldl', isSuffixOf, mapAccumL, partition, sortOn) import Data.List.NonEmpty (NonEmpty (..), nonEmpty, toList, (<|)) @@ -1057,7 +1058,7 @@ processChatCommand' vr = \case fsNewPath <- liftIO $ filesFolder `uniqueCombine` fileName liftIO $ B.writeFile fsNewPath "" -- create empty file encrypt <- chatReadVar encryptLocalFiles - cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing + cfArgs <- if encrypt then Just <$> (liftIO . CF.randomArgs =<< asks random) else pure Nothing let toCF = CryptoFile fsNewPath cfArgs -- to keep forwarded file in case original is deleted liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ copyCryptoFile (fromCF {filePath = fsFromPath} :: CryptoFile) toCF @@ -1264,9 +1265,9 @@ processChatCommand' vr = \case calls <- asks currentCalls withContactLock "sendCallInvitation" contactId $ do g <- asks random - callId <- atomically $ CallId <$> C.randomBytes 16 g + callId <- liftIO $ CallId <$> C.randomBytes 16 g callUUID <- UUID.toText <$> liftIO V4.nextRandom - dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing + dhKeyPair <- liftIO $ 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 user ct (XCallInv callId invitation) @@ -2234,7 +2235,7 @@ processChatCommand' vr = \case SetFileToReceive fileId userApprovedRelays encrypted_ -> withUser $ \_ -> do withFileLock "setFileToReceive" fileId . procCmd $ do encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles - cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing + cfArgs <- if encrypt then Just <$> (liftIO . CF.randomArgs =<< asks random) else pure Nothing withStore' $ \db -> setRcvFileToReceive db fileId userApprovedRelays cfArgs ok_ CancelFile fileId -> withUser $ \user@User {userId} -> @@ -2719,7 +2720,7 @@ processChatCommand' vr = \case forM_ (timed_ >>= timedDeleteAt') $ startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) drgRandomBytes :: Int -> CM ByteString - drgRandomBytes n = asks random >>= atomically . C.randomBytes n + drgRandomBytes n = asks random >>= liftIO . C.randomBytes n privateGetUser :: UserId -> CM User privateGetUser userId = tryChatError (withStore (`getUser` userId)) >>= \case @@ -3244,7 +3245,7 @@ toFSFilePath f = setFileToEncrypt :: RcvFileTransfer -> CM RcvFileTransfer setFileToEncrypt ft@RcvFileTransfer {fileId} = do - cfArgs <- atomically . CF.randomArgs =<< asks random + cfArgs <- liftIO . CF.randomArgs =<< asks random withStore' $ \db -> setFileCryptoArgs db fileId cfArgs pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs} @@ -5956,7 +5957,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = if featureAllowed SCFCalls forContact ct then do g <- asks random - dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing + dhKeyPair <- liftIO $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing ci <- saveCallItem CISCallPending callUUID <- UUID.toText <$> liftIO V4.nextRandom let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair)) @@ -6875,7 +6876,7 @@ createSndMessages idsEvents = do vr <- chatVersionRange' withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents where - createMsg :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> (ConnOrGroupId, ChatMsgEvent e) -> IO (Either ChatError SndMessage) + createMsg :: DB.Connection -> IORef ChaChaDRG -> VersionRangeChat -> (ConnOrGroupId, ChatMsgEvent e) -> IO (Either ChatError SndMessage) createMsg db g vr (connOrGroupId, evnt) = runExceptT $ do withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId evnt encodeMessage where diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index c4f056c778..5bc47e2373 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -36,6 +36,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Char (ord) import Data.Constraint (Dict (..)) +import Data.IORef (IORef) import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) @@ -209,7 +210,7 @@ data ChatController = ChatController agentAsync :: TVar (Maybe (Async (), Maybe (Async ()))), chatStore :: SQLiteStore, chatStoreChanged :: TVar Bool, -- if True, chat should be fully restarted - random :: TVar ChaChaDRG, + random :: IORef ChaChaDRG, eventSeq :: TVar Int, inputQ :: TBQueue String, outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse), diff --git a/src/Simplex/Chat/Mobile/File.hs b/src/Simplex/Chat/Mobile/File.hs index afbb1bc8c9..1b77a975f2 100644 --- a/src/Simplex/Chat/Mobile/File.hs +++ b/src/Simplex/Chat/Mobile/File.hs @@ -42,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 (..), atomically, withFile) +import UnliftIO (Handle, IOMode (..), withFile) data WriteFileResult = WFResult {cryptoArgs :: CryptoFileArgs} @@ -60,7 +60,7 @@ cChatWriteFile cc cPath ptr len = do chatWriteFile :: ChatController -> FilePath -> ByteString -> IO WriteFileResult chatWriteFile ChatController {random} path s = do - cfArgs <- atomically $ CF.randomArgs random + cfArgs <- CF.randomArgs random let file = CryptoFile path $ Just cfArgs either WFError (\_ -> WFResult cfArgs) <$> runCatchExceptT (withExceptT show $ CF.writeFile file $ LB.fromStrict s) @@ -104,7 +104,7 @@ chatEncryptFile ChatController {random} fromPath toPath = either WFError WFResult <$> runCatchExceptT encrypt where encrypt = do - cfArgs <- atomically $ CF.randomArgs random + cfArgs <- liftIO $ CF.randomArgs random encryptFile fromPath toPath cfArgs pure cfArgs diff --git a/src/Simplex/Chat/Mobile/WebRTC.hs b/src/Simplex/Chat/Mobile/WebRTC.hs index 537388b18b..47157cf139 100644 --- a/src/Simplex/Chat/Mobile/WebRTC.hs +++ b/src/Simplex/Chat/Mobile/WebRTC.hs @@ -26,7 +26,6 @@ import Foreign.StablePtr import Simplex.Chat.Controller (ChatController (..)) import Simplex.Chat.Mobile.Shared import qualified Simplex.Messaging.Crypto as C -import UnliftIO (atomically) cChatEncryptMedia :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CString cChatEncryptMedia = cTransformMedia . chatEncryptMedia @@ -48,7 +47,7 @@ chatEncryptMedia cc keyStr frame = do ChatController {random} <- liftIO $ deRefStablePtr cc len <- checkFrameLen frame key <- decodeKey keyStr - iv <- atomically $ C.randomGCMIV random + iv <- liftIO $ 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 diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 276baf56e8..7c61d6d9e2 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -352,7 +352,7 @@ storeRemoteFile rhId encrypted_ localPath = do tmpDir <- lift getChatTempDirectory createDirectoryIfMissing True tmpDir tmpFile <- liftIO $ tmpDir `uniqueCombine` takeFileName localPath - cfArgs <- atomically . CF.randomArgs =<< asks random + cfArgs <- liftIO . CF.randomArgs =<< asks random liftError (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs pure $ CryptoFile tmpFile $ Just cfArgs diff --git a/src/Simplex/Chat/Remote/Transport.hs b/src/Simplex/Chat/Remote/Transport.hs index 774aeccda2..4c0f47d284 100644 --- a/src/Simplex/Chat/Remote/Transport.hs +++ b/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.randomCbNonce drg + nonce <- liftIO $ C.randomCbNonce drg sbState <- liftEitherWith (const $ PRERemoteControl RCEEncrypt) $ LC.kcbInit hybridKey nonce pure (f, nonce, sbState) diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs index d85dde9e87..dc8ff3597c 100644 --- a/src/Simplex/Chat/Remote/Types.hs +++ b/src/Simplex/Chat/Remote/Types.hs @@ -16,6 +16,7 @@ import Control.Exception (Exception) import Crypto.Random (ChaChaDRG) import qualified Data.Aeson.TH as J import Data.ByteString (ByteString) +import Data.IORef (IORef) import Data.Int (Int64) import Data.Text (Text) import Data.Word (Word16) @@ -40,7 +41,7 @@ data RemoteHostClient = RemoteHostClient } data RemoteCrypto = RemoteCrypto - { drg :: TVar ChaChaDRG, + { drg :: IORef ChaChaDRG, counter :: TVar Int64, sessionCode :: ByteString, hybridKey :: KEMHybridSecret, diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 55847114ca..5ebb727524 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -127,6 +127,7 @@ import Control.Monad.IO.Class import Crypto.Random (ChaChaDRG) import Data.Bifunctor (second) import Data.Either (rights) +import Data.IORef (IORef) import Data.Int (Int64) import Data.List (partition, sortOn) import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) @@ -151,7 +152,6 @@ import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>)) import Simplex.Messaging.Version -import UnliftIO.STM type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe UIThemeEntityOverrides, Maybe CustomData) :. GroupMemberRow @@ -311,7 +311,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow}) -- | creates completely new group with a single member - the current user -createNewGroup :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo +createNewGroup :: DB.Connection -> VersionRangeChat -> IORef ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile fullGroupPreferences = mergeGroupPreferences groupPreferences @@ -798,7 +798,7 @@ getGroupInvitation db vr user groupId = firstRow fromOnly (SEGroupNotFound groupId) $ DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId) -createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember +createNewContactMember :: DB.Connection -> IORef ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile, activeConn = Just Connection {connChatVersion, peerChatVRange}} memberRole agentConnId connRequest subMode = createWithRandomId gVar $ \memId -> do @@ -847,7 +847,7 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, :. (minV, maxV) ) -createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> ExceptT StoreError IO () +createNewContactMemberAsync :: DB.Connection -> IORef ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> ExceptT StoreError IO () createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) chatV peerChatVRange subMode = createWithRandomId gVar $ \memId -> do createdAt <- liftIO getCurrentTime @@ -872,7 +872,7 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo :. (minV, maxV) ) -createAcceptedMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId) +createAcceptedMember :: DB.Connection -> IORef ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId) createAcceptedMember db gVar @@ -1544,7 +1544,7 @@ getMatchingMemberContacts db vr user@User {userId} GroupMember {memberProfile = AND p.display_name = ? AND p.full_name = ? |] -createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> ContactOrMember -> ExceptT StoreError IO (Probe, Int64) +createSentProbe :: DB.Connection -> IORef ChaChaDRG -> UserId -> ContactOrMember -> ExceptT StoreError IO (Probe, Int64) createSentProbe db gVar userId to = createWithRandomBytes 32 gVar $ \probe -> do currentTs <- getCurrentTime diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 6dbd9124c5..1cb7408024 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -124,6 +124,7 @@ import Crypto.Random (ChaChaDRG) import Data.Bifunctor (first) import Data.ByteString.Char8 (ByteString) import Data.Either (fromRight, rights) +import Data.IORef (IORef) import Data.Int (Int64) import Data.List (sortBy) import Data.Maybe (fromMaybe, isJust, mapMaybe) @@ -176,7 +177,7 @@ deleteGroupChatItemsMessages db User {userId} GroupInfo {groupId} = do DB.execute db "DELETE FROM chat_item_reactions WHERE group_id = ?" (Only groupId) DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId) -createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage +createNewSndMessage :: MsgEncodingI e => DB.Connection -> IORef ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage createNewSndMessage db gVar connOrGroupId chatMsgEvent encodeMessage = createWithRandomId' gVar $ \sharedMsgId -> case encodeMessage (SharedMsgId sharedMsgId) of diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index b80e2ce805..c5e736d15f 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -20,6 +20,7 @@ import Crypto.Random (ChaChaDRG) import qualified Data.Aeson.TH as J import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 (ByteString) +import Data.IORef (IORef) import Data.Int (Int64) import Data.Maybe (fromMaybe, isJust, listToMaybe) import Data.Text (Text) @@ -44,7 +45,6 @@ import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (allFinally) import Simplex.Messaging.Version -import UnliftIO.STM data ChatLockEntity = CLInvitation ByteString @@ -488,16 +488,16 @@ withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreate |] (ldn, displayName, ldnSuffix, userId, ts, ts) -createWithRandomId :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a +createWithRandomId :: forall a. IORef ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a createWithRandomId = createWithRandomBytes 12 -createWithRandomId' :: forall a. TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a +createWithRandomId' :: forall a. IORef ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a createWithRandomId' = createWithRandomBytes' 12 -createWithRandomBytes :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a +createWithRandomBytes :: forall a. Int -> IORef ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a createWithRandomBytes size gVar create = createWithRandomBytes' size gVar (fmap Right . create) -createWithRandomBytes' :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a +createWithRandomBytes' :: forall a. Int -> IORef ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a createWithRandomBytes' size gVar create = tryCreate 3 where tryCreate :: Int -> ExceptT StoreError IO a @@ -510,8 +510,8 @@ createWithRandomBytes' size gVar create = tryCreate 3 | SQL.sqlError e == SQL.ErrorConstraint -> tryCreate (n - 1) | otherwise -> throwError . SEInternalError $ show e -encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString -encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar +encodedRandomBytes :: IORef ChaChaDRG -> Int -> IO ByteString +encodedRandomBytes gVar n = B64.encode <$> C.randomBytes n gVar assertNotUser :: DB.Connection -> User -> Contact -> ExceptT StoreError IO () assertNotUser db User {userId} Contact {contactId, localDisplayName} = do diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index e3d557166b..42c12f1c6e 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -442,6 +442,7 @@ smpServerCfg = logStatsStartTime = 0, serverStatsLogFile = "tests/smp-server-stats.daily.log", serverStatsBackupFile = Nothing, + pendingENDInterval = 500000, smpServerVRange = supportedServerSMPRelayVRange, transportConfig = defaultTransportServerConfig {alpn = Just supportedSMPHandshakes}, smpHandshakeTimeout = 1000000, diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 8c022d5bfd..49af9ce93f 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -216,7 +216,7 @@ sndRcvImg pqEnc enabled (cc1, msg, v1) (cc2, v2) = do name1 <- userName cc1 name2 <- userName cc2 g <- C.newRandom - img <- atomically $ B64.encode <$> C.randomBytes lrgLen g + img <- B64.encode <$> C.randomBytes lrgLen g cc1 `send` ("/_send @2 json {\"msgContent\":{\"type\":\"image\",\"text\":\"" <> msg <> "\",\"image\":\"" <> B.unpack img <> "\"}}") cc1 .<## "}}" cc1 <### ([ConsoleString (name2 <> ": quantum resistant end-to-end encryption enabled") | enabled] <> [WithTime ("@" <> name2 <> " " <> msg)]) @@ -231,7 +231,7 @@ sndRcvImg pqEnc enabled (cc1, msg, v1) (cc2, v2) = do genProfileImg :: IO ByteString genProfileImg = do g <- C.newRandom - atomically $ B64.encode <$> C.randomBytes lrgLen g + B64.encode <$> C.randomBytes lrgLen g where lrgLen = maxEncodedInfoLength * 3 `div` 4 - 420 diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index cd4b3980eb..ca466ee1be 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -8,7 +8,6 @@ module MobileTests where import ChatTests.Utils -import Control.Concurrent.STM import Control.Monad.Except import Data.Aeson (FromJSON) import qualified Data.Aeson as J @@ -232,8 +231,8 @@ testMediaApi :: HasCallStack => FilePath -> IO () testMediaApi tmp = do Right c@ChatController {random = g} <- chatMigrateInit (tmp "1") "" "yesUp" cc <- newStablePtr c - key <- atomically $ C.randomBytes 32 g - frame <- atomically $ C.randomBytes 100 g + key <- C.randomBytes 32 g + frame <- C.randomBytes 100 g let keyStr = strEncode key reserved = B.replicate (C.authTagSize + C.gcmIVSize) 0 frame' = frame <> reserved @@ -246,8 +245,8 @@ testMediaCApi :: HasCallStack => FilePath -> IO () testMediaCApi tmp = do Right c@ChatController {random = g} <- chatMigrateInit (tmp "1") "" "yesUp" cc <- newStablePtr c - key <- atomically $ C.randomBytes 32 g - frame <- atomically $ C.randomBytes 100 g + key <- C.randomBytes 32 g + frame <- C.randomBytes 100 g let keyStr = strEncode key reserved = B.replicate (C.authTagSize + C.gcmIVSize) 0 frame' = frame <> reserved @@ -300,7 +299,7 @@ testMissingFileCApi :: FilePath -> IO () testMissingFileCApi tmp = do let path = tmp "missing_file" cPath <- newCString path - CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom + CFArgs key nonce <- CF.randomArgs =<< C.newRandom cKey <- encodedCString key cNonce <- encodedCString nonce ptr <- cChatReadFile cPath cKey cNonce @@ -337,7 +336,7 @@ testMissingFileEncryptionCApi tmp = do r <- peekCAString =<< cChatEncryptFile cc cFromPath cToPath Just (WFError err) <- jDecode r err `shouldContain` fromPath - CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom + CFArgs key nonce <- CF.randomArgs =<< C.newRandom cKey <- encodedCString key cNonce <- encodedCString nonce let toPath' = tmp "missing_file.decrypted.pdf"