android-apps-mirrors/SimpleX-Chat
0
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-06-28 12:19:54 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

core: role for full delete preference (#5572)

Browse source 
* core: role for full delete preference

* fix
This commit is contained in:
Evgeny 2025-01-27 07:50:58 +00:00 • committed by GitHub
parent 5072a8475b
commit 1306df81e4
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
5 changed files with 66 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/Simplex/Chat/Library/Commands.hs
View file

@ -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),

6
src/Simplex/Chat/Library/Subscriber.hs
View file

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

15
src/Simplex/Chat/Types/Preferences.hs
View file

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

24
tests/ChatTests/Groups.hs
View file

@ -1249,6 +1249,7 @@ testGroupMessageDelete =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
threadDelay 1000000
-- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events)
alice #> "#team hello!"
@ -1260,7 +1261,7 @@ testGroupMessageDelete =
msgItemId1 <- lastItemId alice
alice #$> ("/_delete item #1 " <> msgItemId1 <> " internal", id, "message deleted")
alice #$> ("/_get chat #1 count=1", chat, [(0, "connected")])
alice #$> ("/_get chat #1 count=2", chat, [(0, "connected"), (1, "Full deletion: off")])
bob #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
cath #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
@ -1286,7 +1287,7 @@ testGroupMessageDelete =
msgItemId2 <- lastItemId alice
alice #$> ("/_delete item #1 " <> msgItemId2 <> " internal", id, "message deleted")
alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)])
alice #$> ("/_get chat #1 count=2", chat', [((0, "connected"), Nothing), ((1, "Full deletion: off"), Nothing)])
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
@ -1333,6 +1334,7 @@ testGroupMessageDeleteMultiple =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
threadDelay 1000000
alice #> "#team hello"
@ -1369,6 +1371,7 @@ testGroupMessageDeleteMultipleManyBatches =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
bob ##> "/set receipts all off"
bob <## "ok"
@ -1606,6 +1609,9 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/set delete #team off"
alice <## "updated group preferences:"
alice <## "Full deletion: off"
addMember "team" alice bob GRAdmin
bob ##> "/j team"
concurrentlyN_
@ -1676,6 +1682,7 @@ testGroupModerate =
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
alice ##> "/mr team cath member"
concurrentlyN_
[ alice <## "#team: you changed the role of cath from admin to member",
@ -1707,6 +1714,7 @@ testGroupModerateOwn =
testChat2 aliceProfile bobProfile $
\alice bob -> do
createGroup2 "team" alice bob
disableFullDeletion2 "team" alice bob
threadDelay 1000000
alice #> "#team hello"
bob <# "#team alice> hello"
@ -1721,6 +1729,7 @@ testGroupModerateMultiple =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
threadDelay 1000000
alice #> "#team hello"
@ -1756,6 +1765,7 @@ testGroupModerateFullDelete =
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
alice ##> "/mr team cath member"
concurrentlyN_
[ alice <## "#team: you changed the role of cath from admin to member",
@ -1794,6 +1804,7 @@ testGroupDelayedModeration ps = do
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do
createGroup2 "team" alice bob
disableFullDeletion2 "team" alice bob
withNewTestChatCfg ps cfg "cath" cathProfile $ \cath -> do
connectUsers alice cath
addMember "team" alice cath GRMember
@ -1840,6 +1851,7 @@ testGroupDelayedModerationFullDelete ps = do
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do
createGroup2 "team" alice bob
disableFullDeletion2 "team" alice bob
withNewTestChatCfg ps cfg "cath" cathProfile $ \cath -> do
connectUsers alice cath
addMember "team" alice cath GRMember
@ -4775,6 +4787,7 @@ testGroupMsgForwardDeletion =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
setupGroupForwarding3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
bob #> "#team hi there"
alice <# "#team bob> hi there"
@ -5492,6 +5505,7 @@ testGroupHistoryDeletedMessage =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup2 "team" alice bob
disableFullDeletion2 "team" alice bob
alice #> "#team hello"
bob <# "#team alice> hello"
@ -6181,6 +6195,7 @@ testBlockForAllMarkedBlocked =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
threadDelay 1000000
@ -6268,6 +6283,7 @@ testBlockForAllFullDelete =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
alice ##> "/set delete #team on"
alice <## "updated group preferences:"
@ -6348,6 +6364,7 @@ testBlockForAllAnotherAdminUnblocks =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
bob #> "#team 1"
[alice, cath] *<# "#team bob> 1"
@ -6376,6 +6393,7 @@ testBlockForAllBeforeJoining =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
bob #> "#team 1"
[alice, cath] *<# "#team bob> 1"
@ -6444,6 +6462,7 @@ testBlockForAllCantRepeat =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
disableFullDeletion3 "team" alice bob cath
alice ##> "/unblock for all #team bob"
alice <## "bad chat command: already unblocked"
@ -6560,6 +6579,7 @@ testGroupMemberReports =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
createGroup3 "jokes" alice bob cath
disableFullDeletion3 "jokes" alice bob cath
alice ##> "/mr jokes bob moderator"
concurrentlyN_
[ alice <## "#jokes: you changed the role of bob from admin to moderator",

20
tests/ChatTests/Utils.hs
View file

@ -300,7 +300,7 @@ groupFeatures'' dir =
[ ((dir, e2eeInfoNoPQStr), Nothing, Nothing),
((dir, "Disappearing messages: off"), Nothing, Nothing),
((dir, "Direct messages: on"), Nothing, Nothing),
((dir, "Full deletion: off"), Nothing, Nothing),
((dir, "Full deletion: on for moderators"), Nothing, Nothing),
((dir, "Message reactions: on"), Nothing, Nothing),
((dir, "Voice messages: on"), Nothing, Nothing),
((dir, "Files and media: on"), Nothing, Nothing),
@ -632,6 +632,16 @@ createGroup2' gName cc1 cc2 doConnectUsers = do
(cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group"))
(cc2 <## ("#" <> gName <> ": you joined the group"))
disableFullDeletion2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
disableFullDeletion2 gName cc1 cc2 = do
cc1 ##> ("/set delete #" <> gName <> " off")
cc1 <## "updated group preferences:"
cc1 <## "Full deletion: off"
name1 <- userName cc1
cc2 <## (name1 <> " updated group #" <> gName <> ":")
cc2 <## "updated group preferences:"
cc2 <## "Full deletion: off"
createGroup3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
createGroup3 gName cc1 cc2 cc3 = do
createGroup2 gName cc1 cc2
@ -652,6 +662,14 @@ createGroup3 gName cc1 cc2 cc3 = do
cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
]
disableFullDeletion3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
disableFullDeletion3 gName cc1 cc2 cc3 = do
disableFullDeletion2 gName cc1 cc2
name1 <- userName cc1
cc3 <## (name1 <> " updated group #" <> gName <> ":")
cc3 <## "updated group preferences:"
cc3 <## "Full deletion: off"
create2Groups3 :: HasCallStack => String -> String -> TestCC -> TestCC -> TestCC -> IO ()
create2Groups3 gName1 gName2 cc1 cc2 cc3 = do
createGroup3 gName1 cc1 cc2 cc3