core: batch apis - remove, block, change role of members (#5674)

* core: core: batch remove members

* order

* foldr

* list

* style

* batch block

* change role

* test

* if
This commit is contained in:
spaced4ndy 2025-02-28 22:43:39 +04:00 committed by GitHub
parent dce8502165
commit dcea008fb9
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
10 changed files with 320 additions and 162 deletions

View file

@ -366,9 +366,9 @@ data ChatCommand
| ApiGetConnNtfMessages {connIds :: NonEmpty AgentConnId}
| APIAddMember GroupId ContactId GroupMemberRole
| APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter}
| APIMemberRole GroupId GroupMemberId GroupMemberRole
| APIBlockMemberForAll GroupId GroupMemberId Bool
| APIRemoveMember GroupId GroupMemberId
| APIMembersRole GroupId (NonEmpty GroupMemberId) GroupMemberRole
| APIBlockMembersForAll GroupId (NonEmpty GroupMemberId) Bool
| APIRemoveMembers GroupId (NonEmpty GroupMemberId)
| APILeaveGroup GroupId
| APIListMembers GroupId
| APIUpdateGroupProfile GroupId GroupProfile
@ -673,7 +673,7 @@ data ChatResponse
| CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
| CRGroupLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRBusinessLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, fromContact :: Contact}
| CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember]}
| CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
| CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
@ -758,9 +758,9 @@ data ChatResponse
| CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
| CRMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CRMemberRoleUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CRMembersRoleUser {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], toRole :: GroupMemberRole}
| CRMemberBlockedForAll {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, blocked :: Bool}
| CRMemberBlockedForAllUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, blocked :: Bool}
| CRMembersBlockedForAllUser {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], blocked :: Bool}
| CRConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact}
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}

View file

