core: correctly handle errors in createWithRandomId/Bytes for postgres (reuse withSavepoint from simplexmq) (#6578)

This commit is contained in:
spaced4ndy
2026-01-15 15:18:15 +00:00
committed by GitHub
parent a8d7a9b389
commit 2d64365d8c
5 changed files with 23 additions and 38 deletions
+1 -1
View File
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 58212c421aa6abb6ad894b8231d8a380849b704b
tag: ca26c69937083deee43b8b2200ec9ef4c004ceac
source-repository-package
type: git
+1 -1
View File
@@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."58212c421aa6abb6ad894b8231d8a380849b704b" = "1awgvhqfi7gv3xl10h21a6w2hhqc48pq6yq4f83awg1zxkh3hiqn";
"https://github.com/simplex-chat/simplexmq.git"."ca26c69937083deee43b8b2200ec9ef4c004ceac" = "1p7jhxcbn95kddfwa5rjpzfx78fzic03wmy9dmh1mj3j14vyfn02";
"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";
+5 -5
View File
@@ -1133,7 +1133,7 @@ getGroupInvitation db vr user groupId =
createNewContactMember :: DB.Connection -> TVar 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 -> runExceptT $ do
createWithRandomId' db gVar $ \memId -> runExceptT $ do
createdAt <- liftIO getCurrentTime
member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
void $ liftIO $ createMemberConnection_ db userId groupMemberId agentConnId connChatVersion peerChatVRange Nothing 0 createdAt subMode
@@ -1188,7 +1188,7 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
createNewContactMemberAsync :: DB.Connection -> TVar 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 -> runExceptT $ do
createWithRandomId' db gVar $ \memId -> runExceptT $ do
createdAt <- liftIO getCurrentTime
insertMember_ (MemberId memId) createdAt
groupMemberId <- liftIO $ insertedRowId db
@@ -1233,7 +1233,7 @@ createJoiningMember
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(displayName, fullName, shortDescr, image, contactLink, userId, preferences, currentTs, currentTs)
profileId <- liftIO $ insertedRowId db
createWithRandomId' gVar $ \memId -> runExceptT $ do
createWithRandomId' db gVar $ \memId -> runExceptT $ do
insertMember_ ldn profileId (MemberId memId) currentTs
groupMemberId <- liftIO $ insertedRowId db
pure (groupMemberId, MemberId memId)
@@ -1318,7 +1318,7 @@ createBusinessRequestGroup
VersionRange minV maxV = cReqChatVRange
insertClientMember_ currentTs groupId membership =
ExceptT . withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
createWithRandomId' gVar $ \memId -> runExceptT $ do
createWithRandomId' db gVar $ \memId -> runExceptT $ do
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
liftIO $
DB.execute
@@ -1950,7 +1950,7 @@ getMatchingMemberContacts db vr user@User {userId} GroupMember {memberProfile =
createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> ContactOrMember -> ExceptT StoreError IO (Probe, Int64)
createSentProbe db gVar userId to =
createWithRandomBytes 32 gVar $ \probe -> do
createWithRandomBytes db 32 gVar $ \probe -> do
currentTs <- getCurrentTime
let (ctId, gmId) = contactOrMemberIds to
DB.execute
+6 -3
View File
@@ -174,6 +174,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, firstRow', maybeFirstRow)
import Simplex.Messaging.Agent.Store.Common (withSavepoint)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
@@ -219,7 +220,7 @@ deleteGroupChatItemsMessages db User {userId} GroupInfo {groupId} = do
createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage
createNewSndMessage db gVar connOrGroupId chatMsgEvent encodeMessage =
createWithRandomId' gVar $ \sharedMsgId ->
createWithRandomId' db gVar $ \sharedMsgId ->
case encodeMessage (SharedMsgId sharedMsgId) of
ECMLarge -> pure $ Left SELargeMsg
ECMEncoded msgBody -> do
@@ -2700,12 +2701,14 @@ updateGroupCIMentions :: DB.Connection -> GroupInfo -> ChatItem 'CTGroup d -> Ma
updateGroupCIMentions db g ci@ChatItem {mentions} mentions'
| mentions' == mentions = pure ci
| otherwise = do
unless (null mentions) $ deleteMentions
unless (null mentions) deleteMentions
if null mentions'
then pure ci
else -- This is a fallback for the error that should not happen in practice.
-- In theory, it may happen in item mentions in database are different from item record.
createMentions `E.catch` \e -> if constraintError e then deleteMentions >> createMentions else E.throwIO e
withSavepoint db "create_mentions" createMentions >>= \case
Right r -> pure r
Left e -> if constraintError e then deleteMentions >> createMentions else E.throwIO e
where
deleteMentions = DB.execute db "DELETE FROM chat_item_mentions WHERE chat_item_id = ?" (Only $ chatItemId' ci)
createMentions = createGroupCIMentions db g ci mentions'
+10 -28
View File
@@ -40,6 +40,7 @@ import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (AConnShortLink (..), AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionRequestUri, CreatedConnLink (..), UserId, connMode)
import Simplex.Messaging.Agent.Store (AnyStoreError (..))
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.Common (withSavepoint)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
@@ -597,42 +598,23 @@ withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreate
|]
(ldn, displayName, ldnSuffix, userId, ts, ts)
-- Execute an action within a savepoint (PostgreSQL only).
-- On success, releases the savepoint. On error, rolls back to the savepoint
-- to restore the transaction to a usable state before returning the error.
withSavepoint :: DB.Connection -> Query -> IO a -> IO (Either SQLError a)
withSavepoint db name action =
#if defined(dbPostgres)
do
DB.execute_ db $ "SAVEPOINT " <> name
E.try action >>= \case
Right r -> do
DB.execute_ db $ "RELEASE SAVEPOINT " <> name
pure $ Right r
Left e -> do
DB.execute_ db $ "ROLLBACK TO SAVEPOINT " <> name
pure $ Left e
#else
E.try action
#endif
createWithRandomId :: forall a. DB.Connection -> TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
createWithRandomId db = createWithRandomBytes db 12
createWithRandomId :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
createWithRandomId = createWithRandomBytes 12
createWithRandomId' :: forall a. DB.Connection -> TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' db = createWithRandomBytes' db 12
createWithRandomId' :: forall a. TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomId' = createWithRandomBytes' 12
createWithRandomBytes :: forall a. DB.Connection -> Int -> TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
createWithRandomBytes db size gVar create = createWithRandomBytes' db size gVar (fmap Right . create)
createWithRandomBytes :: forall a. Int -> TVar 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' size gVar create = tryCreate 3
createWithRandomBytes' :: forall a. DB.Connection -> Int -> TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
createWithRandomBytes' db size gVar create = tryCreate 3
where
tryCreate :: Int -> ExceptT StoreError IO a
tryCreate 0 = throwError SEUniqueID
tryCreate n = do
id' <- liftIO $ encodedRandomBytes gVar size
liftIO (E.try $ create id') >>= \case
liftIO (withSavepoint db "create_random_id" (create id')) >>= \case
Right x -> liftEither x
Left e
| constraintError e -> tryCreate (n - 1)