core, ui: report preference (#5620)

* core: report preference

* fix tests

* ios: disable reports toggle until 6.4

* android, desktop: reports preference

* ui: section

* boolean

src/Simplex/Chat/Library/Commands.hs

@@ -3066,7 +3066,7 @@ processChatCommand' vr = \case
             findProhibited :: [ComposedMessageReq] -> Maybe GroupFeature
             findProhibited =
               foldr'
-                (\(ComposedMessage {fileSource, msgContent = mc}, _, (_, ft), _) acc -> prohibitedGroupContent gInfo membership mc ft fileSource <|> acc)
+                (\(ComposedMessage {fileSource, msgContent = mc}, _, (_, ft), _) acc -> prohibitedGroupContent gInfo membership mc ft fileSource True <|> acc)
                 Nothing
         processComposedMessages :: CM ChatResponse
         processComposedMessages = do
@@ -3974,6 +3974,7 @@ chatCommandP =
       "/set disappear #" *> (SetGroupTimedMessages <$> displayNameP <*> (A.space *> timedTTLOnOffP)),
       "/set disappear @" *> (SetContactTimedMessages <$> displayNameP <*> optional (A.space *> timedMessagesEnabledP)),
       "/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
+      "/set reports #" *> (SetGroupFeature (AGFNR SGFReports) <$> displayNameP <*> _strP),
       "/set links #" *> (SetGroupFeatureRole (AGFR SGFSimplexLinks) <$> displayNameP <*> _strP <*> optional memberRole),
       ("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito,
       "/set device name " *> (SetLocalDeviceName <$> textP),

src/Simplex/Chat/Library/Internal.hs

@@ -320,12 +320,18 @@ quoteContent mc qmc ciFile_
     qFileName = maybe qText (T.pack . getFileName) ciFile_
     qTextOrFile = if T.null qText then qFileName else qText
 
-prohibitedGroupContent :: GroupInfo -> GroupMember -> MsgContent -> Maybe MarkdownList -> Maybe f -> Maybe GroupFeature
-prohibitedGroupContent gInfo m mc ft file_
+prohibitedGroupContent :: GroupInfo -> GroupMember -> MsgContent -> Maybe MarkdownList -> Maybe f -> Bool -> Maybe GroupFeature
+prohibitedGroupContent gInfo@GroupInfo {membership = GroupMember {memberRole = userRole}} m mc ft file_ sent
   | isVoice mc && not (groupFeatureMemberAllowed SGFVoice m gInfo) = Just GFVoice
   | not (isVoice mc) && isJust file_ && not (groupFeatureMemberAllowed SGFFiles m gInfo) = Just GFFiles
+  | isReport mc && (badReportUser || not (groupFeatureAllowed SGFReports gInfo)) = Just GFReports
   | prohibitedSimplexLinks gInfo m ft = Just GFSimplexLinks
   | otherwise = Nothing
+  where
+    -- admins cannot send reports, non-admins cannot receive reports
+    badReportUser
+      | sent = userRole >= GRModerator
+      | otherwise = userRole < GRModerator
 
 prohibitedSimplexLinks :: GroupInfo -> GroupMember -> Maybe MarkdownList -> Bool
 prohibitedSimplexLinks gInfo m ft =

src/Simplex/Chat/Library/Subscriber.hs

@@ -1720,7 +1720,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> CM ()
     newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded
       | blockedByAdmin m = createBlockedByAdmin
-      | otherwise = case prohibitedGroupContent gInfo m content ft_ fInv_ of
+      | otherwise = case prohibitedGroupContent gInfo m content ft_ fInv_ False of
           Just f -> rejected f
           Nothing ->
             withStore' (\db -> getCIModeration db vr user gInfo memberId sharedMsgId_) >>= \case
@@ -1729,7 +1729,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                 withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
               Nothing -> createContentItem
       where
-        rejected f = void $ newChatItem (ciContentNoParse $ CIRcvGroupFeatureRejected f) Nothing Nothing False
+        rejected f = newChatItem (ciContentNoParse $ CIRcvGroupFeatureRejected f) Nothing Nothing False
         timed' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo itemTTL
         live' = fromMaybe False live_
         ExtMsgContent content mentions fInv_ itemTTL live_ = mcExtMsgContent mc

src/Simplex/Chat/Protocol.hs

@@ -410,8 +410,8 @@ forwardedToGroupMembers ms forwardedMsgs =
         XGrpMemRestrict mId _ -> Just mId
         _ -> Nothing
       _ -> Nothing
-    hasReport = any isReport forwardedMsgs
-    isReport ChatMessage {chatMsgEvent} = case encoding @e of
+    hasReport = any isReportEvent forwardedMsgs
+    isReportEvent ChatMessage {chatMsgEvent} = case encoding @e of
       SJson -> case chatMsgEvent of
         XMsgNew mc -> case mcExtMsgContent mc of
           ExtMsgContent {content = MCReport {}} -> True
@@ -600,6 +600,11 @@ isVoice = \case
   MCVoice {} -> True
   _ -> False
 
+isReport :: MsgContent -> Bool
+isReport = \case
+  MCReport {} -> True
+  _ -> False
+
 msgContentTag :: MsgContent -> MsgContentTag
 msgContentTag = \case
   MCText _ -> MCText_

src/Simplex/Chat/Store/Messages.hs

@@ -2453,10 +2453,10 @@ markReceivedGroupReportsDeleted db User {userId} GroupInfo {groupId, membership}
       [sql|
         UPDATE chat_items
         SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
-        WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND item_deleted = ? AND item_sent = ?
+        WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND item_deleted = ? AND item_sent = 0
         RETURNING chat_item_id
       |]
-      (DBCIDeleted, deletedTs, groupMemberId' membership, currentTs, userId, groupId, MCReport_, DBCINotDeleted, False)
+      (DBCIDeleted, deletedTs, groupMemberId' membership, currentTs, userId, groupId, MCReport_, DBCINotDeleted)
 
 getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupInfo -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup)
 getGroupChatItemBySharedMsgId db user@User {userId} g@GroupInfo {groupId} groupMemberId sharedMsgId = do

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

@@ -3322,6 +3322,15 @@ Query:
 Plan:
 SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
 
+Query: 
+        UPDATE chat_items
+        SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
+        WHERE user_id = ? AND group_id = ? AND msg_content_tag = ? AND item_deleted = ? AND item_sent = ?
+        RETURNING chat_item_id
+      
+Plan:
+SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id=? AND msg_content_tag=? AND item_deleted=? AND item_sent=?)
+
 Query: 
         UPDATE chat_items
         SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?

src/Simplex/Chat/Types/Preferences.hs

@@ -149,6 +149,7 @@ data GroupFeature
   | GFVoice
   | GFFiles
   | GFSimplexLinks
+  | GFReports
   | GFHistory
   deriving (Show)
 
@@ -160,6 +161,7 @@ data SGroupFeature (f :: GroupFeature) where
   SGFVoice :: SGroupFeature 'GFVoice
   SGFFiles :: SGroupFeature 'GFFiles
   SGFSimplexLinks :: SGroupFeature 'GFSimplexLinks
+  SGFReports :: SGroupFeature 'GFReports
   SGFHistory :: SGroupFeature 'GFHistory
 
 deriving instance Show (SGroupFeature f)
@@ -185,6 +187,7 @@ groupFeatureNameText = \case
   GFVoice -> "Voice messages"
   GFFiles -> "Files and media"
   GFSimplexLinks -> "SimpleX links"
+  GFReports -> "Member reports"
   GFHistory -> "Recent history"
 
 groupFeatureNameText' :: SGroupFeature f -> Text
@@ -208,11 +211,12 @@ allGroupFeatures =
     AGF SGFVoice,
     AGF SGFFiles,
     AGF SGFSimplexLinks,
+    AGF SGFReports,
     AGF SGFHistory
   ]
 
 groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
-groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, history} = case f of
+groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history} = case f of
   SGFTimedMessages -> timedMessages
   SGFDirectMessages -> directMessages
   SGFFullDelete -> fullDelete