@ -2023,75 +2023,170 @@ processChatCommand' vr = \case
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user))
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
Nothing -> throwChatError $ CEContactNotActive ct
APIMemberRole groupId memberId memRole -> withUser $ \user -> do
Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
if memberId == groupMemberId' membership
then changeMemberRole user gInfo members membership $ SGEUserRole memRole
else case find ((== memberId) . groupMemberId') members of
Just m -> changeMemberRole user gInfo members m $ SGEMemberRole memberId (fromLocalProfile $ memberProfile m) memRole
_ -> throwChatError CEGroupMemberNotFound
APIMembersRole groupId memberIds newRole -> withUser $ \user ->
withGroupLock "memberRole" groupId . procCmd $ do
g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
when (selfSelected gInfo) $ throwChatError $ CECommandError "can't change role for self"
let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin) = selectMembers members
when (length invitedMems + length currentMems + length unchangedMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
when (length memberIds > 1 && (anyAdmin || newRole >= GRAdmin)) $
throwChatError $ CECommandError "can't change role of multiple members when admins selected, or new role is admin"
assertUserGroupRole gInfo $ maximum ([GRAdmin, maxRole, newRole] :: [GroupMemberRole])
(errs1, changed1) <- changeRoleInvitedMems user gInfo invitedMems
(errs2, changed2, acis) <- changeRoleCurrentMems user g currentMems
unless (null acis) $ toView $ CRNewChatItems user acis
let errs = errs1 <> errs2
unless (null errs) $ toView $ CRChatErrors (Just user) errs
pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole} -- same order is not guaranteed
where
changeMemberRole user gInfo members m gEvent = do
let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m
assertUserGroupRole gInfo $ maximum ([GRAdmin, mRole, memRole] :: [GroupMemberRole])
withGroupLock "memberRole" groupId . procCmd $ do
unless (mRole == memRole) $ do
withFastStore' $ \db -> updateGroupMemberRole db user m memRole
case mStatus of
GSMemInvited -> do
withFastStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case
(Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
_ -> do
msg <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent)
toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
APIBlockMemberForAll groupId memberId blocked -> withUser $ \user -> do
Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
when (memberId == groupMemberId' membership) $ throwChatError $ CECommandError "can't block/unblock self"
case splitMember memberId members of
Nothing -> throwChatError $ CEException "expected to find a single blocked member"
Just (bm, remainingMembers) -> do
let GroupMember {memberId = bmMemberId, memberRole = bmRole, memberProfile = bmp} = bm
-- TODO GRModerator when most users migrate
assertUserGroupRole gInfo $ max GRAdmin bmRole
when (blocked == blockedByAdmin bm) $ throwChatError $ CECommandError $ if blocked then "already blocked" else "already unblocked"
withGroupLock "blockForAll" groupId . procCmd $ do
let mrs = if blocked then MRSBlocked else MRSUnrestricted
event = XGrpMemRestrict bmMemberId MemberRestrictions {restriction = mrs}
msg <- sendGroupMessage' user gInfo remainingMembers event
let ciContent = CISndGroupEvent $ SGEMemberBlocked memberId (fromLocalProfile bmp) blocked
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent
toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
bm' <- withFastStore $ \db -> do
liftIO $ updateGroupMemberBlocked db user groupId memberId mrs
getGroupMember db vr user groupId memberId
toggleNtf user bm' (not blocked)
pure CRMemberBlockedForAllUser {user, groupInfo = gInfo, member = bm', blocked}
selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
selectMembers = foldr' addMember ([], [], [], GRObserver, False)
where
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin)
| groupMemberId `elem` memberIds =
let maxRole' = max maxRole memberRole
anyAdmin' = anyAdmin || memberRole >= GRAdmin
in
if
| memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin')
| memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin')
| otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin')
| otherwise = (invited, current, unchanged, maxRole, anyAdmin)
changeRoleInvitedMems :: User -> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
changeRoleInvitedMems user gInfo memsToChange = do
-- not batched, as we need to send different invitations to different connections anyway
mems_ <- forM memsToChange $ \m -> (Right <$> changeRole m) `catchChatError` (pure . Left)
pure $ partitionEithers mems_
where
changeRole :: GroupMember -> CM GroupMember
changeRole m@GroupMember {groupMemberId, memberContactId, localDisplayName = cName} = do
withFastStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user groupMemberId)) >>= \case
(Just ct, Just cReq) -> do
sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = newRole} cReq
withFastStore' $ \db -> updateGroupMemberRole db user m newRole
pure (m :: GroupMember) {memberRole = newRole}
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
changeRoleCurrentMems :: User -> Group -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
changeRoleCurrentMems user (Group gInfo members) memsToChange = case L.nonEmpty memsToChange of
Nothing -> pure ([], [], [])
Just memsToChange' -> do
let events = L.map (\GroupMember {memberId} -> XGrpMemRole memberId newRole) memsToChange'
(msgs_, _gsr) <- sendGroupMessages user gInfo members events
let itemsData = zipWith (fmap . sndItemData) memsToChange (L.toList msgs_)
cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False
when (length cis_ /= length memsToChange) $ logError "changeRoleCurrentMems: memsToChange and cis_ length mismatch"
(errs, changed) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updMember db) memsToChange)
let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_
pure (errs, changed, acis)
where
sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
sndItemData GroupMember {groupMemberId, memberProfile} msg =
let content = CISndGroupEvent $ SGEMemberRole groupMemberId (fromLocalProfile memberProfile) newRole
ts = ciContentTexts content
in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
updMember db m = do
updateGroupMemberRole db user m newRole
pure (m :: GroupMember) {memberRole = newRole}
APIBlockMembersForAll groupId memberIds blockFlag -> withUser $ \user ->
withGroupLock "blockForAll" groupId . procCmd $ do
Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
when (selfSelected gInfo) $ throwChatError $ CECommandError "can't block/unblock self"
let (blockMems, remainingMems, maxRole, anyAdmin) = selectMembers members
when (length blockMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
when (length memberIds > 1 && anyAdmin) $ throwChatError $ CECommandError "can't block/unblock multiple members when admins selected"
assertUserGroupRole gInfo $ max GRModerator maxRole
blockMembers user gInfo blockMems remainingMems
where
splitMember mId ms = case break ((== mId) . groupMemberId') ms of
(_, []) -> Nothing
(ms1, bm : ms2) -> Just (bm, ms1 <> ms2)
APIRemoveMember groupId memberId -> withUser $ \user -> do
Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
case find ((== memberId) . groupMemberId') members of
Nothing -> throwChatError CEGroupMemberNotFound
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberProfile} -> do
assertUserGroupRole gInfo $ max GRAdmin mRole
withGroupLock "removeMember" groupId . procCmd $ do
case mStatus of
GSMemInvited -> do
deleteMemberConnection user m
withFastStore' $ \db -> deleteGroupMember db user m
_ -> do
msg <- sendGroupMessage user gInfo members $ XGrpMemDel mId
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
deleteMemberConnection' user m True
-- undeleted "member connected" chat item will prevent deletion of member record
deleteOrUpdateMemberRecord user m
pure $ CRUserDeletedMember user gInfo m {memberStatus = GSMemRemoved}
selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool)
selectMembers = foldr' addMember ([], [], GRObserver, False)
where
addMember m@GroupMember {groupMemberId, memberRole} (block, remaining, maxRole, anyAdmin)
| groupMemberId `elem` memberIds =
let maxRole' = max maxRole memberRole
anyAdmin' = anyAdmin || memberRole >= GRAdmin
in (m : block, remaining, maxRole', anyAdmin')
| otherwise = (block, m : remaining, maxRole, anyAdmin)
blockMembers :: User -> GroupInfo -> [GroupMember] -> [GroupMember] -> CM ChatResponse
blockMembers user gInfo blockMems remainingMems = case L.nonEmpty blockMems of
Nothing -> throwChatError $ CECommandError "no members to block/unblock"
Just blockMems' -> do
let mrs = if blockFlag then MRSBlocked else MRSUnrestricted
events = L.map (\GroupMember {memberId} -> XGrpMemRestrict memberId MemberRestrictions {restriction = mrs}) blockMems'
(msgs_, _gsr) <- sendGroupMessages user gInfo remainingMems events
let itemsData = zipWith (fmap . sndItemData) blockMems (L.toList msgs_)
cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False
when (length cis_ /= length blockMems) $ logError "blockMembers: blockMems and cis_ length mismatch"
let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_
unless (null acis) $ toView $ CRNewChatItems user acis
(errs, blocked) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updateGroupMemberBlocked db user gInfo mrs) blockMems)
unless (null errs) $ toView $ CRChatErrors (Just user) errs
-- TODO not batched - requires agent batch api
forM_ blocked $ \m -> toggleNtf user m (not blockFlag)
pure CRMembersBlockedForAllUser {user, groupInfo = gInfo, members = blocked, blocked = blockFlag}
where
sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
sndItemData GroupMember {groupMemberId, memberProfile} msg =
let content = CISndGroupEvent $ SGEMemberBlocked groupMemberId (fromLocalProfile memberProfile) blockFlag
ts = ciContentTexts content
in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
APIRemoveMembers groupId memberIds -> withUser $ \user ->
withGroupLock "removeMembers" groupId . procCmd $ do
g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
let (invitedMems, currentMems, maxRole, anyAdmin) = selectMembers members
when (length invitedMems + length currentMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
when (length memberIds > 1 && anyAdmin) $ throwChatError $ CECommandError "can't remove multiple members when admins selected"
assertUserGroupRole gInfo $ max GRAdmin maxRole
(errs1, deleted1) <- deleteInvitedMems user invitedMems
(errs2, deleted2, acis) <- deleteCurrentMems user g currentMems
unless (null acis) $ toView $ CRNewChatItems user acis
let errs = errs1 <> errs2
unless (null errs) $ toView $ CRChatErrors (Just user) errs
pure $ CRUserDeletedMembers user gInfo (deleted1 <> deleted2) -- same order is not guaranteed
where
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool)
selectMembers = foldr' addMember ([], [], GRObserver, False)
where
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, maxRole, anyAdmin)
| groupMemberId `elem` memberIds =
let maxRole' = max maxRole memberRole
anyAdmin' = anyAdmin || memberRole >= GRAdmin
in
if memberStatus == GSMemInvited
then (m : invited, current, maxRole', anyAdmin')
else (invited, m : current, maxRole', anyAdmin')
| otherwise = (invited, current, maxRole, anyAdmin)
deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
deleteInvitedMems user memsToDelete = do
deleteMembersConnections user memsToDelete
lift $ partitionEithers <$> withStoreBatch' (\db -> map (delMember db) memsToDelete)
where
delMember db m = do
deleteGroupMember db user m
pure m {memberStatus = GSMemRemoved}
deleteCurrentMems :: User -> Group -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
deleteCurrentMems user (Group gInfo members) memsToDelete = case L.nonEmpty memsToDelete of
Nothing -> pure ([], [], [])
Just memsToDelete' -> do
let events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId) memsToDelete'
(msgs_, _gsr) <- sendGroupMessages user gInfo members events
let itemsData = zipWith (fmap . sndItemData) memsToDelete (L.toList msgs_)
cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False
when (length cis_ /= length memsToDelete) $ logError "deleteCurrentMems: memsToDelete and cis_ length mismatch"
deleteMembersConnections' user memsToDelete True
(errs, deleted) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (delMember db) memsToDelete)
let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_
pure (errs, deleted, acis)
where
sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
sndItemData GroupMember {groupMemberId, memberProfile} msg =
let content = CISndGroupEvent $ SGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)
ts = ciContentTexts content
in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
delMember db m = do
deleteOrUpdateMemberRecordIO db user m
pure m {memberStatus = GSMemRemoved}
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo
@ -2114,18 +2209,14 @@ processChatCommand' vr = \case
JoinGroup gName enableNtfs -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APIJoinGroup groupId enableNtfs
MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMemberRole gId gMemberId memRole
BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMemberForAll gId gMemberId blocked
MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMembersRole gId [gMemberId] memRole
BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMembersForAll gId [gMemberId] blocked
RemoveMembers gName gMemberNames -> withUser $ \user -> do
(gId, gMemberIds) <- withStore $ \db -> do
gId <- getGroupIdByName db user gName
gMemberIds <- forM gMemberNames $ getGroupMemberIdByName db user gId
pure (gId, gMemberIds)
rs <- forM (L.zip (L.fromList [1..]) gMemberIds) $ \(i, memId) -> do
r <- processChatCommand (APIRemoveMember gId memId)
when (i < length gMemberIds) $ toView r
pure r
pure $ L.last rs
processChatCommand $ APIRemoveMembers gId gMemberIds
LeaveGroup gName -> withUser $ \user -> do
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APILeaveGroup groupId
@ -3090,7 +3181,7 @@ processChatCommand' vr = \case
(msgs_, gsr) <- sendGroupMessages user gInfo ms chatMsgEvents
let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) (L.toList msgs_)
cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live
when (length itemsData /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch"
when (length cis_ /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch"
createMemberSndStatuses cis_ msgs_ gsr
let r@(_, cis) = partitionEithers cis_
processSendErrs user r
@ -3795,9 +3886,9 @@ chatCommandP =
"/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP),
"/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI
"/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP),
"/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal),
"/_member role #" *> (APIMembersRole <$> A.decimal <*> _strP <*> memberRole),
"/_block #" *> (APIBlockMembersForAll <$> A.decimal <*> _strP <* A.space <* "blocked=" <*> onOffP),
"/_remove #" *> (APIRemoveMembers <$> A.decimal <*> _strP),
"/_leave #" *> (APILeaveGroup <$> A.decimal),
"/_members #" *> (APIListMembers <$> A.decimal),
"/_server test " *> (APITestProtoServer <$> A.decimal <* A.space <*> strP),

View file

@ -1251,11 +1251,14 @@ deleteMemberConnection' user GroupMember {activeConn} waitDelivery = do
withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
deleteOrUpdateMemberRecord :: User -> GroupMember -> CM ()
deleteOrUpdateMemberRecord user@User {userId} member =
withStore' $ \db ->
checkGroupMemberHasItems db user member >>= \case
Just _ -> updateGroupMemberStatus db userId member GSMemRemoved
Nothing -> deleteGroupMember db user member
deleteOrUpdateMemberRecord user member =
withStore' $ \db -> deleteOrUpdateMemberRecordIO db user member
deleteOrUpdateMemberRecordIO :: DB.Connection -> User -> GroupMember -> IO ()
deleteOrUpdateMemberRecordIO db user@User {userId} member =
checkGroupMemberHasItems db user member >>= \case
Just _ -> updateGroupMemberStatus db userId member GSMemRemoved
Nothing -> deleteGroupMember db user member
sendDirectContactMessages :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage]
sendDirectContactMessages user ct events = do

View file

@ -2608,7 +2608,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpMemRestrict :: GroupInfo -> GroupMember -> MemberId -> MemberRestrictions -> RcvMessage -> UTCTime -> CM ()
xGrpMemRestrict
gInfo@GroupInfo {groupId, membership = GroupMember {memberId = membershipMemId}}
gInfo@GroupInfo {membership = GroupMember {memberId = membershipMemId}}
m@GroupMember {memberRole = senderRole}
memId
MemberRestrictions {restriction}
@ -2619,10 +2619,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
messageError "x.grp.mem.restrict: admin blocks you"
| otherwise =
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
Right bm@GroupMember {groupMemberId = bmId, memberRole, memberProfile = bmp}
Right bm@GroupMember {groupMemberId = bmId, memberRole, blockedByAdmin, memberProfile = bmp}
| blockedByAdmin == mrsBlocked restriction -> pure ()
| senderRole < GRModerator || senderRole < memberRole -> messageError "x.grp.mem.restrict with insufficient member permissions"
| otherwise -> do
bm' <- setMemberBlocked bmId
bm' <- setMemberBlocked bm
toggleNtf user bm' (not blocked)
let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs ciContent
@ -2630,14 +2631,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView CRMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked}
Left (SEGroupMemberNotFoundByMemberId _) -> do
bm <- createUnknownMember gInfo memId
bm' <- setMemberBlocked $ groupMemberId' bm
bm' <- setMemberBlocked bm
toView $ CRUnknownMemberBlocked user gInfo m bm'
Left e -> throwError $ ChatErrorStore e
where
setMemberBlocked bmId =
withStore $ \db -> do
liftIO $ updateGroupMemberBlocked db user groupId bmId restriction
getGroupMember db vr user groupId bmId
setMemberBlocked bm = withStore' $ \db -> updateGroupMemberBlocked db user gInfo restriction bm
blocked = mrsBlocked restriction
xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> CM ()

