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

* 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>

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

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)

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;
+|]

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
+);

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 <-

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)

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

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

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