IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: moderate messages that have arrived after the event of moderation (#2604)

Browse Source 
* core: moderate messages that have arrived after the event of moderation

* remove index

* test, delete moderation

* unused selector

* rework

* refactor

* change error

* parameter

* fix syntax

* refactor

* Nothing

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
spaced4ndy 2023-06-22 20:38:09 +04:00 committed by GitHub
parent 7ed581dfbf
commit da2622f00e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
11 changed files with 245 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
simplex-chat.cabal
View File

@ -102,6 +102,7 @@ library
Simplex.Chat.Migrations.M20230529_indexes
Simplex.Chat.Migrations.M20230608_deleted_contacts
Simplex.Chat.Migrations.M20230618_favorite_chats
Simplex.Chat.Migrations.M20230621_chat_item_moderations
Simplex.Chat.Mobile
Simplex.Chat.Mobile.WebRTC
Simplex.Chat.Options

33
src/Simplex/Chat.hs
View File

@ -3533,15 +3533,34 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
e -> throwError e
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m ()
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
-- TODO integrity message check
let (ExtMsgContent content fInv_ _ _) = mcExtMsgContent mc
if isVoice content && not (groupFeatureAllowed SGFVoice gInfo)
then void $ newChatItem (CIRcvGroupFeatureRejected GFVoice) Nothing Nothing False
else do
let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc
timed_ = rcvGroupCITimed gInfo itemTTL
-- check if message moderation event was received ahead of message
let timed_ = rcvGroupCITimed gInfo itemTTL
live = fromMaybe False live_
withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
Just ciModeration -> do
applyModeration timed_ live ciModeration
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
Nothing -> createItem timed_ live
where
ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
applyModeration timed_ live CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, createdByMsgId, moderatedAt}
| moderatorRole < GRAdmin || moderatorRole < memberRole =
createItem timed_ live
| groupFeatureAllowed SGFFullDelete gInfo = do
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False
ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo (CChatItem SMDRcv ci) moderator moderatedAt
toView $ CRNewChatItem user ci'
| otherwise = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False
cr <- markGroupCIDeleted user gInfo (CChatItem SMDRcv ci) createdByMsgId False (Just moderator) moderatedAt
toView cr
createItem timed_ live = do
file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
autoAcceptFile file_
@ -3549,7 +3568,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
whenGroupNtfs user gInfo $ do
showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText
setActive $ ActiveG g
where
newChatItem ciContent ciFile_ timed_ live = do
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live
reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_
@ -3602,7 +3620,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| sameMemberId memberId mem && msgMemberId == memberId -> delete ci Nothing >>= toView
| otherwise -> deleteMsg mem ci
CIGroupSnd -> deleteMsg membership ci
Left e -> messageError $ "x.msg.del: message not found, " <> tshow e
Left e
| msgMemberId == memberId -> messageError $ "x.msg.del: message not found, " <> tshow e
| senderRole < GRAdmin -> messageError $ "x.msg.del: message not found, message of another member with insufficient member permissions, " <> tshow e
| otherwise -> withStore' $ \db -> createCIModeration db gInfo m msgMemberId sharedMsgId msgId brokerTs
where
deleteMsg :: GroupMember -> CChatItem 'CTGroup -> m ()
deleteMsg mem ci = case sndMemberId_ of

8
src/Simplex/Chat/Messages.hs
View File

@ -907,3 +907,11 @@ mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
itemVersionTs = itemTs,
createdAt = createdAt
}
data CIModeration = CIModeration
{ moderationId :: Int64,
moderatorMember :: GroupMember,
createdByMsgId :: MessageId,
moderatedAt :: UTCTime
}
deriving (Show)

41
src/Simplex/Chat/Migrations/M20230621_chat_item_moderations.hs Normal file
View File

