core: rfc, protocol and types for user reports (#5451)

* core: rfc, protocol and types for user reports

* add comment

* rfc

* moderation rfc

* api, types

* update

* typos

* migration

* update

* report reason

* query

* deleted

* remove auto-accepting conditions for SimpleX Chat Ltd

* api, query

* make indices work

* index without filtering

* query for unread

* postgres: rework chat list pagination query (#5441)

* fix query

* fix

* report counts to stats

* internalMark

* fix parser

* AND

* delete reports on event, fix counters

* test

* remove reports when message is moderated on sending side

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

apps/ios/SimpleXChat/ChatTypes.swift

@@ -3348,9 +3348,11 @@ public enum MREmojiChar: String, Codable, CaseIterable, Hashable {
     case thumbsup = "👍"
     case thumbsdown = "👎"
     case smile = "😀"
+    case laugh = "😂"
     case sad = "😢"
     case heart = "❤"
     case launch = "🚀"
+    case check = "✅"
 }
 
 extension MsgReaction: Decodable {

apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt

@@ -3202,9 +3202,11 @@ enum class MREmojiChar(val value: String) {
   @SerialName("👍") ThumbsUp("👍"),
   @SerialName("👎") ThumbsDown("👎"),
   @SerialName("😀") Smile("😀"),
+  @SerialName("😂") Laugh("😂"),
   @SerialName("😢") Sad("😢"),
   @SerialName("❤") Heart("❤"),
-  @SerialName("🚀") Launch("🚀");
+  @SerialName("🚀") Launch("🚀"),
+  @SerialName("✅") Check("✅");
 }
 
 @Serializable

apps/simplex-directory-service/src/Directory/Service.hs

@@ -688,7 +688,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
           sendComposedMessage cc ct Nothing $ MCText text
 
 getContact :: ChatController -> ContactId -> IO (Maybe Contact)
-getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) (CPLast 0) Nothing)
+getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) Nothing (CPLast 0) Nothing)
   where
     resp :: ChatResponse -> Maybe Contact
     resp = \case

docs/protocol/simplex-chat.schema.json

@@ -113,6 +113,12 @@
           "properties": {
             "text": {"type": "string", "metadata": {"comment": "can be empty"}}
           }