@@ -220,6 +224,7 @@ groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reac
   SGFVoice -> voice
   SGFFiles -> files
   SGFSimplexLinks -> simplexLinks
+  SGFReports -> reports
   SGFHistory -> history
 
 toGroupFeature :: SGroupFeature f -> GroupFeature
@@ -231,6 +236,7 @@ toGroupFeature = \case
   SGFVoice -> GFVoice
   SGFFiles -> GFFiles
   SGFSimplexLinks -> GFSimplexLinks
+  SGFReports -> GFReports
   SGFHistory -> GFHistory
 
 class GroupPreferenceI p where
@@ -243,7 +249,7 @@ instance GroupPreferenceI (Maybe GroupPreferences) where
   getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
 
 instance GroupPreferenceI FullGroupPreferences where
-  getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, history} = case f of
+  getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history} = case f of
     SGFTimedMessages -> timedMessages
     SGFDirectMessages -> directMessages
     SGFFullDelete -> fullDelete
@@ -251,6 +257,7 @@ instance GroupPreferenceI FullGroupPreferences where
     SGFVoice -> voice
     SGFFiles -> files
     SGFSimplexLinks -> simplexLinks
+    SGFReports -> reports
     SGFHistory -> history
   {-# INLINE getGroupPreference #-}
 
@@ -263,6 +270,7 @@ data GroupPreferences = GroupPreferences
     voice :: Maybe VoiceGroupPreference,
     files :: Maybe FilesGroupPreference,
     simplexLinks :: Maybe SimplexLinksGroupPreference,
+    reports :: Maybe ReportsGroupPreference,
     history :: Maybe HistoryGroupPreference
   }
   deriving (Eq, Show)
