Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[WPB-2565] Do not send member updates to all #3703

Merged
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/2-features/WPB-2565-member-updates
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Events for a member update, join and leave are not sent to everyone in the team any longer. Only team admins get them.
5 changes: 3 additions & 2 deletions services/galley/src/Galley/API/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,7 @@ import Galley.Effects.GundeckAccess
import Galley.Effects.LegalHoldStore as LegalHoldStore
import Galley.Effects.MemberStore qualified as E
import Galley.Effects.TeamStore
import Galley.Effects.TeamStore qualified as E
import Galley.Intra.Push qualified as Intra
import Galley.Monad
import Galley.Options hiding (brig)
Expand Down Expand Up @@ -361,8 +362,8 @@ rmUser lusr conn = do
goConvPages range newCids

leaveTeams page = for_ (pageItems page) $ \tid -> do
mems <- getTeamMembersForFanout tid
uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) mems
admins <- E.getTeamAdmins tid
uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) admins
page' <- listTeams @p2 (tUnqualified lusr) (Just (pageState page)) maxBound
leaveTeams page'

Expand Down
97 changes: 35 additions & 62 deletions services/galley/src/Galley/API/Teams.hs
Original file line number Diff line number Diff line change
Expand Up @@ -332,10 +332,10 @@ updateTeamH zusr zcon tid updateData = do
void $ permissionCheckS SSetTeamData zusrMembership
E.setTeamData tid updateData
now <- input
memList <- getTeamMembersForFanout tid
admins <- E.getTeamAdmins tid
let e = newEvent tid now (EdTeamUpdate updateData)
let r = list1 (userRecipient zusr) (membersToRecipients (Just zusr) (memList ^. teamMembers))
E.push1 $ newPushLocal1 (memList ^. teamMemberListType) zusr (TeamEvent e) r & pushConn ?~ zcon
let r = list1 (userRecipient zusr) (map userRecipient (filter (/= zusr) admins))
E.push1 $ newPushLocal1 ListComplete zusr (TeamEvent e) r & pushConn ?~ zcon & pushTransient .~ True

deleteTeam ::
forall r.
Expand Down Expand Up @@ -737,8 +737,7 @@ addTeamMember lzusr zcon tid nmem = do
ensureConnectedToLocals zusr [uid]
(TeamSize sizeBeforeJoin) <- E.getSize tid
ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1)
memList <- getTeamMembersForFanout tid
void $ addTeamMemberInternal tid (Just zusr) (Just zcon) nmem memList
void $ addTeamMemberInternal tid (Just zusr) (Just zcon) nmem

-- This function is "unchecked" because there is no need to check for user binding (invite only).
uncheckedAddTeamMember ::
Expand All @@ -760,12 +759,11 @@ uncheckedAddTeamMember ::
NewTeamMember ->
Sem r ()
uncheckedAddTeamMember tid nmem = do
mems <- getTeamMembersForFanout tid
(TeamSize sizeBeforeJoin) <- E.getSize tid
ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1)
(TeamSize sizeBeforeAdd) <- addTeamMemberInternal tid Nothing Nothing nmem mems
billingUserIds <- E.getBillingTeamMembers tid
Journal.teamUpdate tid (sizeBeforeAdd + 1) billingUserIds
(TeamSize sizeBeforeAdd) <- addTeamMemberInternal tid Nothing Nothing nmem
owners <- E.getBillingTeamMembers tid
Journal.teamUpdate tid (sizeBeforeAdd + 1) owners

uncheckedUpdateTeamMember ::
forall r.
Expand Down Expand Up @@ -804,30 +802,15 @@ uncheckedUpdateTeamMember mlzusr mZcon tid newMember = do
-- update target in Cassandra
E.setTeamMemberPermissions (previousMember ^. permissions) tid targetId targetPermissions

updatedMembers <- getTeamMembersForFanout tid
updateJournal team
updatePeers mZusr targetId targetMember targetPermissions updatedMembers
where
updateJournal :: Team -> Sem r ()
updateJournal team = do
when (team ^. teamBinding == Binding) $ do
(TeamSize size) <- E.getSize tid
owners <- E.getBillingTeamMembers tid
Journal.teamUpdate tid size owners

updatePeers :: Maybe UserId -> UserId -> TeamMember -> Permissions -> TeamMemberList -> Sem r ()
updatePeers zusr targetId targetMember targetPermissions updatedMembers = do
-- inform members of the team about the change
-- some (privileged) users will be informed about which change was applied
let privileged = filter (`canSeePermsOf` targetMember) (updatedMembers ^. teamMembers)
mkUpdate = EdMemberUpdate targetId
privilegedUpdate = mkUpdate $ Just targetPermissions
privilegedRecipients = membersToRecipients Nothing privileged
now <- input
let ePriv = newEvent tid now privilegedUpdate
-- push to all members (user is privileged)
let pushPriv = newPush (updatedMembers ^. teamMemberListType) zusr (TeamEvent ePriv) $ privilegedRecipients
for_ pushPriv (\p -> E.push1 (p & pushConn .~ mZcon))
when (team ^. teamBinding == Binding) $ do
(TeamSize size) <- E.getSize tid
owners <- E.getBillingTeamMembers tid
Journal.teamUpdate tid size owners