View file

@ -33,9 +33,9 @@ data RcvGroupEvent
data SndGroupEvent
= SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
| SGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMemberBlockedForAllUser
| SGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMembersBlockedForAllUser
| SGEUserRole {role :: GroupMemberRole}
| SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
| SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMembers
| SGEUserLeft -- CRLeftMemberUser
| SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
deriving (Show)

View file

@ -2062,8 +2062,8 @@ updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {sh
|]
(BI showMessages, currentTs, userId, gId, gMemberId)
updateGroupMemberBlocked :: DB.Connection -> User -> GroupId -> GroupMemberId -> MemberRestrictionStatus -> IO ()
updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
updateGroupMemberBlocked :: DB.Connection -> User -> GroupInfo -> MemberRestrictionStatus -> GroupMember -> IO GroupMember
updateGroupMemberBlocked db User {userId} GroupInfo {groupId} mrs m@GroupMember {groupMemberId} = do
currentTs <- getCurrentTime
DB.execute
db
@ -2072,7 +2072,8 @@ updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
SET member_restriction = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|]
(memberBlocked, currentTs, userId, gId, gMemberId)
(mrs, currentTs, userId, groupId, groupMemberId)
pure m {blockedByAdmin = mrsBlocked mrs}
getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont))
getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do

