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

* Do not send member updates to all (#3431) --------- Co-authored-by: Paolo Capriotti <[email protected]> Co-authored-by: Stefan Matting <[email protected]>
wireapp · Nov 13, 2023 · c0cc85e · c0cc85e
1 parent aa7c912
commit c0cc85e
Show file tree

Hide file tree

Showing 5 changed files with 44 additions and 221 deletions.
diff --git a/changelog.d/2-features/WPB-2565-member-updates b/changelog.d/2-features/WPB-2565-member-updates
@@ -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.
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
@@ -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)
@@ -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'
 

diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs
@@ -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.
@@ -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 ::
@@ -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.
@@ -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.
@@ -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")
@@ -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.
@@ -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)
 
@@ -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")
@@ -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,
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.