core: role for full delete preference (#5572)

* core: role for full delete preference

* fix

src/Simplex/Chat/Library/Commands.hs

@@ -678,7 +678,7 @@ processChatCommand' vr = \case
           let msgIds = itemsMsgIds items
               events = L.nonEmpty $ map (`XMsgDel` Nothing) msgIds
           mapM_ (sendGroupMessages user gInfo ms) events
-          delGroupChatItems user gInfo items Nothing
+          delGroupChatItems user gInfo items False
     CTLocal -> do
       (nf, items) <- getCommandLocalChatItems user chatId itemIds
       deleteLocalCIs user nf items True False
@@ -706,7 +706,7 @@ processChatCommand' vr = \case
     let msgMemIds = itemsMsgMemIds gInfo items
         events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId (Just memId)) msgMemIds
     mapM_ (sendGroupMessages user gInfo ms) events
-    delGroupChatItems user gInfo items (Just membership)
+    delGroupChatItems user gInfo items True
     where
       assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM ()
       assertDeletable GroupInfo {membership = GroupMember {memberRole = membershipMemRole}} items =
@@ -2707,15 +2707,16 @@ processChatCommand' vr = \case
       when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g)
       when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved
       unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
-    delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Maybe GroupMember -> CM ChatResponse
-    delGroupChatItems user gInfo items byGroupMember = do
+    delGroupChatItems :: User -> GroupInfo -> [CChatItem 'CTGroup] -> Bool -> CM ChatResponse
+    delGroupChatItems user gInfo@GroupInfo {membership} items moderation = 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
+      when moderation $ do
+        ciIds <- concat <$> withStore' (\db -> forM items $ \(CChatItem _ ci) -> markMessageReportsDeleted db user gInfo ci membership deletedTs)
+        unless (null ciIds) $ toView $ CRGroupChatItemsDeleted user gInfo ciIds False (Just membership)
+      let m = if moderation then Just membership else Nothing
+      if groupFeatureMemberAllowed SGFFullDelete membership gInfo
+        then deleteGroupCIs user gInfo items True False m deletedTs
+        else markGroupCIsDeleted user gInfo items True m deletedTs
     updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse
     updateGroupProfileByName gName update = withUser $ \user -> do
       g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db ->
@@ -3919,7 +3920,7 @@ chatCommandP =
       "/set reactions #" *> (SetGroupFeature (AGFNR SGFReactions) <$> displayNameP <*> (A.space *> strP)),
       "/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayNameP <*> optional (A.space *> strP)),
       "/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP),
-      "/set delete #" *> (SetGroupFeature (AGFNR SGFFullDelete) <$> displayNameP <*> (A.space *> strP)),
+      "/set delete #" *> (SetGroupFeatureRole (AGFR SGFFullDelete) <$> displayNameP <*> _strP <*> optional memberRole),
       "/set delete @" *> (SetContactFeature (ACF SCFFullDelete) <$> displayNameP <*> optional (A.space *> strP)),
       "/set delete " *> (SetUserFeature (ACF SCFFullDelete) <$> strP),
       "/set direct #" *> (SetGroupFeatureRole (AGFR SGFDirectMessages) <$> displayNameP <*> _strP <*> optional memberRole),

src/Simplex/Chat/Library/Subscriber.hs

@@ -1742,7 +1742,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         live' = fromMaybe False live_
         ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
         createBlockedByAdmin
-          | groupFeatureAllowed SGFFullDelete gInfo = do
+          | groupFeatureAllowed SGFFullDelete gInfo = do -- ignores member role when blocked by admin
               ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvBlocked Nothing timed' False
               ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs
               groupMsgToView gInfo ci'
@@ -1754,7 +1754,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         applyModeration CIModeration {moderatorMember = moderator@GroupMember {memberRole = moderatorRole}, moderatedAt}
           | moderatorRole < GRModerator || moderatorRole < memberRole =
               createContentItem
-          | groupFeatureAllowed SGFFullDelete gInfo = do
+          | groupFeatureMemberAllowed SGFFullDelete moderator gInfo = do
               ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs CIRcvModerated Nothing timed' False
               ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
               groupMsgToView gInfo ci'
@@ -1854,7 +1854,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           | otherwise = a
         delete :: CChatItem 'CTGroup -> Maybe GroupMember -> CM ChatResponse
         delete cci byGroupMember
-          | groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCIs user gInfo [cci] False False byGroupMember brokerTs
+          | groupFeatureMemberAllowed SGFFullDelete m 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

src/Simplex/Chat/Types/Preferences.hs

@@ -377,7 +377,7 @@ defaultGroupPrefs =
   FullGroupPreferences
     { timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400},
       directMessages = DirectMessagesGroupPreference {enable = FEOff, role = Nothing},
-      fullDelete = FullDeleteGroupPreference {enable = FEOff},
+      fullDelete = FullDeleteGroupPreference {enable = FEOn, role = Just GRModerator},
       reactions = ReactionsGroupPreference {enable = FEOn},
       voice = VoiceGroupPreference {enable = FEOn, role = Nothing},
       files = FilesGroupPreference {enable = FEOn, role = Nothing},
@@ -392,7 +392,7 @@ 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},
+      fullDelete = Just FullDeleteGroupPreference {enable = maybe FEOff enableFeature fullDelete, role = Just GRModerator},
       reactions = Just ReactionsGroupPreference {enable = maybe FEOn enableFeature reactions},
       voice = Just VoiceGroupPreference {enable = maybe FEOff enableFeature voice, role = Nothing}
     }