+        },
+        "report": {
+          "properties": {
+            "text": {"type": "string", "metadata": {"comment": "can be empty, includes report reason for old clients"}},
+            "reason": {"enum": ["spam", "illegal", "community", "other"]}
+          }
         }
       },
       "metadata": {

simplex-chat.cabal

@@ -162,6 +162,7 @@ library
       Simplex.Chat.Migrations.M20241222_operator_conditions
       Simplex.Chat.Migrations.M20241223_chat_tags
       Simplex.Chat.Migrations.M20241230_reports
+      Simplex.Chat.Migrations.M20250105_indexes
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared

src/Simplex/Chat/Controller.hs

@@ -297,7 +297,7 @@ data ChatCommand
   | SlowSQLQueries
   | APIGetChatTags UserId
   | APIGetChats {userId :: UserId, pendingConnections :: Bool, pagination :: PaginationByTime, query :: ChatListQuery}
-  | APIGetChat ChatRef ChatPagination (Maybe String)
+  | APIGetChat ChatRef (Maybe ContentFilter) ChatPagination (Maybe String)
   | APIGetChatItems ChatPagination (Maybe String)
   | APIGetChatItemInfo ChatRef ChatItemId
   | APISendMessages {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage}
@@ -635,6 +635,7 @@ data ChatResponse
   | CRChatItemReaction {user :: User, added :: Bool, reaction :: ACIReaction}
   | CRReactionMembers {user :: User, memberReactions :: [MemberReaction]}
   | CRChatItemsDeleted {user :: User, chatItemDeletions :: [ChatItemDeletion], byUser :: Bool, timed :: Bool}
+  | CRGroupChatItemsDeleted {user :: User, groupInfo :: GroupInfo, chatItemIDs :: [ChatItemId], byUser :: Bool, member_ :: Maybe GroupMember}
   | CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
   | CRBroadcastSent {user :: User, msgContent :: MsgContent, successes :: Int, failures :: Int, timestamp :: UTCTime}
   | CRMsgIntegrityError {user :: User, msgError :: MsgErrorType}
@@ -867,6 +868,12 @@ logResponseToFile = \case
   CRMessageError {} -> True
   _ -> False
 
+data ContentFilter = ContentFilter
+  { mcTag :: MsgContentTag,
+    deleted :: Maybe Bool
+  }
+  deriving (Show)
+
 data ChatPagination
   = CPLast Int
   | CPAfter ChatItemId Int

src/Simplex/Chat/Library/Commands.hs

@@ -481,15 +481,17 @@ processChatCommand' vr = \case
     (errs, previews) <- partitionEithers <$> withFastStore' (\db -> getChatPreviews db vr user pendingConnections pagination query)
     unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
     pure $ CRApiChats user previews
-  APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
+  APIGetChat (ChatRef cType cId) contentFilter pagination search -> withUser $ \user -> case cType of
     -- TODO optimize queries calculating ChatStats, currently they're disabled
     CTDirect -> do
+      when (isJust contentFilter) $ throwChatError $ CECommandError "content filter not supported"
       (directChat, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId pagination search)
       pure $ CRApiChat user (AChat SCTDirect directChat) navInfo
     CTGroup -> do
-      (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId pagination search)
+      (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId contentFilter pagination search)
       pure $ CRApiChat user (AChat SCTGroup groupChat) navInfo
     CTLocal -> do
+      when (isJust contentFilter) $ throwChatError $ CECommandError "content filter not supported"
       (localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId pagination search)
       pure $ CRApiChat user (AChat SCTLocal localChat) navInfo
     CTContactRequest -> pure $ chatCmdError (Just user) "not implemented"
@@ -2158,14 +2160,14 @@ processChatCommand' vr = \case
     pure $ CRChats previews
   LastMessages (Just chatName) count search -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    chatResp <- processChatCommand $ APIGetChat chatRef (CPLast count) search
+    chatResp <- processChatCommand $ APIGetChat chatRef Nothing (CPLast count) search
     pure $ CRChatItems user (Just chatName) (aChatItems . chat $ chatResp)
   LastMessages Nothing count search -> withUser $ \user -> do
     chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast count) search
     pure $ CRChatItems user Nothing chatItems
   LastChatItemId (Just chatName) index -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    chatResp <- processChatCommand (APIGetChat chatRef (CPLast $ index + 1) Nothing)
+    chatResp <- processChatCommand (APIGetChat chatRef Nothing (CPLast $ index + 1) Nothing)
     pure $ CRChatItemId user (fmap aChatItemId . listToMaybe . aChatItems . chat $ chatResp)
   LastChatItemId Nothing index -> withUser $ \user -> do
     chatItems <- withFastStore $ \db -> getAllChatItems db vr user (CPLast $ index + 1) Nothing
@@ -2639,6 +2641,9 @@ processChatCommand' vr = \case
     delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> CM ChatResponse
     delGroupChatItems user gInfo items byGroupMember = do
       deletedTs <- liftIO getCurrentTime
+      forM_ byGroupMember $ \byMember -> do
+        ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci byMember deletedTs)
+        unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just byMember)
       if groupFeatureAllowed SGFFullDelete gInfo
         then deleteGroupCIs user gInfo items True False byGroupMember deletedTs
         else markGroupCIsDeleted user gInfo items True byGroupMember deletedTs
@@ -3573,7 +3578,7 @@ chatCommandP =
               <*> (A.space *> paginationByTimeP <|> pure (PTLast 5000))
               <*> (A.space *> jsonP <|> pure clqNoFilters)
            ),
-      "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
+      "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> optional (contentFilterP <* A.space) <*> chatPaginationP <*> optional (" search=" *> stringP)),
       "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
       "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
       "/_send " *> (APISendMessages <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)),
@@ -3948,6 +3953,7 @@ chatCommandP =
         ct -> ChatName ct <$> displayName
     chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName
     chatRefP = ChatRef <$> chatTypeP <*> A.decimal
+    contentFilterP = ContentFilter <$> ("content=" *> strP) <*> optional (" deleted=" *> onOffP)
     msgCountP = A.space *> A.decimal <|> pure 10
     ciTTLDecimal = ("none" $> Nothing) <|> (Just <$> A.decimal)
     ciTTL =

src/Simplex/Chat/Library/Subscriber.hs

@@ -1840,7 +1840,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         moderate :: GroupMember -> CChatItem 'CTGroup -> CM ()
         moderate mem cci = case sndMemberId_ of
           Just sndMemberId
-            | sameMemberId sndMemberId mem -> checkRole mem $ delete cci (Just m) >>= toView
+            | sameMemberId sndMemberId mem -> checkRole mem $ do
+                delete cci (Just m) >>= toView
+                archiveMessageReports cci m
             | otherwise -> messageError "x.msg.del: message of another member with incorrect memberId"
           _ -> messageError "x.msg.del: message of another member without memberId"
         checkRole GroupMember {memberRole} a
@@ -1851,6 +1853,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         delete cci byGroupMember
           | groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCIs user gInfo [cci] False False byGroupMember brokerTs
           | otherwise = markGroupCIsDeleted user gInfo [cci] False byGroupMember brokerTs
+        archiveMessageReports :: CChatItem 'CTGroup -> GroupMember -> CM ()
+        archiveMessageReports (CChatItem _ ci) byMember = do
+          ciIds <- withStore' $ \db -> markMessageReportsDeleted db user gInfo ci byMember brokerTs
+          unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just byMember)
 
     -- TODO remove once XFile is discontinued
     processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> CM ()

src/Simplex/Chat/Messages.hs

@@ -91,14 +91,6 @@ chatInfoChatTs = \case
   GroupChat GroupInfo {chatTs} -> chatTs
   _ -> Nothing
 
-chatInfoUpdatedAt :: ChatInfo c -> UTCTime
-chatInfoUpdatedAt = \case
-  DirectChat Contact {updatedAt} -> updatedAt
-  GroupChat GroupInfo {updatedAt} -> updatedAt
-  LocalChat NoteFolder {updatedAt} -> updatedAt
-  ContactRequest UserContactRequest {updatedAt} -> updatedAt
-  ContactConnection PendingContactConnection {updatedAt} -> updatedAt
-
 chatInfoToRef :: ChatInfo c -> ChatRef
 chatInfoToRef = \case
   DirectChat Contact {contactId} -> ChatRef CTDirect contactId
@@ -318,12 +310,17 @@ data AChat = forall c. ChatTypeI c => AChat (SChatType c) (Chat c)
 deriving instance Show AChat
 
 data ChatStats = ChatStats
-  { unreadCount :: Int,
+  { unreadCount :: Int, -- returned both in /_get chat initial API and in /_get chats API
+    reportsCount :: Int, -- returned both in /_get chat initial API and in /_get chats API
+    archivedReportsCount :: Int, -- only returned in /_get chat initial API
     minUnreadItemId :: ChatItemId,
     unreadChat :: Bool
   }
   deriving (Show)
 
+emptyChatStats :: ChatStats
+emptyChatStats = ChatStats 0 0 0 0 False
+
 data NavigationInfo = NavigationInfo
   { afterUnread :: Int,
     afterTotal :: Int

src/Simplex/Chat/Migrations/M20250105_indexes.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20250105_indexes where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20250105_indexes :: Query
+m20250105_indexes =
+  [sql|
+CREATE INDEX idx_chat_items_groups_msg_content_tag_item_ts ON chat_items(user_id, group_id, msg_content_tag, item_ts);
+CREATE INDEX idx_chat_items_groups_msg_content_tag_item_deleted_item_ts ON chat_items(user_id, group_id, msg_content_tag, item_deleted, item_ts);
+|]
+
+down_m20250105_indexes :: Query
+down_m20250105_indexes =
+  [sql|
+DROP INDEX idx_chat_items_groups_msg_content_tag_item_ts;
+DROP INDEX idx_chat_items_groups_msg_content_tag_item_deleted_item_ts;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -962,3 +962,16 @@ CREATE UNIQUE INDEX idx_chat_tags_chats_chat_tag_id_group_id ON chat_tags_chats(
   group_id,
   chat_tag_id
 );
+CREATE INDEX idx_chat_items_groups_msg_content_tag_item_ts ON chat_items(
+  user_id,
+  group_id,
+  msg_content_tag,
+  item_ts
+);
+CREATE INDEX idx_chat_items_groups_msg_content_tag_item_deleted_item_ts ON chat_items(
+  user_id,
+  group_id,
+  msg_content_tag,
+  item_deleted,
+  item_ts
+);

src/Simplex/Chat/Protocol.hs

@@ -70,7 +70,7 @@ import Simplex.Messaging.Version hiding (version)
 -- 9 - batch sending in direct connections (2024-07-24)
 -- 10 - business chats (2024-11-29)
 -- 11 - fix profile update in business chats (2024-12-05)
--- 12 - fix profile update in business chats (2025-01-03)
+-- 12 - support sending and receiving content reports (2025-01-03)
 
 -- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
 -- This indirection is needed for backward/forward compatibility testing.
@@ -443,7 +443,7 @@ instance FromJSON MREmojiChar where
 
 mrEmojiChar :: Char -> Either String MREmojiChar
 mrEmojiChar c
-  | c `elem` ("👍👎😀😢❤️🚀" :: String) = Right $ MREmojiChar c
+  | c `elem` ("👍👎😀😂😢❤️🚀✅" :: String) = Right $ MREmojiChar c
   | otherwise = Left "bad emoji"
 
 data FileChunk = FileChunk {chunkNo :: Integer, chunkBytes :: ByteString} | FileChunkCancel
@@ -485,7 +485,7 @@ cmToQuotedMsg = \case
   _ -> Nothing
 
 data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVideo_ | MCVoice_ | MCFile_ | MCReport_ | MCUnknown_ Text
-  deriving (Eq)
+  deriving (Eq, Show)
 
 instance StrEncoding MsgContentTag where
   strEncode = \case
@@ -522,6 +522,7 @@ instance ToField MsgContentTag where toField = toField . strEncode
 data MsgContainer
   = MCSimple ExtMsgContent
   | MCQuote QuotedMsg ExtMsgContent
+  | MCComment MsgRef ExtMsgContent
   | MCForward ExtMsgContent
   deriving (Eq, Show)
 
@@ -529,13 +530,9 @@ mcExtMsgContent :: MsgContainer -> ExtMsgContent
 mcExtMsgContent = \case
   MCSimple c -> c
   MCQuote _ c -> c
+  MCComment _ c -> c
   MCForward c -> c
 
-isQuote :: MsgContainer -> Bool
-isQuote = \case
-  MCQuote {} -> True
-  _ -> False
-
 data MsgContent
   = MCText Text
   | MCLink {text :: Text, preview :: LinkPreview}
@@ -564,9 +561,6 @@ msgContentText = \case
       msg = "report " <> safeDecodeUtf8 (strEncode reason)
   MCUnknown {text} -> text
 
-toMCText :: MsgContent -> MsgContent
-toMCText = MCText . msgContentText
-
 durationText :: Int -> Text
 durationText duration =
   let (mins, secs) = duration `divMod` 60 in T.pack $ "(" <> with0 mins <> ":" <> with0 secs <> ")"
@@ -657,7 +651,10 @@ markCompressedBatch = B.cons 'X'
 parseMsgContainer :: J.Object -> JT.Parser MsgContainer
 parseMsgContainer v =
   MCQuote <$> v .: "quote" <*> mc
+    <|> MCComment <$> v .: "parent" <*> mc
     <|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc)
+    -- The support for arbitrary object in "forward" property is added to allow
+    -- forward compatibility with forwards that include public group links.
     <|> (MCForward <$> ((v .: "forward" :: JT.Parser J.Object) *> mc))
     <|> MCSimple <$> mc
   where
@@ -708,6 +705,7 @@ unknownMsgType = "unknown message type"
 msgContainerJSON :: MsgContainer -> J.Object
 msgContainerJSON = \case
   MCQuote qm mc -> o $ ("quote" .= qm) : msgContent mc
+  MCComment ref mc -> o $ ("parent" .= ref) : msgContent mc
   MCForward mc -> o $ ("forward" .= True) : msgContent mc
   MCSimple mc -> o $ msgContent mc
   where

src/Simplex/Chat/Store/Migrations.hs

@@ -122,6 +122,7 @@ import Simplex.Chat.Migrations.M20241205_business_chat_members
 import Simplex.Chat.Migrations.M20241222_operator_conditions
 import Simplex.Chat.Migrations.M20241223_chat_tags
 import Simplex.Chat.Migrations.M20241230_reports
+import Simplex.Chat.Migrations.M20250105_indexes
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -243,7 +244,8 @@ schemaMigrations =
     ("20241205_business_chat_members", m20241205_business_chat_members, Just down_m20241205_business_chat_members),
     ("20241222_operator_conditions", m20241222_operator_conditions, Just down_m20241222_operator_conditions),
     ("20241223_chat_tags", m20241223_chat_tags, Just down_m20241223_chat_tags),
-    ("20241230_reports", m20241230_reports, Just down_m20241230_reports)
+    ("20241230_reports", m20241230_reports, Just down_m20241230_reports),
+    ("20250105_indexes", m20250105_indexes, Just down_m20250105_indexes)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/View.hs

@@ -156,6 +156,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
     [ChatItemDeletion (AChatItem _ _ chat deletedItem) toItem] ->
       ttyUser u $ unmuted u chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
     deletions' -> ttyUser u [sShow (length deletions') <> " messages deleted"]
