diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 8620f881d..162a57c23 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -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 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index b823a4bcc..908547fe3 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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 diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 05cc6909b..2c5f4755f 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -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) diff --git a/src/Simplex/Chat/Migrations/M20230621_chat_item_moderations.hs b/src/Simplex/Chat/Migrations/M20230621_chat_item_moderations.hs new file mode 100644 index 000000000..449e21e20 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230621_chat_item_moderations.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 05c7857a2..176397ddc 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -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 +); diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index acf722a3a..1829192df 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -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 <- diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 1b1df64a2..0cc17320e 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -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) diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index a155841b8..f1294de64 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -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 diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 0d4991589..28c70c03c 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -56,6 +56,7 @@ data StoreError | SEGroupNotFoundByName {groupName :: GroupName} | SEGroupMemberNameNotFound {groupId :: GroupId, groupMemberName :: ContactName} | SEGroupMemberNotFound {groupMemberId :: GroupMemberId} + | SEGroupMemberNotFoundByMemberId {memberId :: MemberId} | SEGroupWithoutUser | SEDuplicateGroupMember | SEGroupAlreadyJoined diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 1c3eeafe0..e67746a2c 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -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 diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 85b9c720b..5e9a41923 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -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)