@@ -296,6 +304,7 @@ setGroupPreference_ f pref prefs =
     SGFVoice -> prefs {voice = pref}
     SGFFiles -> prefs {files = pref}
     SGFSimplexLinks -> prefs {simplexLinks = pref}
+    SGFReports -> prefs {reports = pref}
     SGFHistory -> prefs {history = pref}
 
 setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
@@ -325,6 +334,7 @@ data FullGroupPreferences = FullGroupPreferences
     voice :: VoiceGroupPreference,
     files :: FilesGroupPreference,
     simplexLinks :: SimplexLinksGroupPreference,
+    reports :: ReportsGroupPreference,
     history :: HistoryGroupPreference
   }
   deriving (Eq, Show)
@@ -377,22 +387,23 @@ defaultGroupPrefs =
   FullGroupPreferences
     { timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400},
       directMessages = DirectMessagesGroupPreference {enable = FEOff, role = Nothing},
-      fullDelete = FullDeleteGroupPreference {enable = FEOn, role = Just GRModerator},
+      fullDelete = FullDeleteGroupPreference {enable = FEOff, role = Nothing},
       reactions = ReactionsGroupPreference {enable = FEOn},
       voice = VoiceGroupPreference {enable = FEOn, role = Nothing},
       files = FilesGroupPreference {enable = FEOn, role = Nothing},
       simplexLinks = SimplexLinksGroupPreference {enable = FEOn, role = Nothing},
+      reports = ReportsGroupPreference {enable = FEOn},
       history = HistoryGroupPreference {enable = FEOff}
     }
 
 emptyGroupPrefs :: GroupPreferences
-emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 businessGroupPrefs :: Preferences -> GroupPreferences
 businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice} =
   defaultBusinessGroupPrefs
     { timedMessages = Just TimedMessagesGroupPreference {enable = maybe FEOff enableFeature timedMessages, ttl = maybe Nothing prefParam timedMessages},
-      fullDelete = Just FullDeleteGroupPreference {enable = maybe FEOff enableFeature fullDelete, role = Just GRModerator},
+      fullDelete = Just FullDeleteGroupPreference {enable = maybe FEOff enableFeature fullDelete, role = Nothing},
       reactions = Just ReactionsGroupPreference {enable = maybe FEOn enableFeature reactions},
       voice = Just VoiceGroupPreference {enable = maybe FEOff enableFeature voice, role = Nothing}
     }
@@ -412,6 +423,7 @@ defaultBusinessGroupPrefs =
       voice = Just $ VoiceGroupPreference FEOff Nothing,
       files = Just $ FilesGroupPreference FEOn Nothing,
       simplexLinks = Just $ SimplexLinksGroupPreference FEOn Nothing,
+      reports = Just $ ReportsGroupPreference FEOff,
       history = Just $ HistoryGroupPreference FEOn
     }
 
@@ -512,6 +524,10 @@ data SimplexLinksGroupPreference = SimplexLinksGroupPreference
   {enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole}
   deriving (Eq, Show)
 
+data ReportsGroupPreference = ReportsGroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show)
+
 data HistoryGroupPreference = HistoryGroupPreference
   {enable :: GroupFeatureEnabled}
   deriving (Eq, Show)
@@ -550,6 +566,9 @@ instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
 instance HasField "enable" SimplexLinksGroupPreference GroupFeatureEnabled where
   hasField p@SimplexLinksGroupPreference {enable} = (\e -> p {enable = e}, enable)
 
+instance HasField "enable" ReportsGroupPreference GroupFeatureEnabled where
+  hasField p@ReportsGroupPreference {enable} = (\e -> p {enable = e}, enable)
+
 instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
   hasField p@HistoryGroupPreference {enable} = (\e -> p {enable = e}, enable)
 
@@ -595,6 +614,12 @@ instance GroupFeatureI 'GFSimplexLinks where
   groupPrefParam _ = Nothing
   groupPrefRole SimplexLinksGroupPreference {role} = role
 
+instance GroupFeatureI 'GFReports where
+  type GroupFeaturePreference 'GFReports = ReportsGroupPreference
+  sGroupFeature = SGFReports
+  groupPrefParam _ = Nothing
+  groupPrefRole _ = Nothing
+
 instance GroupFeatureI 'GFHistory where
   type GroupFeaturePreference 'GFHistory = HistoryGroupPreference
   sGroupFeature = SGFHistory
@@ -607,6 +632,8 @@ instance GroupFeatureNoRoleI 'GFFullDelete
 
 instance GroupFeatureNoRoleI 'GFReactions
 
+instance GroupFeatureNoRoleI 'GFReports
+
 instance GroupFeatureNoRoleI 'GFHistory
 
 instance HasField "role" DirectMessagesGroupPreference (Maybe GroupMemberRole) where
@@ -761,6 +788,7 @@ mergeGroupPreferences groupPreferences =
       voice = pref SGFVoice,
       files = pref SGFFiles,
       simplexLinks = pref SGFSimplexLinks,
+      reports = pref SGFReports,
       history = pref SGFHistory
     }
   where
@@ -777,6 +805,7 @@ toGroupPreferences groupPreferences =
       voice = pref SGFVoice,
       files = pref SGFFiles,
       simplexLinks = pref SGFSimplexLinks,
+      reports = pref SGFReports,
       history = pref SGFHistory
     }
   where
@@ -885,6 +914,8 @@ $(J.deriveJSON defaultJSON ''FilesGroupPreference)
 
 $(J.deriveJSON defaultJSON ''SimplexLinksGroupPreference)
 
+$(J.deriveJSON defaultJSON ''ReportsGroupPreference)
+
 $(J.deriveJSON defaultJSON ''HistoryGroupPreference)
 
 $(J.deriveJSON defaultJSON ''GroupPreferences)