Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions changelog.d/1-api-changes/backend-removal-fix
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Users being kicked out results in member-leave events originating from the user who caused the change in the conversation
67 changes: 47 additions & 20 deletions services/galley/src/Galley/API/Action.hs
Original file line number Diff line number Diff line change
Expand Up @@ -340,7 +340,7 @@ performAction tag origUser lconv action = do
E.setConversationReceiptMode (tUnqualified lcnv) (cruReceiptMode action)
pure (mempty, action)
SConversationAccessDataTag -> do
(bm, act) <- performConversationAccessData lconv action
(bm, act) <- performConversationAccessData origUser lconv action
pure (bm, act)

performConversationJoin ::
Expand Down Expand Up @@ -457,14 +457,11 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do
then do
for_ convUsersLHStatus $ \(mem, status) ->
when (consentGiven status == ConsentNotGiven) $ do
let lvictim = qualifyAs lconv (lmId mem)
void . runError @NoChanges $
updateLocalConversation
@'ConversationLeaveTag
(fmap convId lconv)
(qUntagged lvictim)
Nothing
()
kickMember
qusr
lconv
(convBotsAndMembers (tUnqualified lconv))
(qUntagged (qualifyAs lconv (lmId mem)))
else throwS @'MissingLegalholdConsent

checkLHPolicyConflictsRemote ::
Expand All @@ -474,10 +471,11 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do

performConversationAccessData ::
(HasConversationActionEffects 'ConversationAccessDataTag r) =>
Qualified UserId ->
Local Conversation ->
ConversationAccessData ->
Sem r (BotsAndMembers, ConversationAccessData)
performConversationAccessData lconv action = do
performConversationAccessData qusr lconv action = do
when (convAccessData conv == action) noChanges
-- Remove conversation codes if CodeAccess is revoked
when
Expand Down Expand Up @@ -506,16 +504,8 @@ performConversationAccessData lconv action = do
let bmToNotify = current {bmBots = bmBots desired}

-- Remove users and notify everyone
for_ (bmQualifiedMembers lcnv toRemove) $ \userToRemove -> do
(extraTargets, action') <- performAction SConversationLeaveTag userToRemove lconv ()
notifyConversationAction
(sing @'ConversationLeaveTag)
userToRemove
True
Nothing
lconv
(bmToNotify <> extraTargets)
action'
for_ (bmQualifiedMembers lcnv toRemove) $
kickMember qusr lconv bmToNotify

pure (mempty, action)
where
Expand Down Expand Up @@ -792,3 +782,40 @@ notifyRemoteConversationAction loc rconvUpdate con = do
let bots = []

pushConversationEvent con event localPresentUsers bots $> event

-- | Kick a user from a conversation and send notifications.
--
-- This function removes the given victim from the conversation by making them
-- leave, but then sends notifications as if the user was removed by someone
-- else.
kickMember ::
( Member (Error InternalError) r,
Member ExternalAccess r,
Member FederatorAccess r,
Member GundeckAccess r,
Member ProposalStore r,
Member (Input UTCTime) r,
Member (Input Env) r,
Member MemberStore r,
Member TinyLog r
) =>
Qualified UserId ->
Local Conversation ->
BotsAndMembers ->
Qualified UserId ->
Sem r ()
kickMember qusr lconv targets victim = void . runError @NoChanges $ do
(extraTargets, _) <-
performAction
SConversationLeaveTag
victim
lconv
()
notifyConversationAction
(sing @'ConversationRemoveMembersTag)
qusr
True
Nothing
lconv
(targets <> extraTargets)
(pure victim)
41 changes: 21 additions & 20 deletions services/galley/test/integration/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1483,9 +1483,9 @@ postConvertTeamConv = do
-- non-team members get kicked out
liftIO $ do
WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $
wsAssertMemberLeave qconv qeve (pure qeve)
wsAssertMemberLeave qconv qalice (pure qeve)
WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $
wsAssertMemberLeave qconv qmallory (pure qmallory)
wsAssertMemberLeave qconv qalice (pure qmallory)
-- joining (for mallory) is no longer possible
postJoinCodeConv mallory j !!! const 403 === statusCode
-- team members (dave) can still join
Expand Down Expand Up @@ -1537,14 +1537,17 @@ testAccessUpdateGuestRemoved = do
-- note that removing users happens asynchronously, so this check should
-- happen while the mock federator is still available
WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $
wsAssertMembersLeave (cnvQualifiedId conv) charlie [charlie]
wsAssertMembersLeave (cnvQualifiedId conv) alice [charlie]
WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $
wsAssertMembersLeave (cnvQualifiedId conv) dee [dee]
wsAssertMembersLeave (cnvQualifiedId conv) alice [dee]

-- dee's remote receives a notification
let compareLists [] ys = [] @?= ys
compareLists (x : xs) ys = case break (== x) ys of
(ys1, _ : ys2) -> compareLists xs (ys1 <> ys2)
_ -> assertFailure $ "Could not find " <> show x <> " in " <> show ys
liftIO $
sortOn
(fmap fst)
compareLists
( map
( \fr -> do
cu <- eitherDecode (frBody fr)
Expand All @@ -1558,20 +1561,18 @@ testAccessUpdateGuestRemoved = do
reqs
)
)
@?= sortOn
(fmap fst)
[ Right (charlie, SomeConversationAction (sing @'ConversationLeaveTag) ()),
Right (dee, SomeConversationAction (sing @'ConversationLeaveTag) ()),
Right
( alice,
SomeConversationAction
(sing @'ConversationAccessDataTag)
ConversationAccessData
{ cupAccess = mempty,
cupAccessRoles = Set.fromList [TeamMemberAccessRole]
}
)
]
[ Right (alice, SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure charlie)),
Right (alice, SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure dee)),
Right
( alice,
SomeConversationAction
(sing @'ConversationAccessDataTag)
ConversationAccessData
{ cupAccess = mempty,
cupAccessRoles = Set.fromList [TeamMemberAccessRole]
}
)
]

-- only alice and bob remain
conv2 <-
Expand Down