mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
core: fully delete group chat items instead of overwriting content (#1154)
This commit is contained in:
JRoberts
GitHub
parent
7f70fe4d64
commit
ef28215284
7 changed files with 149 additions and 124 deletions
|
|
@ -51,6 +51,7 @@ library
|
|||
Simplex.Chat.Migrations.M20220909_commands
|
||||
Simplex.Chat.Migrations.M20220926_connection_alias
|
||||
Simplex.Chat.Migrations.M20220928_settings
|
||||
Simplex.Chat.Migrations.M20221001_shared_msg_id_indices
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Options
|
||||
Simplex.Chat.ProfileGenerator
|
||||
|
|
|
|||
|
|
@ -434,12 +434,12 @@ processChatCommand = \case
|
|||
case (mode, msgDir, itemSharedMsgId) of
|
||||
(CIDMInternal, _, _) -> do
|
||||
deleteCIFile user file
|
||||
toCi <- withStore $ \db -> deleteGroupChatItemInternal db user gInfo itemId
|
||||
toCi <- withStore $ \db -> deleteGroupChatItemLocal db user gInfo itemId CIDMInternal
|
||||
pure $ CRChatItemDeleted (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) toCi
|
||||
(CIDMBroadcast, SMDSnd, Just itemSharedMId) -> do
|
||||
SndMessage {msgId} <- sendGroupMessage gInfo ms (XMsgDel itemSharedMId)
|
||||
void $ sendGroupMessage gInfo ms (XMsgDel itemSharedMId)
|
||||
deleteCIFile user file
|
||||
toCi <- withStore $ \db -> deleteGroupChatItemSndBroadcast db user gInfo itemId msgId
|
||||
toCi <- withStore $ \db -> deleteGroupChatItemLocal db user gInfo itemId CIDMBroadcast
|
||||
setActive $ ActiveG gName
|
||||
pure $ CRChatItemDeleted (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) toCi
|
||||
(CIDMBroadcast, _, _) -> throwChatError CEInvalidChatItemDelete
|
||||
|
|
@ -1112,7 +1112,7 @@ deleteGroupChatItem user gInfo (itemId, fileInfo_) = do
|
|||
forM_ fileInfo_ $ \fileInfo -> do
|
||||
cancelFile user fileInfo `catchError` \_ -> pure ()
|
||||
withFilesFolder $ \filesFolder -> deleteFile filesFolder fileInfo
|
||||
void $ withStore $ \db -> deleteGroupChatItemInternal db user gInfo itemId
|
||||
void $ withStore $ \db -> deleteGroupChatItemLocal db user gInfo itemId CIDMInternal
|
||||
|
||||
-- perform an action only if filesFolder is set (i.e. on mobile devices)
|
||||
withFilesFolder :: ChatMonad m => (FilePath -> m ()) -> m ()
|
||||
|
|
@ -1688,7 +1688,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
|
|||
withAckMessage agentConnId cmdId msgMeta $
|
||||
case chatMsgEvent of
|
||||
XMsgNew mc -> newGroupContentMessage gInfo m mc msg msgMeta
|
||||
XMsgUpdate sharedMsgId mContent -> groupMessageUpdate gInfo m sharedMsgId mContent msg
|
||||
XMsgUpdate sharedMsgId mContent -> groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta
|
||||
XMsgDel sharedMsgId -> groupMessageDelete gInfo m sharedMsgId msg
|
||||
-- TODO discontinue XFile
|
||||
XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta
|
||||
|
|
@ -2001,30 +2001,41 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
|
|||
when (enableNtfs chatSettings) $ showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
|
||||
setActive $ ActiveG g
|
||||
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> m ()
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId} GroupMember {memberId} sharedMsgId mc RcvMessage {msgId} = do
|
||||
CChatItem msgDir ChatItem {chatDir, meta = CIMeta {itemId}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId sharedMsgId
|
||||
case (msgDir, chatDir) of
|
||||
(SMDRcv, CIGroupRcv m) ->
|
||||
if sameMemberId memberId m
|
||||
then do
|
||||
updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CIRcvMsgContent mc) msgId
|
||||
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) updCi
|
||||
let g = groupName' gInfo
|
||||
setActive $ ActiveG g
|
||||
else messageError "x.msg.update: group member attempted to update a message of another member"
|
||||
(SMDSnd, _) -> messageError "x.msg.update: group member attempted invalid message update"
|
||||
groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m ()
|
||||
groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta =
|
||||
updateRcvChatItem `catchError` \e ->
|
||||
case e of
|
||||
(ChatErrorStore (SEChatItemSharedMsgIdNotFound _)) -> do
|
||||
-- This patches initial sharedMsgId into chat item when locally deleted chat item
|
||||
-- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete).
|
||||
-- Chat item and update message which created it will have different sharedMsgId in this case...
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta (CIRcvMsgContent mc) Nothing
|
||||
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci
|
||||
setActive $ ActiveG g
|
||||
_ -> throwError e
|
||||
where
|
||||
updateRcvChatItem = do
|
||||
CChatItem msgDir ChatItem {chatDir, meta = CIMeta {itemId}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
case (msgDir, chatDir) of
|
||||
(SMDRcv, CIGroupRcv m') ->
|
||||
if sameMemberId memberId m'
|
||||
then do
|
||||
updCi <- withStore $ \db -> updateGroupChatItem db user groupId itemId (CIRcvMsgContent mc) msgId
|
||||
toView . CRChatItemUpdated $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) updCi
|
||||
setActive $ ActiveG g
|
||||
else messageError "x.msg.update: group member attempted to update a message of another member" -- shouldn't happen now that query includes group member id
|
||||
(SMDSnd, _) -> messageError "x.msg.update: group member attempted invalid message update"
|
||||
|
||||
groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> RcvMessage -> m ()
|
||||
groupMessageDelete gInfo@GroupInfo {groupId} GroupMember {memberId} sharedMsgId RcvMessage {msgId} = do
|
||||
CChatItem msgDir deletedItem@ChatItem {chatDir, meta = CIMeta {itemId}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId sharedMsgId
|
||||
groupMessageDelete gInfo@GroupInfo {groupId} GroupMember {groupMemberId, memberId} sharedMsgId RcvMessage {msgId} = do
|
||||
CChatItem msgDir deletedItem@ChatItem {chatDir, meta = CIMeta {itemId}} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
case (msgDir, chatDir) of
|
||||
(SMDRcv, CIGroupRcv m) ->
|
||||
if sameMemberId memberId m
|
||||
then do
|
||||
toCi <- withStore $ \db -> deleteGroupChatItemRcvBroadcast db user gInfo itemId msgId
|
||||
toView $ CRChatItemDeleted (AChatItem SCTGroup SMDRcv (GroupChat gInfo) deletedItem) toCi
|
||||
else messageError "x.msg.del: group member attempted to delete a message of another member"
|
||||
else messageError "x.msg.del: group member attempted to delete a message of another member" -- shouldn't happen now that query includes group member id
|
||||
(SMDSnd, _) -> messageError "x.msg.del: group member attempted invalid message delete"
|
||||
|
||||
-- TODO remove once XFile is discontinued
|
||||
|
|
@ -2073,10 +2084,10 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
|
|||
else messageError "x.file.acpt.inv: fileName is different from expected"
|
||||
|
||||
xFileCancelGroup :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m ()
|
||||
xFileCancelGroup g@GroupInfo {groupId} mem@GroupMember {memberId} sharedMsgId msgMeta = do
|
||||
xFileCancelGroup g@GroupInfo {groupId} mem@GroupMember {groupMemberId, memberId} sharedMsgId msgMeta = do
|
||||
checkIntegrityCreateItem (CDGroupRcv g mem) msgMeta
|
||||
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
|
||||
CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId sharedMsgId
|
||||
CChatItem msgDir ChatItem {chatDir} <- withStore $ \db -> getGroupChatItemBySharedMsgId db user groupId groupMemberId sharedMsgId
|
||||
case (msgDir, chatDir) of
|
||||
(SMDRcv, CIGroupRcv m) -> do
|
||||
if sameMemberId memberId m
|
||||
|
|
@ -2085,7 +2096,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
|
|||
unless cancelled $ do
|
||||
cancelRcvFileTransfer user ft
|
||||
toView $ CRRcvFileSndCancelled ft
|
||||
else messageError "x.file.cancel: group member attempted to cancel file of another member"
|
||||
else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id
|
||||
(SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel"
|
||||
|
||||
xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> ConnReqInvitation -> String -> MsgMeta -> m ()
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ CREATE TABLE chat_items (
|
|||
created_by_msg_id INTEGER UNIQUE REFERENCES messages (message_id) ON DELETE SET NULL,
|
||||
item_sent INTEGER NOT NULL, -- 0 for received, 1 for sent
|
||||
item_ts TEXT NOT NULL, -- broker_ts of creating message for received, created_at for sent
|
||||
item_deleted INTEGER NOT NULL DEFAULT 0, -- 1 for deleted,
|
||||
item_deleted INTEGER NOT NULL DEFAULT 0, -- 1 for deleted, -- ! legacy field that was used for group chat items when they weren't fully deleted
|
||||
item_content TEXT NOT NULL, -- JSON
|
||||
item_text TEXT NOT NULL, -- textual representation
|
||||
created_at TEXT NOT NULL DEFAULT (datetime('now')),
|
||||
|
|
|
|||
|
|
@ -0,0 +1,25 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20221001_shared_msg_id_indices where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20221001_shared_msg_id_indices :: Query
|
||||
m20221001_shared_msg_id_indices =
|
||||
[sql|
|
||||
DROP INDEX idx_messages_group_shared_msg_id;
|
||||
|
||||
CREATE UNIQUE INDEX idx_chat_items_direct_shared_msg_id ON chat_items(
|
||||
user_id,
|
||||
contact_id,
|
||||
shared_msg_id
|
||||
);
|
||||
|
||||
CREATE UNIQUE INDEX idx_chat_items_group_shared_msg_id ON chat_items(
|
||||
user_id,
|
||||
group_id,
|
||||
group_member_id,
|
||||
shared_msg_id
|
||||
);
|
||||
|]
|
||||
|
|
@ -331,8 +331,8 @@ CREATE TABLE chat_items(
|
|||
created_by_msg_id INTEGER UNIQUE REFERENCES messages(message_id) ON DELETE SET NULL,
|
||||
item_sent INTEGER NOT NULL, -- 0 for received, 1 for sent
|
||||
item_ts TEXT NOT NULL, -- broker_ts of creating message for received, created_at for sent
|
||||
item_deleted INTEGER NOT NULL DEFAULT 0, -- 1 for deleted,
|
||||
item_content TEXT NOT NULL, -- JSON
|
||||
item_deleted INTEGER NOT NULL DEFAULT 0, -- 1 for deleted, -- ! legacy field that was used for group chat items when they weren't fully deleted
|
||||
item_content TEXT NOT NULL, -- JSON
|
||||
item_text TEXT NOT NULL, -- textual representation
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
|
|
@ -374,11 +374,6 @@ CREATE UNIQUE INDEX idx_messages_direct_shared_msg_id ON messages(
|
|||
shared_msg_id_user,
|
||||
shared_msg_id
|
||||
);
|
||||
CREATE UNIQUE INDEX idx_messages_group_shared_msg_id ON messages(
|
||||
group_id,
|
||||
shared_msg_id_user,
|
||||
shared_msg_id
|
||||
);
|
||||
CREATE INDEX idx_chat_items_shared_msg_id ON chat_items(shared_msg_id);
|
||||
CREATE TABLE calls(
|
||||
-- stores call invitations state for communicating state between NSE and app when call notification comes
|
||||
|
|
@ -420,3 +415,14 @@ CREATE TABLE settings(
|
|||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE UNIQUE INDEX idx_chat_items_direct_shared_msg_id ON chat_items(
|
||||
user_id,
|
||||
contact_id,
|
||||
shared_msg_id
|
||||
);
|
||||
CREATE UNIQUE INDEX idx_chat_items_group_shared_msg_id ON chat_items(
|
||||
user_id,
|
||||
group_id,
|
||||
group_member_id,
|
||||
shared_msg_id
|
||||
);
|
||||
|
|
|
|||
|
|
@ -171,9 +171,8 @@ module Simplex.Chat.Store
|
|||
deleteDirectChatItemLocal,
|
||||
deleteDirectChatItemRcvBroadcast,
|
||||
updateGroupChatItem,
|
||||
deleteGroupChatItemInternal,
|
||||
deleteGroupChatItemLocal,
|
||||
deleteGroupChatItemRcvBroadcast,
|
||||
deleteGroupChatItemSndBroadcast,
|
||||
updateDirectChatItemsRead,
|
||||
updateGroupChatItemsRead,
|
||||
getSMPServers,
|
||||
|
|
@ -256,13 +255,13 @@ import Simplex.Chat.Migrations.M20220824_profiles_local_alias
|
|||
import Simplex.Chat.Migrations.M20220909_commands
|
||||
import Simplex.Chat.Migrations.M20220926_connection_alias
|
||||
import Simplex.Chat.Migrations.M20220928_settings
|
||||
import Simplex.Chat.Migrations.M20221001_shared_msg_id_indices
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
|
||||
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, firstRow, firstRow', maybeFirstRow, withTransaction)
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String (StrEncoding (strEncode))
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (ProtocolServer (..), SMPServer, pattern SMPServer)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost)
|
||||
|
|
@ -293,7 +292,8 @@ schemaMigrations =
|
|||
("20220824_profiles_local_alias", m20220824_profiles_local_alias),
|
||||
("20220909_commands", m20220909_commands),
|
||||
("20220926_connection_alias", m20220926_connection_alias),
|
||||
("20220928_settings", m20220928_settings)
|
||||
("20220928_settings", m20220928_settings),
|
||||
("20221001_shared_msg_id_indices", m20221001_shared_msg_id_indices)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
|
@ -3422,23 +3422,6 @@ deleteChatItemMessages_ db itemId =
|
|||
|]
|
||||
(Only itemId)
|
||||
|
||||
setChatItemMessagesDeleted_ :: DB.Connection -> ChatItemId -> IO ()
|
||||
setChatItemMessagesDeleted_ db itemId =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE messages
|
||||
SET chat_msg_event = ?, msg_body = ?
|
||||
WHERE message_id IN (
|
||||
SELECT message_id
|
||||
FROM chat_item_messages
|
||||
WHERE chat_item_id = ?
|
||||
)
|
||||
|]
|
||||
(XMsgDeleted_, xMsgDeletedBody, itemId)
|
||||
where
|
||||
xMsgDeletedBody = strEncode ChatMessage {msgId = Nothing, chatMsgEvent = XMsgDeleted}
|
||||
|
||||
deleteDirectChatItemRcvBroadcast :: DB.Connection -> UserId -> Contact -> ChatItemId -> MessageId -> ExceptT StoreError IO AChatItem
|
||||
deleteDirectChatItemRcvBroadcast db userId ct itemId msgId = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
|
|
@ -3461,17 +3444,6 @@ updateDirectChatItemRcvDeleted_ db userId ct@Contact {contactId} itemId currentT
|
|||
(toContent, toText, currentTs, userId, contactId, itemId)
|
||||
pure $ AChatItem SCTDirect msgDir (DirectChat ct) (ci {content = toContent, meta = (meta ci) {itemText = toText}, formattedText = Nothing})
|
||||
|
||||
deleteQuote_ :: DB.Connection -> ChatItemId -> IO ()
|
||||
deleteQuote_ db itemId =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET quoted_shared_msg_id = NULL, quoted_sent_at = NULL, quoted_content = NULL, quoted_sent = NULL, quoted_member_id = NULL
|
||||
WHERE chat_item_id = ?
|
||||
|]
|
||||
(Only itemId)
|
||||
|
||||
getDirectChatItemBySharedMsgId :: DB.Connection -> UserId -> ContactId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTDirect)
|
||||
getDirectChatItemBySharedMsgId db userId contactId sharedMsgId = do
|
||||
itemId <- getDirectChatItemIdBySharedMsgId_ db userId contactId sharedMsgId
|
||||
|
|
@ -3554,51 +3526,49 @@ updateGroupChatItem db user@User {userId} groupId itemId newContent msgId = do
|
|||
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
|
||||
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
|
||||
|
||||
deleteGroupChatItemInternal :: DB.Connection -> User -> GroupInfo -> ChatItemId -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItemInternal db user gInfo itemId = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
ci <- deleteGroupChatItem_ db user gInfo itemId CIDMInternal True currentTs
|
||||
liftIO $ setChatItemMessagesDeleted_ db itemId
|
||||
liftIO $ DB.execute db "DELETE FROM files WHERE chat_item_id = ?" (Only itemId)
|
||||
pure ci
|
||||
deleteGroupChatItemLocal :: DB.Connection -> User -> GroupInfo -> ChatItemId -> CIDeleteMode -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItemLocal db user gInfo itemId mode = do
|
||||
liftIO $ deleteChatItemMessages_ db itemId
|
||||
deleteGroupChatItem_ db user gInfo itemId mode
|
||||
|
||||
deleteGroupChatItemRcvBroadcast :: DB.Connection -> User -> GroupInfo -> ChatItemId -> MessageId -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItemRcvBroadcast db user gInfo itemId =
|
||||
deleteGroupChatItemBroadcast_ db user gInfo itemId False
|
||||
|
||||
deleteGroupChatItemSndBroadcast :: DB.Connection -> User -> GroupInfo -> ChatItemId -> MessageId -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItemSndBroadcast db user gInfo itemId msgId = do
|
||||
ci <- deleteGroupChatItemBroadcast_ db user gInfo itemId True msgId
|
||||
liftIO $ setChatItemMessagesDeleted_ db itemId
|
||||
liftIO $ DB.execute db "DELETE FROM files WHERE chat_item_id = ?" (Only itemId)
|
||||
pure ci
|
||||
|
||||
deleteGroupChatItemBroadcast_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Bool -> MessageId -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItemBroadcast_ db user gInfo itemId itemDeleted msgId = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $ insertChatItemMessage_ db itemId msgId currentTs
|
||||
deleteGroupChatItem_ db user gInfo itemId CIDMBroadcast itemDeleted currentTs
|
||||
|
||||
deleteGroupChatItem_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> CIDeleteMode -> Bool -> UTCTime -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItem_ db user@User {userId} gInfo@GroupInfo {groupId} itemId mode itemDeleted currentTs = do
|
||||
deleteGroupChatItem_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> CIDeleteMode -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItem_ db user@User {userId} gInfo@GroupInfo {groupId} itemId mode = do
|
||||
(CChatItem msgDir ci) <- getGroupChatItem db user groupId itemId
|
||||
let toContent = msgDirToDeletedContent_ msgDir mode
|
||||
liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, item_deleted = ?, updated_at = ?
|
||||
DELETE FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(toContent, toText, itemDeleted, currentTs, userId, groupId, itemId)
|
||||
when itemDeleted $ deleteQuote_ db itemId
|
||||
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) (ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted}, formattedText = Nothing})
|
||||
where
|
||||
toText = ciDeleteModeToText mode
|
||||
(userId, groupId, itemId)
|
||||
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) (ci {content = toContent, meta = (meta ci) {itemText = ciDeleteModeToText mode, itemDeleted = True}, formattedText = Nothing})
|
||||
|
||||
getGroupChatItemBySharedMsgId :: DB.Connection -> User -> Int64 -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
|
||||
getGroupChatItemBySharedMsgId db user@User {userId} groupId sharedMsgId = do
|
||||
deleteGroupChatItemRcvBroadcast :: DB.Connection -> User -> GroupInfo -> ChatItemId -> MessageId -> ExceptT StoreError IO AChatItem
|
||||
deleteGroupChatItemRcvBroadcast db user gInfo itemId msgId = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $ insertChatItemMessage_ db itemId msgId currentTs
|
||||
updateGroupChatItemRcvDeleted_ db user gInfo itemId currentTs
|
||||
|
||||
updateGroupChatItemRcvDeleted_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> UTCTime -> ExceptT StoreError IO AChatItem
|
||||
updateGroupChatItemRcvDeleted_ db user@User {userId} gInfo@GroupInfo {groupId} itemId currentTs = do
|
||||
(CChatItem msgDir ci) <- getGroupChatItem db user groupId itemId
|
||||
let toContent = msgDirToDeletedContent_ msgDir CIDMBroadcast
|
||||
toText = ciDeleteModeToText CIDMBroadcast
|
||||
liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_content = ?, item_text = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND chat_item_id = ?
|
||||
|]
|
||||
(toContent, toText, currentTs, userId, groupId, itemId)
|
||||
pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) (ci {content = toContent, meta = (meta ci) {itemText = toText}, formattedText = Nothing})
|
||||
|
||||
getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupId -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
|
||||
getGroupChatItemBySharedMsgId db user@User {userId} groupId groupMemberId sharedMsgId = do
|
||||
itemId <-
|
||||
ExceptT . firstRow fromOnly (SEChatItemSharedMsgIdNotFound sharedMsgId) $
|
||||
DB.query
|
||||
|
|
@ -3606,11 +3576,11 @@ getGroupChatItemBySharedMsgId db user@User {userId} groupId sharedMsgId = do
|
|||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND shared_msg_id = ?
|
||||
WHERE user_id = ? AND group_id = ? AND group_member_id = ? AND shared_msg_id = ?
|
||||
ORDER BY chat_item_id DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, groupId, sharedMsgId)
|
||||
(userId, groupId, groupMemberId, sharedMsgId)
|
||||
getGroupChatItem db user groupId itemId
|
||||
|
||||
getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
|
||||
|
|
@ -4109,7 +4079,7 @@ getChatsWithExpiredItems db User {userId} expirationDate =
|
|||
[sql|
|
||||
SELECT contact_id, group_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND item_ts <= ? AND item_deleted != 1
|
||||
WHERE user_id = ? AND item_ts <= ?
|
||||
GROUP BY contact_id, group_id
|
||||
ORDER BY contact_id ASC, group_id ASC
|
||||
|]
|
||||
|
|
@ -4143,7 +4113,7 @@ getGroupExpiredCIs db User {userId} groupId expirationDate =
|
|||
SELECT i.chat_item_id, f.file_id, f.ci_file_status, f.file_path
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
WHERE i.user_id = ? AND i.group_id = ? AND i.item_ts <= ? AND i.item_deleted != 1
|
||||
WHERE i.user_id = ? AND i.group_id = ? AND i.item_ts <= ?
|
||||
ORDER BY i.item_ts ASC
|
||||
|]
|
||||
(userId, groupId, expirationDate)
|
||||
|
|
|
|||
|
|
@ -1008,17 +1008,15 @@ testGroupMessageDelete =
|
|||
(bob <# "#team alice> hello!")
|
||||
(cath <# "#team alice> hello!")
|
||||
|
||||
-- alice: deletes msg id 5
|
||||
alice #$> ("/_delete item #1 5 internal", id, "message deleted")
|
||||
|
||||
alice #$> ("/_get chat #1 count=1", chat, [(0, "connected")])
|
||||
bob #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
|
||||
cath #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
|
||||
|
||||
alice #$> ("/_update item #1 5 text updating deleted message", id, "cannot update this item")
|
||||
alice #$> ("/_send #1 json {\"quotedItemId\": 5, \"msgContent\": {\"type\": \"text\", \"text\": \"quoting deleted message\"}}", id, "cannot reply to this message")
|
||||
|
||||
threadDelay 1000000
|
||||
-- alice, bob: msg id 6, cath: msg id 5
|
||||
-- alice: msg id 5, bob: msg id 6, cath: msg id 5
|
||||
bob `send` "> #team @alice (hello) hi alic"
|
||||
bob <# "#team > alice hello!"
|
||||
bob <## " hi alic"
|
||||
|
|
@ -1036,17 +1034,14 @@ testGroupMessageDelete =
|
|||
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
||||
|
||||
alice #$> ("/_delete item #1 5 broadcast", id, "message deleted")
|
||||
concurrently_
|
||||
(bob <# "#team alice> [deleted] hello!")
|
||||
(cath <# "#team alice> [deleted] hello!")
|
||||
|
||||
alice #$> ("/_delete item #1 6 internal", id, "message deleted")
|
||||
-- alice: deletes msg id 5
|
||||
alice #$> ("/_delete item #1 5 internal", id, "message deleted")
|
||||
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
||||
|
||||
-- alice: msg id 5
|
||||
bob #$> ("/_update item #1 6 text hi alice", id, "message updated")
|
||||
concurrently_
|
||||
(alice <# "#team bob> [edited] hi alice")
|
||||
|
|
@ -1056,11 +1051,11 @@ testGroupMessageDelete =
|
|||
)
|
||||
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((0, "hi alice"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alice"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alice"), Just (0, "hello!"))])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
|
||||
threadDelay 1000000
|
||||
-- alice, bob: msg id 7, cath: msg id 6
|
||||
-- alice: msg id 6, bob: msg id 7, cath: msg id 6
|
||||
cath #> "#team how are you?"
|
||||
concurrently_
|
||||
(alice <# "#team cath> how are you?")
|
||||
|
|
@ -1071,12 +1066,12 @@ testGroupMessageDelete =
|
|||
(alice <# "#team cath> [deleted] how are you?")
|
||||
(bob <# "#team cath> [deleted] how are you?")
|
||||
|
||||
alice #$> ("/_delete item #1 6 broadcast", id, "cannot delete this item")
|
||||
alice #$> ("/_delete item #1 6 internal", id, "message deleted")
|
||||
alice #$> ("/_delete item #1 5 broadcast", id, "cannot delete this item")
|
||||
alice #$> ("/_delete item #1 5 internal", id, "message deleted")
|
||||
|
||||
alice #$> ("/_get chat #1 count=1", chat', [((0, "this item is deleted (broadcast)"), Nothing)])
|
||||
bob #$> ("/_get chat #1 count=3", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alice"), Just (0, "hello!")), ((0, "this item is deleted (broadcast)"), Nothing)])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
bob #$> ("/_get chat #1 count=3", chat', [((0, "hello!"), Nothing), ((1, "hi alice"), Just (0, "hello!")), ((0, "this item is deleted (broadcast)"), Nothing)])
|
||||
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
||||
|
||||
testUpdateGroupProfile :: IO ()
|
||||
testUpdateGroupProfile =
|
||||
|
|
@ -2413,27 +2408,44 @@ testGetSetSMPServers =
|
|||
|
||||
testAsyncInitiatingOffline :: IO ()
|
||||
testAsyncInitiatingOffline = withTmpFiles $ do
|
||||
putStrLn "testAsyncInitiatingOffline"
|
||||
inv <- withNewTestChat "alice" aliceProfile $ \alice -> do
|
||||
putStrLn "1"
|
||||
alice ##> "/c"
|
||||
putStrLn "2"
|
||||
getInvitation alice
|
||||
putStrLn "3"
|
||||
withNewTestChat "bob" bobProfile $ \bob -> do
|
||||
putStrLn "4"
|
||||
bob `send` ("/c " <> inv)
|
||||
putStrLn "5"
|
||||
bob <### ["/c " <> inv, "confirmation sent!"]
|
||||
putStrLn "6"
|
||||
withTestChat "alice" $ \alice -> do
|
||||
putStrLn "7"
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
|
||||
testAsyncAcceptingOffline :: IO ()
|
||||
testAsyncAcceptingOffline = withTmpFiles $ do
|
||||
putStrLn "testAsyncAcceptingOffline"
|
||||
inv <- withNewTestChat "alice" aliceProfile $ \alice -> do
|
||||
putStrLn "1"
|
||||
alice ##> "/c"
|
||||
putStrLn "2"
|
||||
getInvitation alice
|
||||
putStrLn "3"
|
||||
withNewTestChat "bob" bobProfile $ \bob -> do
|
||||
putStrLn "4"
|
||||
bob ##> ("/c " <> inv)
|
||||
putStrLn "5"
|
||||
bob <## "confirmation sent!"
|
||||
withTestChat "alice" $ \alice ->
|
||||
withTestChat "bob" $ \bob ->
|
||||
putStrLn "6"
|
||||
withTestChat "alice" $ \alice -> do
|
||||
putStrLn "7"
|
||||
withTestChat "bob" $ \bob -> do
|
||||
putStrLn "8"
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue