core: forward reports only to moderators and above roles (#5605)

* core: do not forward reports

* test

* core: forward reports only to moderators and above roles (#5606)

* core: forward reports only to moderators and above roles

* test

* name

* name

---------

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

src/Simplex/Chat/Protocol.hs

@@ -390,19 +390,34 @@ forwardedGroupMsg msg@ChatMessage {chatMsgEvent} = case encoding @e of
   _ -> Nothing
 
 -- applied after checking forwardedGroupMsg and building list of group members to forward to, see Chat;
+--
 -- this filters out members if any of forwarded events in batch is an XGrpMemRestrict event referring to them,
 -- but practically XGrpMemRestrict is not batched with other events so it wouldn't prevent forwarding of other events
--- to these members
+-- to these members;
+--
+-- same for reports (MCReport) - they are not batched with other events, so we can safely filter out
+-- members with role less than moderator when forwarding
 forwardedToGroupMembers :: forall e. MsgEncodingI e => [GroupMember] -> NonEmpty (ChatMessage e) -> [GroupMember]
 forwardedToGroupMembers ms forwardedMsgs =
-  filter (\GroupMember {memberId} -> memberId `notElem` restrictMemberIds) ms
+  filter forwardToMember ms
   where
+    forwardToMember GroupMember {memberId, memberRole} =
+      (memberId `notElem` restrictMemberIds)
+        && (not hasReport || memberRole >= GRModerator)
     restrictMemberIds = mapMaybe restrictMemberId $ L.toList forwardedMsgs
     restrictMemberId ChatMessage {chatMsgEvent} = case encoding @e of
       SJson -> case chatMsgEvent of
         XGrpMemRestrict mId _ -> Just mId
         _ -> Nothing
       _ -> Nothing
+    hasReport = any isReport forwardedMsgs
+    isReport ChatMessage {chatMsgEvent} = case encoding @e of
+      SJson -> case chatMsgEvent of
+        XMsgNew mc -> case mcExtMsgContent mc of
+          ExtMsgContent {content = MCReport {}} -> True
+          _ -> False
+        _ -> False
+      _ -> False
 
 data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
   deriving (Eq, Show)

src/Simplex/Chat/Store/Groups.hs

@@ -891,7 +891,7 @@ getGroupModerators db vr user@User {userId, userContactId} GroupInfo {groupId} =
   map (toContactMember vr user)
     <$> DB.query
       db
-      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND member_role IN (?,?,?)")
+      (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)")
       (userId, userId, groupId, userContactId, GRModerator, GRAdmin, GROwner)
 
 getGroupMembersForExpiration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]

src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt

@@ -4577,7 +4577,7 @@ Query:
       FROM connections cc
       WHERE cc.user_id = ? AND cc.group_member_id = m.group_member_id
     )
-   WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND member_role IN (?,?,?)
+   WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)
 Plan:
 SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
 SEARCH p USING INTEGER PRIMARY KEY (rowid=?)

tests/ChatTests/Groups.hs

@@ -133,6 +133,7 @@ chatGroupTests = do
     it "re-create member contact after deletion, many groups" testRecreateMemberContactManyGroups
   describe "group message forwarding" $ do
     it "forward messages between invitee and introduced (x.msg.new)" testGroupMsgForward
+    it "forward reports to moderators, don't forward to members (x.msg.new, MCReport)" testGroupMsgForwardReport
     it "deduplicate forwarded messages" testGroupMsgForwardDeduplicate
     it "forward message edit (x.msg.update)" testGroupMsgForwardEdit
     it "forward message reaction (x.msg.react)" testGroupMsgForwardReaction
@@ -3980,6 +3981,58 @@ testGroupMsgForward =
       cath <# "#team bob> hi there [>>]"
       cath <# "#team hey team"
 
+testGroupMsgForwardReport :: HasCallStack => TestParams -> IO ()
+testGroupMsgForwardReport =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      setupGroupForwarding3 "team" alice bob cath
+
+      bob #> "#team hi there"
+      alice <# "#team bob> hi there"
+      cath <# "#team bob> hi there [>>]"
+
+      alice ##> "/mr team bob moderator"
+      concurrentlyN_
+        [ alice <## "#team: you changed the role of bob from admin to moderator",
+          bob <## "#team: alice changed your role from admin to moderator",
+          cath <## "#team: alice changed the role of bob from admin to moderator"
+        ]
+
+      cath ##> "/report #team content hi there"
+      cath <# "#team > bob hi there"
+      cath <## "      report content"
+      concurrentlyN_
+        [ do
+            alice <# "#team cath> > bob hi there"
+            alice <## "      report content",
+          do
+            bob <# "#team cath!> > bob hi there [>>]"
+            bob <## "      report content [>>]"
+        ]
+
+      alice ##> "/mr team bob member"
+      concurrentlyN_
+        [ alice <## "#team: you changed the role of bob from moderator to member",
+          bob <## "#team: alice changed your role from moderator to member",
+          cath <## "#team: alice changed the role of bob from moderator to member"
+        ]
+
+      cath ##> "/report #team content hi there"
+      cath <# "#team > bob hi there"
+      cath <## "      report content"
+      concurrentlyN_
+        [ do
+            alice <# "#team cath> > bob hi there"
+            alice <## "      report content",
+          (bob </)
+        ]
+
+      -- regular messages are still forwarded
+
+      cath #> "#team hey team"
+      alice <# "#team cath> hey team"
+      bob <# "#team cath> hey team [>>]"
+
 setupGroupForwarding3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
 setupGroupForwarding3 gName alice bob cath = do
   createGroup3 gName alice bob cath