View file

@ -220,7 +220,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
CRGroupLinkConnecting u g _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
CRBusinessLinkConnecting u g _ _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
CRUserDeletedMembers u g members -> case members of
[m] -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
mems' -> ttyUser u [ttyGroup' g <> ": you removed " <> sShow (length mems') <> " members from the group"]
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
CRUnknownMemberCreated u g fwdM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember fwdM <> " forwarded a message from an unknown member, creating unknown member record " <> ttyMember um]
CRUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um]
@ -301,9 +303,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRJoinedGroupMemberConnecting u g host m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
CRConnectedToGroupMember u g m _ -> ttyUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
CRMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
CRMemberRoleUser u g m r r' -> ttyUser u $ viewMemberRoleUserChanged g m r r'
CRMembersRoleUser u g members r' -> ttyUser u $ viewMemberRoleUserChanged g members r'
CRMemberBlockedForAll u g by m blocked -> ttyUser u $ viewMemberBlockedForAll g by m blocked
CRMemberBlockedForAllUser u g m blocked -> ttyUser u $ viewMemberBlockedForAllUser g m blocked
CRMembersBlockedForAllUser u g members blocked -> ttyUser u $ viewMembersBlockedForAllUser g members blocked
CRDeletedMemberUser u g by -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
CRDeletedMember u g by m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
@ -1109,21 +1111,19 @@ viewMemberRoleChanged g@GroupInfo {membership} by m r r'
memId = groupMemberId' m
view s = [ttyGroup' g <> ": " <> ttyMember by <> " changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
viewMemberRoleUserChanged :: GroupInfo -> GroupMember -> GroupMemberRole -> GroupMemberRole -> [StyledString]
viewMemberRoleUserChanged g@GroupInfo {membership} m r r'
| r == r' = [ttyGroup' g <> ": member role did not change"]
| groupMemberId' membership == groupMemberId' m = view "your role"
| otherwise = view $ "the role of " <> ttyMember m
where
view s = [ttyGroup' g <> ": you changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
viewMemberRoleUserChanged :: GroupInfo -> [GroupMember] -> GroupMemberRole -> [StyledString]
viewMemberRoleUserChanged g members r = case members of
[m] -> [ttyGroup' g <> ": you changed the role of " <> ttyMember m <> " to " <> showRole r]
mems' -> [ttyGroup' g <> ": you changed the role of " <> sShow (length mems') <> " members to " <> showRole r]
viewMemberBlockedForAll :: GroupInfo -> GroupMember -> GroupMember -> Bool -> [StyledString]
viewMemberBlockedForAll g by m blocked =
[ttyGroup' g <> ": " <> ttyMember by <> " " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
viewMemberBlockedForAllUser :: GroupInfo -> GroupMember -> Bool -> [StyledString]
viewMemberBlockedForAllUser g m blocked =
[ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
viewMembersBlockedForAllUser :: GroupInfo -> [GroupMember] -> Bool -> [StyledString]
viewMembersBlockedForAllUser g members blocked = case members of
[m] -> [ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
mems' -> [ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> sShow (length mems') <> " members"]
showRole :: GroupMemberRole -> StyledString
showRole = plain . strEncode

View file

@ -122,7 +122,7 @@ testDirectoryService ps =
bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
bob ##> "/mr PSA SimpleX-Directory admin"
-- putStrLn "*** discover service joins group and creates the link for profile"
bob <## "#PSA: you changed the role of SimpleX-Directory from member to admin"
bob <## "#PSA: you changed the role of SimpleX-Directory to admin"
bob <# "SimpleX-Directory> Joining the group PSA…"
bob <## "#PSA: SimpleX-Directory joined the group"
bob <# "SimpleX-Directory> Joined the group PSA, creating the link…"
@ -579,7 +579,7 @@ testDelistedRoleChanges ps =
groupFoundN 3 cath "privacy"
-- de-listed if service role changed
bob ##> "/mr privacy SimpleX-Directory member"
bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
bob <## "#privacy: you changed the role of SimpleX-Directory to member"
cath <## "#privacy: bob changed the role of SimpleX-Directory from admin to member"
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to member."
bob <## ""
@ -588,7 +588,7 @@ testDelistedRoleChanges ps =
groupNotFound cath "privacy"
-- re-listed if service role changed back without profile changes
cath ##> "/mr privacy SimpleX-Directory admin"
cath <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
cath <## "#privacy: you changed the role of SimpleX-Directory to admin"
bob <## "#privacy: cath changed the role of SimpleX-Directory from member to admin"
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
bob <## ""
@ -597,7 +597,7 @@ testDelistedRoleChanges ps =
groupFoundN 3 cath "privacy"
-- de-listed if owner role changed
cath ##> "/mr privacy bob admin"
cath <## "#privacy: you changed the role of bob from owner to admin"
cath <## "#privacy: you changed the role of bob to admin"
bob <## "#privacy: cath changed your role from owner to admin"
bob <# "SimpleX-Directory> Your role in the group ID 1 (privacy) is changed to admin."
bob <## ""
@ -606,7 +606,7 @@ testDelistedRoleChanges ps =
groupNotFound cath "privacy"
-- re-listed if owner role changed back without profile changes
cath ##> "/mr privacy bob owner"
cath <## "#privacy: you changed the role of bob from admin to owner"
cath <## "#privacy: you changed the role of bob to owner"
bob <## "#privacy: cath changed your role from admin to owner"
bob <# "SimpleX-Directory> Your role in the group ID 1 (privacy) is changed to owner."
bob <## ""
@ -627,7 +627,7 @@ testNotDelistedMemberRoleChanged ps =
cath <## "use @SimpleX-Directory <message> to send messages"
groupFoundN 3 cath "privacy"
bob ##> "/mr privacy cath member"
bob <## "#privacy: you changed the role of cath from owner to member"
bob <## "#privacy: you changed the role of cath to member"
cath <## "#privacy: bob changed your role from owner to member"
groupFoundN 3 cath "privacy"
@ -641,11 +641,11 @@ testNotSentApprovalBadRoles ps =
submitGroup bob "privacy" "Privacy"
welcomeWithLink <- groupAccepted bob "privacy"
bob ##> "/mr privacy SimpleX-Directory member"
bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
bob <## "#privacy: you changed the role of SimpleX-Directory to member"
updateProfileWithLink bob "privacy" welcomeWithLink 1
bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
bob ##> "/mr privacy SimpleX-Directory admin"
bob <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
bob <## "#privacy: you changed the role of SimpleX-Directory to admin"
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
bob <## ""
bob <## "The group is submitted for approval."
@ -666,14 +666,14 @@ testNotApprovedBadRoles ps =
updateProfileWithLink bob "privacy" welcomeWithLink 1
notifySuperUser superUser bob "privacy" "Privacy" welcomeWithLink 1
bob ##> "/mr privacy SimpleX-Directory member"
bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
bob <## "#privacy: you changed the role of SimpleX-Directory to member"
let approve = "/approve 1:privacy 1"
superUser #> ("@SimpleX-Directory " <> approve)
superUser <# ("SimpleX-Directory> > " <> approve)
superUser <## " Group is not approved: SimpleX-Directory is not an admin."
groupNotFound cath "privacy"
bob ##> "/mr privacy SimpleX-Directory admin"
bob <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
bob <## "#privacy: you changed the role of SimpleX-Directory to admin"
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
bob <## ""
bob <## "The group is submitted for approval."
@ -940,7 +940,7 @@ testListUserGroups ps =
-- with de-listed group
groupFound cath "anonymity"
cath ##> "/mr anonymity SimpleX-Directory member"
cath <## "#anonymity: you changed the role of SimpleX-Directory from admin to member"
cath <## "#anonymity: you changed the role of SimpleX-Directory to member"
cath <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (anonymity) is changed to member."
cath <## ""
cath <## "The group is no longer listed in the directory."

View file

@ -173,7 +173,8 @@ chatGroupTests = do
it "messages are fully deleted" testBlockForAllFullDelete
it "another admin can unblock" testBlockForAllAnotherAdminUnblocks
it "member was blocked before joining group" testBlockForAllBeforeJoining
it "can't repeat block, unblock" testBlockForAllCantRepeat
it "repeat block, unblock" testBlockForAllRepeat
it "block multiple members" testBlockForAllMultipleMembers
describe "group member inactivity" $ do
it "mark member inactive on reaching quota" testGroupMemberInactive
describe "group member reports" $ do
@ -265,7 +266,7 @@ testGroupShared alice bob cath checkMessages = do
-- test observer role
alice ##> "/mr team bob observer"
concurrentlyN_
[ alice <## "#team: you changed the role of bob from admin to observer",
[ alice <## "#team: you changed the role of bob to observer",
bob <## "#team: alice changed your role from admin to observer",
cath <## "#team: alice changed the role of bob from admin to observer"
]
@ -280,7 +281,7 @@ testGroupShared alice bob cath checkMessages = do
]
alice ##> "/mr team bob admin"
concurrentlyN_
[ alice <## "#team: you changed the role of bob from observer to admin",
[ alice <## "#team: you changed the role of bob to admin",
bob <## "#team: alice changed your role from observer to admin",
cath <## "#team: alice changed the role of bob from observer to admin"
]
@ -1460,7 +1461,7 @@ testUpdateMemberRole =
alice <## "to add members use /a team <name> or /create link #team"
addMember "team" alice bob GRAdmin
alice ##> "/mr team bob member"
alice <## "#team: you changed the role of bob from admin to member"
alice <## "#team: you changed the role of bob to member"
bob <## "#team: alice invites you to join the group as member"
bob <## "use /j team to accept"
bob ##> "/j team"
@ -1472,7 +1473,7 @@ testUpdateMemberRole =
bob <## "#team: you have insufficient permissions for this action, the required role is admin"
alice ##> "/mr team bob admin"
concurrently_
(alice <## "#team: you changed the role of bob from member to admin")
(alice <## "#team: you changed the role of bob to admin")
(bob <## "#team: alice changed your role from member to admin")
bob ##> "/a team cath owner"
bob <## "#team: you have insufficient permissions for this action, the required role is owner"
@ -1488,13 +1489,7 @@ testUpdateMemberRole =
alice <## "#team: new member cath is connected"
]
alice ##> "/mr team alice admin"
concurrentlyN_
[ alice <## "#team: you changed your role from owner to admin",
bob <## "#team: alice changed the role from owner to admin",
cath <## "#team: alice changed the role from owner to admin"
]
alice ##> "/d #team"
alice <## "#team: you have insufficient permissions for this action, the required role is owner"
alice <## "bad chat command: can't change role for self"
testGroupDescription :: HasCallStack => TestParams -> IO ()
testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do
@ -1579,7 +1574,7 @@ testGroupModerate =
-- disableFullDeletion3 "team" alice bob cath
alice ##> "/mr team cath member"
concurrentlyN_
[ alice <## "#team: you changed the role of cath from admin to member",
[ alice <## "#team: you changed the role of cath to member",
bob <## "#team: alice changed the role of cath from admin to member",
cath <## "#team: alice changed your role from admin to member"
]
@ -1662,7 +1657,7 @@ testGroupModerateFullDelete =
-- disableFullDeletion3 "team" alice bob cath
alice ##> "/mr team cath member"
concurrentlyN_
[ alice <## "#team: you changed the role of cath from admin to member",
[ alice <## "#team: you changed the role of cath to member",
bob <## "#team: alice changed the role of cath from admin to member",
cath <## "#team: alice changed your role from admin to member"
]
@ -2691,7 +2686,7 @@ testGroupLinkMemberRole =
bob <## "#team: you don't have permission to send messages"
alice ##> "/mr #team bob member"
alice <## "#team: you changed the role of bob from observer to member"
alice <## "#team: you changed the role of bob to member"
bob <## "#team: alice changed your role from observer to member"
bob #> "#team hey now"
@ -2721,7 +2716,7 @@ testGroupLinkMemberRole =
cath <## "#team: you don't have permission to send messages"
alice ##> "/mr #team cath admin"
alice <## "#team: you changed the role of cath from observer to admin"
alice <## "#team: you changed the role of cath to admin"
cath <## "#team: alice changed your role from observer to admin"
bob <## "#team: alice changed the role of cath from observer to admin"
@ -2730,7 +2725,7 @@ testGroupLinkMemberRole =
bob <# "#team cath> hey"
cath ##> "/mr #team bob admin"
cath <## "#team: you changed the role of bob from member to admin"
cath <## "#team: you changed the role of bob to admin"
bob <## "#team: cath changed your role from member to admin"
alice <## "#team: cath changed the role of bob from member to admin"
@ -4132,14 +4127,14 @@ testGroupMsgForwardReport =
alice ##> "/mr team bob moderator"
concurrentlyN_
[ alice <## "#team: you changed the role of bob from admin to moderator",
[ alice <## "#team: you changed the role of bob to moderator",
bob <## "#team: alice changed your role from admin to moderator",
cath <## "#team: alice changed the role of bob from admin to moderator"
]
alice ##> "/mr team cath member"
concurrentlyN_
[ alice <## "#team: you changed the role of cath from admin to member",
[ alice <## "#team: you changed the role of cath to member",
bob <## "#team: alice changed the role of cath from admin to member",
cath <## "#team: alice changed your role from admin to member"
]
@ -4157,7 +4152,7 @@ testGroupMsgForwardReport =
alice ##> "/mr team bob member"
concurrentlyN_
[ alice <## "#team: you changed the role of bob from moderator to member",
[ alice <## "#team: you changed the role of bob to member",
bob <## "#team: alice changed your role from moderator to member",
cath <## "#team: alice changed the role of bob from moderator to member"
]
@ -4315,7 +4310,7 @@ testGroupMsgForwardChangeRole =
setupGroupForwarding3 "team" alice bob cath
cath ##> "/mr #team bob member"
cath <## "#team: you changed the role of bob from admin to member"
cath <## "#team: you changed the role of bob to member"
alice <## "#team: cath changed the role of bob from admin to member"
bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded
@ -5942,19 +5937,13 @@ testBlockForAllBeforeJoining =
cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
cc <## "#team: new member dan is connected"
testBlockForAllCantRepeat :: HasCallStack => TestParams -> IO ()
testBlockForAllCantRepeat =
testBlockForAllRepeat :: HasCallStack => TestParams -> IO ()
testBlockForAllRepeat =
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"
cath ##> "/unblock for all #team bob"
cath <## "bad chat command: already unblocked"
bob #> "#team 1"
[alice, cath] *<# "#team bob> 1"
@ -5964,10 +5953,10 @@ testBlockForAllCantRepeat =
bob <// 50000
alice ##> "/block for all #team bob"
alice <## "bad chat command: already blocked"
alice <## "#team: you blocked bob"
cath ##> "/block for all #team bob"
cath <## "bad chat command: already blocked"
cath <## "#team: you blocked bob"
bob #> "#team 2"
alice <# "#team bob> 2 [blocked by admin] <muted>"
@ -5979,16 +5968,92 @@ testBlockForAllCantRepeat =
bob <// 50000
alice ##> "/unblock for all #team bob"
alice <## "bad chat command: already unblocked"
alice <## "#team: you unblocked bob"
cath ##> "/unblock for all #team bob"
cath <## "bad chat command: already unblocked"
cath <## "#team: you unblocked bob"
bob #> "#team 3"
[alice, cath] *<# "#team bob> 3"
bob #$> ("/_get chat #1 count=3", chat, [(1, "1"), (1, "2"), (1, "3")])
testBlockForAllMultipleMembers :: HasCallStack => TestParams -> IO ()
testBlockForAllMultipleMembers =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
createGroup3 "team" alice bob cath
connectUsers alice dan
addMember "team" alice dan GRMember
dan ##> "/j team"
concurrentlyN_
[ alice <## "#team: dan joined the group",
do
dan <## "#team: you joined the group"
dan
<### [ "#team: member bob (Bob) is connected",
"#team: member cath (Catherine) is connected"
],
do
bob <## "#team: alice added dan (Daniel) to the group (connecting...)"
bob <## "#team: new member dan is connected",
do
cath <## "#team: alice added dan (Daniel) to the group (connecting...)"
cath <## "#team: new member dan is connected"
]
-- lower roles to for batch block to be allowed (can't batch block if admins are selected)
alice ##> "/mr team bob member"
concurrentlyN_
[ alice <## "#team: you changed the role of bob to member",
bob <## "#team: alice changed your role from admin to member",
cath <## "#team: alice changed the role of bob from admin to member",
dan <## "#team: alice changed the role of bob from admin to member"
]
alice ##> "/mr team cath member"
concurrentlyN_
[ alice <## "#team: you changed the role of cath to member",
bob <## "#team: alice changed the role of cath from admin to member",
cath <## "#team: alice changed your role from admin to member",
dan <## "#team: alice changed the role of cath from admin to member"
]
bob #> "#team 1"
[alice, cath, dan] *<# "#team bob> 1"
cath #> "#team 2"
[alice, bob, dan] *<# "#team cath> 2"
alice ##> "/_block #1 2,3 blocked=on"
alice <## "#team: you blocked 2 members"
dan <## "#team: alice blocked bob"
dan <## "#team: alice blocked cath"
bob <// 50000
cath <// 50000
-- bob and cath don't know they are blocked and receive each other's messages
bob #> "#team 3"
[alice, dan] *<# "#team bob> 3 [blocked by admin] <muted>"
cath <# "#team bob> 3"
cath #> "#team 4"
[alice, dan] *<# "#team cath> 4 [blocked by admin] <muted>"
bob <# "#team cath> 4"
alice ##> "/_block #1 2,3 blocked=off"
alice <## "#team: you unblocked 2 members"
dan <## "#team: alice unblocked bob"
dan <## "#team: alice unblocked cath"
bob <// 50000
cath <// 50000
bob #> "#team 5"
[alice, cath, dan] *<# "#team bob> 5"
cath #> "#team 6"
[alice, bob, dan] *<# "#team cath> 6"
testGroupMemberInactive :: HasCallStack => TestParams -> IO ()
testGroupMemberInactive ps = do
withSmpServer' serverCfg' $ do
@ -6067,13 +6132,13 @@ testGroupMemberReports =
-- disableFullDeletion3 "jokes" alice bob cath
alice ##> "/mr jokes bob moderator"
concurrentlyN_
[ alice <## "#jokes: you changed the role of bob from admin to moderator",
[ alice <## "#jokes: you changed the role of bob to moderator",
bob <## "#jokes: alice changed your role from admin to moderator",
cath <## "#jokes: alice changed the role of bob from admin to moderator"
]
alice ##> "/mr jokes cath member"
concurrentlyN_
[ alice <## "#jokes: you changed the role of cath from admin to member",
[ alice <## "#jokes: you changed the role of cath to member",
bob <## "#jokes: alice changed the role of cath from admin to member",
cath <## "#jokes: alice changed your role from admin to member"
]

View file

@ -773,7 +773,7 @@ testBusinessUpdateProfiles = withTestOutput $ testChat4 businessProfile alicePro
biz <# "#alisa alisa_1> hello again"
-- customer can invite members too, if business allows
biz ##> "/mr alisa alisa_1 admin"
biz <## "#alisa: you changed the role of alisa_1 from member to admin"
biz <## "#alisa: you changed the role of alisa_1 to admin"
alice <## "#biz: biz_1 changed your role from member to admin"
connectUsers alice bob
alice ##> "/a #biz bob"