@@ -407,7 +407,7 @@ defaultBusinessGroupPrefs =
   GroupPreferences
     { timedMessages = Just $ TimedMessagesGroupPreference FEOff Nothing,
       directMessages = Just $ DirectMessagesGroupPreference FEOff Nothing,
-      fullDelete = Just $ FullDeleteGroupPreference FEOff,
+      fullDelete = Just $ FullDeleteGroupPreference FEOn (Just GRModerator),
       reactions = Just $ ReactionsGroupPreference FEOn,
       voice = Just $ VoiceGroupPreference FEOff Nothing,
       files = Just $ FilesGroupPreference FEOn Nothing,
@@ -493,7 +493,7 @@ data DirectMessagesGroupPreference = DirectMessagesGroupPreference
   deriving (Eq, Show)
 
 data FullDeleteGroupPreference = FullDeleteGroupPreference
-  {enable :: GroupFeatureEnabled}
+  {enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole}
   deriving (Eq, Show)
 
 data ReactionsGroupPreference = ReactionsGroupPreference
@@ -569,7 +569,7 @@ instance GroupFeatureI 'GFFullDelete where
   type GroupFeaturePreference 'GFFullDelete = FullDeleteGroupPreference
   sGroupFeature = SGFFullDelete
   groupPrefParam _ = Nothing
-  groupPrefRole _ = Nothing
+  groupPrefRole FullDeleteGroupPreference {role} = role
 
 instance GroupFeatureI 'GFReactions where
   type GroupFeaturePreference 'GFReactions = ReactionsGroupPreference
@@ -612,6 +612,9 @@ instance GroupFeatureNoRoleI 'GFHistory
 instance HasField "role" DirectMessagesGroupPreference (Maybe GroupMemberRole) where
   hasField p@DirectMessagesGroupPreference {role} = (\r -> p {role = r}, role)
 
+instance HasField "role" FullDeleteGroupPreference (Maybe GroupMemberRole) where
+  hasField p@FullDeleteGroupPreference {role} = (\r -> p {role = r}, role)
+
 instance HasField "role" VoiceGroupPreference (Maybe GroupMemberRole) where
   hasField p@VoiceGroupPreference {role} = (\r -> p {role = r}, role)
 
@@ -623,6 +626,8 @@ instance HasField "role" SimplexLinksGroupPreference (Maybe GroupMemberRole) whe
 
 instance GroupFeatureRoleI 'GFDirectMessages
 
+instance GroupFeatureRoleI 'GFFullDelete
+
 instance GroupFeatureRoleI 'GFVoice
 
 instance GroupFeatureRoleI 'GFFiles