@ -0,0 +1,41 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230621_chat_item_moderations where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
-- moderations that could not be applied - for messages that haven't been received at the time of moderation
m20230621_chat_item_moderations :: Query
m20230621_chat_item_moderations =
[sql|
CREATE TABLE chat_item_moderations (
chat_item_moderation_id INTEGER PRIMARY KEY,
group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
moderator_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
item_member_id BLOB NOT NULL,
shared_msg_id BLOB NOT NULL,
created_by_msg_id INTEGER REFERENCES messages(message_id) ON DELETE SET NULL,
moderated_at TEXT NOT NULL, -- broker_ts of creating message
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE INDEX idx_chat_item_moderations_group_id ON chat_item_moderations(group_id);
CREATE INDEX idx_chat_item_moderations_moderator_member_id ON chat_item_moderations(moderator_member_id);
CREATE INDEX idx_chat_item_moderations_created_by_msg_id ON chat_item_moderations(created_by_msg_id);
CREATE INDEX idx_chat_item_moderations_group ON chat_item_moderations(group_id, item_member_id, shared_msg_id);
|]
down_m20230621_chat_item_moderations :: Query
down_m20230621_chat_item_moderations =
[sql|
DROP INDEX idx_chat_item_moderations_group;
DROP INDEX idx_chat_item_moderations_created_by_msg_id;
DROP INDEX idx_chat_item_moderations_moderator_member_id;
DROP INDEX idx_chat_item_moderations_group_id;
DROP TABLE chat_item_moderations;
|]

25
src/Simplex/Chat/Migrations/chat_schema.sql
View File

@ -481,6 +481,17 @@ CREATE TABLE chat_item_reactions(
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE TABLE chat_item_moderations(
chat_item_moderation_id INTEGER PRIMARY KEY,
group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
moderator_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
item_member_id BLOB NOT NULL,
shared_msg_id BLOB NOT NULL,
created_by_msg_id INTEGER REFERENCES messages(message_id) ON DELETE SET NULL,
moderated_at TEXT NOT NULL, -- broker_ts of creating message
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
);
CREATE INDEX contact_profiles_index ON contact_profiles(
display_name,
full_name
@ -658,3 +669,17 @@ CREATE INDEX idx_msg_deliveries_agent_ack_cmd_id ON msg_deliveries(
CREATE INDEX msg_delivery_events_msg_delivery_id ON msg_delivery_events(
msg_delivery_id
);
CREATE INDEX idx_chat_item_moderations_group_id ON chat_item_moderations(
group_id
);
CREATE INDEX idx_chat_item_moderations_moderator_member_id ON chat_item_moderations(
moderator_member_id
);
CREATE INDEX idx_chat_item_moderations_created_by_msg_id ON chat_item_moderations(
created_by_msg_id
);
CREATE INDEX idx_chat_item_moderations_group ON chat_item_moderations(
group_id,
item_member_id,
shared_msg_id
);

4
src/Simplex/Chat/Store/Groups.hs
View File

@ -17,6 +17,7 @@ module Simplex.Chat.Store.Groups
toGroupInfo,
toGroupMember,
toMaybeGroupMember,
-- * Group functions
createGroupLink,
getGroupLinkConnection,
@ -1061,9 +1062,6 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName =
ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $
DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName)
getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact]
getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do
contactIds <-

44
src/Simplex/Chat/Store/Messages.hs
View File

@ -14,6 +14,7 @@ module Simplex.Chat.Store.Messages
( getContactConnIds_,
getDirectChatReactions_,
toDirectChatItem,
-- * Message and chat item functions
deleteContactCIs,
getGroupFileInfo,
@ -83,6 +84,9 @@ module Simplex.Chat.Store.Messages
deleteContactExpiredCIs,
getGroupExpiredFileInfo,
deleteGroupExpiredCIs,
createCIModeration,
getCIModeration,
deleteCIModeration,
)
where
@ -1803,3 +1807,43 @@ deleteGroupExpiredCIs db User {userId} GroupInfo {groupId} expirationDate create
DB.execute db "DELETE FROM messages WHERE group_id = ? AND created_at <= ?" (groupId, min expirationDate createdAtCutoff)
DB.execute db "DELETE FROM chat_item_reactions WHERE group_id = ? AND reaction_ts <= ? AND created_at <= ?" (groupId, expirationDate, createdAtCutoff)
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND item_ts <= ? AND created_at <= ?" (userId, groupId, expirationDate, createdAtCutoff)
createCIModeration :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> MessageId -> UTCTime -> IO ()
createCIModeration db GroupInfo {groupId} moderatorMember itemMemberId itemSharedMId msgId moderatedAtTs =
DB.execute
db
[sql|
INSERT INTO chat_item_moderations
(group_id, moderator_member_id, item_member_id, shared_msg_id, created_by_msg_id, moderated_at)
VALUES (?,?,?,?,?,?)
|]
(groupId, groupMemberId' moderatorMember, itemMemberId, itemSharedMId, msgId, moderatedAtTs)
getCIModeration :: DB.Connection -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
getCIModeration _ _ _ _ Nothing = pure Nothing
getCIModeration db user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
r_ <-
maybeFirstRow id $
DB.query
db
[sql|
SELECT chat_item_moderation_id, moderator_member_id, created_by_msg_id, moderated_at
FROM chat_item_moderations
WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?
LIMIT 1
|]
(groupId, itemMemberId, sharedMsgId)
case r_ of
Just (moderationId, moderatorId, createdByMsgId, moderatedAt) -> do
runExceptT (getGroupMember db user groupId moderatorId) >>= \case
Right moderatorMember -> pure (Just CIModeration {moderationId, moderatorMember, createdByMsgId, moderatedAt})
_ -> pure Nothing
_ -> pure Nothing
deleteCIModeration :: DB.Connection -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO ()
deleteCIModeration _ _ _ Nothing = pure ()
deleteCIModeration db GroupInfo {groupId} itemMemberId (Just sharedMsgId) =
DB.execute
db
"DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?"
(groupId, itemMemberId, sharedMsgId)

4
src/Simplex/Chat/Store/Migrations.hs
View File

@ -72,6 +72,7 @@ import Simplex.Chat.Migrations.M20230526_indexes
import Simplex.Chat.Migrations.M20230529_indexes
import Simplex.Chat.Migrations.M20230608_deleted_contacts
import Simplex.Chat.Migrations.M20230618_favorite_chats
import Simplex.Chat.Migrations.M20230621_chat_item_moderations
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@ -143,7 +144,8 @@ schemaMigrations =
("20230526_indexes", m20230526_indexes, Just down_m20230526_indexes),
("20230529_indexes", m20230529_indexes, Just down_m20230529_indexes),
("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts),
("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats)
("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats),
("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations)
]
-- | The list of migrations in ascending order by date

1
src/Simplex/Chat/Store/Shared.hs
View File

@ -56,6 +56,7 @@ data StoreError
| SEGroupNotFoundByName {groupName :: GroupName}
| SEGroupMemberNameNotFound {groupId :: GroupId, groupMemberName :: ContactName}
| SEGroupMemberNotFound {groupMemberId :: GroupMemberId}
| SEGroupMemberNotFoundByMemberId {memberId :: MemberId}
| SEGroupWithoutUser
| SEDuplicateGroupMember
| SEGroupAlreadyJoined

1
src/Simplex/Chat/View.hs
View File

@ -404,6 +404,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta
CIRcvDecryptionError err n -> viewRcvDecryptionError from err n ts tz meta
CIRcvGroupInvitation {} -> showRcvItemProhibited from
CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g m) quote meta [plainContent content] False
_ -> showRcvItem from
where
from = ttyFromGroup g m

99
tests/ChatTests/Groups.hs
View File

@ -40,8 +40,10 @@ chatGroupTests = do
it "update member role" testUpdateMemberRole
it "unused contacts are deleted after all their groups are deleted" testGroupDeleteUnusedContacts
it "group description is shown as the first message to new members" testGroupDescription
it "delete message of another group member" testGroupMemberMessageDelete
it "full delete message of another group member" testGroupMemberMessageFullDelete
it "moderate message of another group member" testGroupModerate
it "moderate message of another group member (full delete)" testGroupModerateFullDelete
it "moderate message that arrives after the event of moderation" testGroupDelayedModeration
it "moderate message that arrives after the event of moderation (full delete)" testGroupDelayedModerationFullDelete
describe "async group connections" $ do
xit "create and join group when clients go offline" testGroupAsync
describe "group links" $ do
@ -1308,8 +1310,8 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile
cc <## "#team: bob added dan (Daniel) to the group (connecting...)"
cc <## "#team: new member dan is connected"
testGroupMemberMessageDelete :: HasCallStack => FilePath -> IO ()
testGroupMemberMessageDelete =
testGroupModerate :: HasCallStack => FilePath -> IO ()
testGroupModerate =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
@ -1339,8 +1341,8 @@ testGroupMemberMessageDelete =
bob #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted by you]")])
cath #$> ("/_get chat #1 count=1", chat, [(1, "hi [marked deleted by bob]")])
testGroupMemberMessageFullDelete :: HasCallStack => FilePath -> IO ()
testGroupMemberMessageFullDelete =
testGroupModerateFullDelete :: HasCallStack => FilePath -> IO ()
testGroupModerateFullDelete =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
@ -1377,6 +1379,91 @@ testGroupMemberMessageFullDelete =
bob #$> ("/_get chat #1 count=1", chat, [(0, "moderated [deleted by you]")])
cath #$> ("/_get chat #1 count=1", chat, [(1, "moderated [deleted by bob]")])
testGroupDelayedModeration :: HasCallStack => FilePath -> IO ()
testGroupDelayedModeration tmp = do
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do
createGroup2 "team" alice bob
withNewTestChat tmp "cath" cathProfile $ \cath -> do
connectUsers alice cath
addMember "team" alice cath GRMember
cath ##> "/j team"
concurrentlyN_
[ alice <## "#team: cath joined the group",
cath <## "#team: you joined the group"
]
threadDelay 1000000
cath #> "#team hi" -- message is pending for bob
alice <# "#team cath> hi"
alice ##> "\\\\ #team @cath hi"
alice <## "message marked deleted by you"
cath <# "#team cath> [marked deleted by alice] hi"
withTestChat tmp "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)"
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
withTestChat tmp "cath" $ \cath -> do
cath <## "2 contacts connected (use /cs for the list)"
cath <## "#team: connected to server(s)"
cath <## "#team: member bob (Bob) is connected"
bob
<### [ "#team: new member cath is connected",
EndsWith "#team cath> [marked deleted by alice] hi"
]
alice #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted by you]")])
cath #$> ("/_get chat #1 count=2", chat, [(1, "hi [marked deleted by alice]"), (0, "connected")])
bob ##> "/_get chat #1 count=2"
r <- chat <$> getTermLine bob
r `shouldMatchList` [(0, "connected"), (0, "hi [marked deleted by alice]")]
testGroupDelayedModerationFullDelete :: HasCallStack => FilePath -> IO ()
testGroupDelayedModerationFullDelete tmp = do
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do
createGroup2 "team" alice bob
withNewTestChat tmp "cath" cathProfile $ \cath -> do
connectUsers alice cath
addMember "team" alice cath GRMember
cath ##> "/j team"
concurrentlyN_
[ alice <## "#team: cath joined the group",
cath <## "#team: you joined the group"
]
threadDelay 1000000
cath #> "#team hi" -- message is pending for bob
alice <# "#team cath> hi"
alice ##> "\\\\ #team @cath hi"
alice <## "message marked deleted by you"
cath <# "#team cath> [marked deleted by alice] hi"
-- if full deletion was enabled at time of moderation, cath would delete pending message as well,
-- that's why we set it afterwards to test delayed moderation for bob
alice ##> "/set delete #team on"
alice <## "updated group preferences:"
alice <## "Full deletion: on"
cath <## "alice updated group #team:"
cath <## "updated group preferences:"
cath <## "Full deletion: on"
withTestChat tmp "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
bob <## "#team: connected to server(s)"
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
bob <## "alice updated group #team:"
bob <## "updated group preferences:"
bob <## "Full deletion: on"
withTestChat tmp "cath" $ \cath -> do
cath <## "2 contacts connected (use /cs for the list)"
cath <## "#team: connected to server(s)"
cath <## "#team: member bob (Bob) is connected"
bob
<### [ "#team: new member cath is connected",
EndsWith "#team cath> moderated [deleted by alice]"
]
alice #$> ("/_get chat #1 count=2", chat, [(0, "hi [marked deleted by you]"), (1, "Full deletion: on")])
cath #$> ("/_get chat #1 count=3", chat, [(1, "hi [marked deleted by alice]"), (0, "Full deletion: on"), (0, "connected")])
bob ##> "/_get chat #1 count=3"
r <- chat <$> getTermLine bob
r `shouldMatchList` [(0, "Full deletion: on"), (0, "connected"), (0, "moderated [deleted by alice]")]
testGroupAsync :: HasCallStack => FilePath -> IO ()
testGroupAsync tmp = do
print (0 :: Integer)