now <- input
let event = newEvent tid now (EdMemberUpdate targetId (Just targetPermissions))
let pushPriv = newPush ListComplete mZusr (TeamEvent event) (map userRecipient admins')
for_ pushPriv (\p -> E.push1 (p & pushConn .~ mZcon & pushTransient .~ True))

updateTeamMember ::
forall r.
Expand Down Expand Up @@ -967,7 +950,6 @@ deleteTeamMember' lusr zcon tid remove mBody = do
tm <- noteS @'TeamMemberNotFound targetMember
unless (canDeleteMember dm tm) $ throwS @'AccessDenied
team <- fmap tdTeam $ E.getTeam tid >>= noteS @'TeamNotFound
mems <- getTeamMembersForFanout tid
if team ^. teamBinding == Binding && isJust targetMember
then do
body <- mBody & note (InvalidPayload "missing request body")
Expand All @@ -985,7 +967,8 @@ deleteTeamMember' lusr zcon tid remove mBody = do
Journal.teamUpdate tid sizeAfterDelete $ filter (/= remove) owners
pure TeamMemberDeleteAccepted
else do
uncheckedDeleteTeamMember lusr (Just zcon) tid remove mems
admins <- E.getTeamAdmins tid
uncheckedDeleteTeamMember lusr (Just zcon) tid remove admins
pure TeamMemberDeleteCompleted

-- This function is "unchecked" because it does not validate that the user has the `RemoveTeamMember` permission.
Expand All @@ -1002,47 +985,43 @@ uncheckedDeleteTeamMember ::
Maybe ConnId ->
TeamId ->
UserId ->
TeamMemberList ->
[UserId] ->
Sem r ()
uncheckedDeleteTeamMember lusr zcon tid remove mems = do
uncheckedDeleteTeamMember lusr zcon tid remove admins = do
now <- input
pushMemberLeaveEvent now
E.deleteTeamMember tid remove
removeFromConvsAndPushConvLeaveEvent now
where
-- notify all team members.
-- notify team admins
pushMemberLeaveEvent :: UTCTime -> Sem r ()
pushMemberLeaveEvent now = do
let e = newEvent tid now (EdMemberLeave remove)
let r =
list1
(userRecipient (tUnqualified lusr))
(membersToRecipients (Just (tUnqualified lusr)) (mems ^. teamMembers))
userRecipient
<$> list1
(tUnqualified lusr)
(filter (/= (tUnqualified lusr)) admins)
E.push1 $
newPushLocal1 (mems ^. teamMemberListType) (tUnqualified lusr) (TeamEvent e) r & pushConn .~ zcon
newPushLocal1 ListComplete (tUnqualified lusr) (TeamEvent e) r & pushConn .~ zcon & pushTransient .~ True
-- notify all conversation members not in this team.
removeFromConvsAndPushConvLeaveEvent :: UTCTime -> Sem r ()
removeFromConvsAndPushConvLeaveEvent now = do
-- This may not make sense if that list has been truncated. In such cases, we still want to
-- remove the user from conversations but never send out any events. We assume that clients
-- handle nicely these missing events, regardless of whether they are in the same team or not
let tmids = Set.fromList $ map (view userId) (mems ^. teamMembers)
let tmids = Set.fromList admins
let edata = Conv.EdMembersLeave Conv.EdReasonDeleted (Conv.QualifiedUserIdList [tUntagged (qualifyAs lusr remove)])
cc <- E.getTeamConversations tid
for_ cc $ \c ->
E.getConversation (c ^. conversationId) >>= \conv ->
for_ conv $ \dc -> when (remove `isMember` Data.convLocalMembers dc) $ do
E.deleteMembers (c ^. conversationId) (UserList [remove] [])
-- If the list was truncated, then the tmids list is incomplete so we simply drop these events
unless (mems ^. teamMemberListType == ListTruncated) $
pushEvent tmids edata now dc
pushEvent tmids edata now dc
pushEvent :: Set UserId -> Conv.EventData -> UTCTime -> Data.Conversation -> Sem r ()
pushEvent exceptTo edata now dc = do
let qconvId = tUntagged $ qualifyAs lusr (Data.convId dc)
let (bots, users) = localBotsAndUsers (Data.convLocalMembers dc)
let x = filter (\m -> not (Conv.lmId m `Set.member` exceptTo)) users
let y = Conv.Event qconvId Nothing (tUntagged lusr) now edata
for_ (newPushLocal (mems ^. teamMemberListType) (tUnqualified lusr) (ConvEvent y) (recipient <$> x)) $ \p ->
for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent y) (recipient <$> x)) $ \p ->
E.push1 $ p & pushConn .~ zcon
E.deliverAsync (map (,y) bots)

Expand Down Expand Up @@ -1264,9 +1243,8 @@ addTeamMemberInternal ::
Maybe UserId ->
Maybe ConnId ->
NewTeamMember ->
TeamMemberList ->
Sem r TeamSize
addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) memList = do
addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) = do
P.debug $
Log.field "targets" (toByteString (new ^. userId))
. Log.field "action" (Log.val "Teams.addTeamMemberInternal")
Expand All @@ -1277,22 +1255,17 @@ addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) memList =
checkAdminLimit (length admins')

E.createTeamMember tid new

now <- input
let e = newEvent tid now (EdMemberJoin (new ^. userId))
let rs = case origin of
Just o -> userRecipient <$> list1 o (filter (/= o) ((new ^. userId) : admins'))
Nothing -> userRecipient <$> list1 (new ^. userId) (admins')
E.push1 $
newPushLocal1 (memList ^. teamMemberListType) (new ^. userId) (TeamEvent e) (recipients origin new) & pushConn .~ originConn
newPushLocal1 ListComplete (new ^. userId) (TeamEvent e) rs & pushConn .~ originConn & pushTransient .~ True

APITeamQueue.pushTeamEvent tid e
pure sizeBeforeAdd
where
recipients (Just o) n =
list1
(userRecipient o)
(membersToRecipients (Just o) (n : memList ^. teamMembers))
recipients Nothing n =
list1
(userRecipient (n ^. userId))
(membersToRecipients Nothing (memList ^. teamMembers))

finishCreateTeam ::
( Member GundeckAccess r,
Expand Down
Loading
Loading