+  CRGroupChatItemsDeleted u g ciIds byUser member_ -> ttyUser u [ttyGroup' g <> ": " <> sShow (length ciIds) <> " messages deleted by " <> if byUser then "user" else "member" <> maybe "" (\m -> " " <> ttyMember m) member_]
   CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction u chat reaction $ viewItemReaction showReactions chat reaction added ts tz
   CRReactionMembers u memberReactions -> ttyUser u $ viewReactionMembers memberReactions
   CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"]

tests/ChatTests/Groups.hs

@@ -6600,3 +6600,34 @@ testGroupMemberReports =
             bob <## "      report content",
           (cath </)
         ]
+      alice #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content")])
+      alice #$> ("/_get chat #1 content=report deleted=off count=100", chat, [(0, "report content")])
+      alice #$> ("/_get chat #1 content=report deleted=on count=100", chat, [])
+      bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content")])
+      bob #$> ("/_get chat #1 content=report deleted=off count=100", chat, [(0, "report content")])
+      bob #$> ("/_get chat #1 content=report deleted=on count=100", chat, [])
+      dan #$> ("/_get chat #1 content=report count=100", chat, [(1, "report content")])
+      dan #$> ("/_get chat #1 content=report deleted=off count=100", chat, [(1, "report content")])
+      dan #$> ("/_get chat #1 content=report deleted=on count=100", chat, [])
+      alice ##> "\\\\ #jokes cath inappropriate joke"
+      concurrentlyN_
+        [ do
+            alice <## "#jokes: 1 messages deleted by member alice"
+            alice <## "message marked deleted by you",
+          do
+            bob <# "#jokes cath> [marked deleted by alice] inappropriate joke"
+            bob <## "#jokes: 1 messages deleted by member alice",
+          cath <# "#jokes cath> [marked deleted by alice] inappropriate joke",
+          do
+            dan <# "#jokes cath> [marked deleted by alice] inappropriate joke"
+            dan <## "#jokes: 1 messages deleted by member alice"
+        ]
+      alice #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by you]")])
+      alice #$> ("/_get chat #1 content=report deleted=off count=100", chat, [])
+      alice #$> ("/_get chat #1 content=report deleted=on count=100", chat, [(0, "report content [marked deleted by you]")])
+      bob #$> ("/_get chat #1 content=report count=100", chat, [(0, "report content [marked deleted by alice]")])
+      bob #$> ("/_get chat #1 content=report deleted=off count=100", chat, [])
+      bob #$> ("/_get chat #1 content=report deleted=on count=100", chat, [(0, "report content [marked deleted by alice]")])
+      dan #$> ("/_get chat #1 content=report count=100", chat, [(1, "report content [marked deleted by alice]")])
+      dan #$> ("/_get chat #1 content=report deleted=off count=100", chat, [])
+      dan #$> ("/_get chat #1 content=report deleted=on count=100", chat, [(1, "report content [marked deleted by alice]")])