diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 9fa1ca1831..6845c124f6 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -1415,6 +1415,26 @@ CREATE TABLE galley_test.group_id_conv_id ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE galley_test.team_admin ( + team uuid, + user uuid, + PRIMARY KEY (team, user) +) WITH CLUSTERING ORDER BY (user ASC) + AND bloom_filter_fp_chance = 0.1 + AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} + AND comment = '' + AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'} + AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} + AND crc_check_chance = 1.0 + AND dclocal_read_repair_chance = 0.1 + AND default_time_to_live = 0 + AND gc_grace_seconds = 864000 + AND max_index_interval = 2048 + AND memtable_flush_period_in_ms = 0 + AND min_index_interval = 128 + AND read_repair_chance = 0.0 + AND speculative_retry = '99PERCENTILE'; + -- NOTE: this table is unused. It was replaced by mls_group_member_client CREATE TABLE galley_test.member_client ( conv uuid, diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 5318b760e6..ed15dc9ea6 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -56,6 +56,7 @@ module Galley.Types.Teams rolePermissions, roleHiddenPermissions, permissionsRole, + isAdminOrOwner, HiddenPerm (..), IsPerm (..), ) @@ -101,6 +102,15 @@ permissionsRole (Permissions p p') = rolePerms role `Set.isSubsetOf` perms ] +isAdminOrOwner :: Permissions -> Bool +isAdminOrOwner perms = + case permissionsRole perms of + Just RoleOwner -> True + Just RoleAdmin -> True + Just RoleMember -> False + Just RoleExternalPartner -> False + Nothing -> False + -- | Internal function for 'rolePermissions'. (It works iff the two sets in 'Permissions' are -- identical for every 'Role', otherwise it'll need to be specialized for the resp. sides.) rolePerms :: Role -> Set Perm diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 790f6405ee..dc9747cbfd 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -59,6 +59,7 @@ data GalleyError | UserBindingExists | NoAddToBinding | TooManyTeamMembers + | TooManyTeamAdmins | -- FUTUREWORK: possibly make MissingPermission take a list of Perm MissingPermission (Maybe Perm) | ActionDenied Action @@ -168,6 +169,8 @@ type instance MapError 'NoAddToBinding = 'StaticError 403 "binding-team" "Cannot type instance MapError 'TooManyTeamMembers = 'StaticError 403 "too-many-team-members" "Maximum number of members per team reached" +type instance MapError 'TooManyTeamAdmins = 'StaticError 403 "too-many-team-admins" "Maximum number of admins per team reached" + type instance MapError ('MissingPermission mperm) = 'StaticError 403 "operation-denied" (MissingPermissionMessage mperm) type instance MapError ('ActionDenied action) = 'StaticError 403 "action-denied" ("Insufficient authorization (missing " `AppendSymbol` ActionName action `AppendSymbol` ")") diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index 573a222faa..b7a9aaec62 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -294,6 +294,7 @@ type ITeamsAPIBase = "unchecked-add-team-member" ( CanThrow 'TooManyTeamMembers :> CanThrow 'TooManyTeamMembersOnTeamWithLegalhold + :> CanThrow 'TooManyTeamAdmins :> ReqBody '[Servant.JSON] NewTeamMember :> MultiVerb1 'POST '[Servant.JSON] (RespondEmpty 200 "OK") ) @@ -320,6 +321,7 @@ type ITeamsAPIBase = :> CanThrow 'InvalidPermissions :> CanThrow 'TeamNotFound :> CanThrow 'TeamMemberNotFound + :> CanThrow 'TooManyTeamAdmins :> CanThrow 'NotATeamMember :> CanThrow OperationDenied :> ReqBody '[Servant.JSON] NewTeamMember diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs index 205d51c2a8..1ad7dca780 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -105,6 +105,7 @@ type TeamMemberAPI = :> CanThrow OperationDenied :> CanThrow 'TeamNotFound :> CanThrow 'TooManyTeamMembers + :> CanThrow 'TooManyTeamAdmins :> CanThrow 'UserBindingExists :> CanThrow 'TooManyTeamMembersOnTeamWithLegalhold :> ZLocalUser @@ -169,6 +170,7 @@ type TeamMemberAPI = :> CanThrow 'InvalidPermissions :> CanThrow 'TeamNotFound :> CanThrow 'TeamMemberNotFound + :> CanThrow 'TooManyTeamAdmins :> CanThrow 'NotATeamMember :> CanThrow OperationDenied :> ZLocalUser diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index 43b6f433c7..8ae143b501 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -389,7 +389,7 @@ testRemoteUserGetsDeleted opts brig cannon fedBrigClient = do runFedClient @"on-user-deleted-connections" fedBrigClient (qDomain remoteUser) $ UserDeletedConnectionsNotification (qUnqualified remoteUser) (unsafeRange localUsers) - WS.assertMatchN_ (5 # Second) [cc] $ matchDeleteUserNotification remoteUser + WS.assertMatchN_ (60 # Second) [cc] $ matchDeleteUserNotification remoteUser WS.assertNoEvent (1 # Second) [pc, bc, uc] for_ localUsers $ \u -> diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 821833d550..0465b86da0 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -525,6 +525,7 @@ executable galley-migrate-data Paths_galley V1_BackfillBillingTeamMembers V2_MigrateMLSMembers + V3_BackfillTeamAdmins hs-source-dirs: migrate-data/src default-extensions: @@ -583,6 +584,7 @@ executable galley-migrate-data , exceptions , extended , galley + , galley-types , imports , lens , optparse-applicative @@ -667,6 +669,7 @@ executable galley-schema V80_AddConversationCodePassword V81_TeamFeatureMlsE2EIdUpdate V82_RemoteDomainIndexes + V83_CreateTableTeamAdmin hs-source-dirs: schema/src default-extensions: diff --git a/services/galley/migrate-data/src/Main.hs b/services/galley/migrate-data/src/Main.hs index f6a051b8d5..c3e728aedf 100644 --- a/services/galley/migrate-data/src/Main.hs +++ b/services/galley/migrate-data/src/Main.hs @@ -23,6 +23,7 @@ import Options.Applicative import qualified System.Logger.Extended as Log import qualified V1_BackfillBillingTeamMembers import qualified V2_MigrateMLSMembers +import qualified V3_BackfillTeamAdmins main :: IO () main = do @@ -32,7 +33,8 @@ main = do l o [ V1_BackfillBillingTeamMembers.migration, - V2_MigrateMLSMembers.migration + V2_MigrateMLSMembers.migration, + V3_BackfillTeamAdmins.migration ] where desc = header "Galley Cassandra Data Migrations" <> fullDesc diff --git a/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs b/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs new file mode 100644 index 0000000000..207828fb6b --- /dev/null +++ b/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs @@ -0,0 +1,74 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module V3_BackfillTeamAdmins where + +import Cassandra +import Conduit +import Data.Conduit.Internal (zipSources) +import qualified Data.Conduit.List as C +import Data.Id +import Galley.DataMigration.Types +import Galley.Types.Teams +import Imports +import qualified System.Logger.Class as Log +import Wire.API.Team.Permission +import Wire.API.Team.Role + +migration :: Migration +migration = + Migration + { version = MigrationVersion 3, + text = "Backfill team_admin", + action = + runConduit $ + zipSources + (C.sourceList [(1 :: Int32) ..]) + getTeamMembers + .| C.mapM + ( \(i, p) -> + Log.info (Log.field "team members" (show (i * pageSize))) + >> pure p + ) + .| C.concatMap (filter isAdmin) + .| C.map (\(t, u, _) -> (t, u)) + .| C.mapM_ createTeamAdmins + } + +pageSize :: Int32 +pageSize = 1000 + +---------------------------------------------------------------------------- +-- Queries + +-- | Get team members from Galley +getTeamMembers :: MonadClient m => ConduitM () [(TeamId, UserId, Maybe Permissions)] m () +getTeamMembers = paginateC cql (paramsP LocalQuorum () pageSize) x5 + where + cql :: PrepQuery R () (TeamId, UserId, Maybe Permissions) + cql = "SELECT team, user, perms FROM team_member" + +createTeamAdmins :: MonadClient m => (TeamId, UserId) -> m () +createTeamAdmins pair = + retry x5 $ write cql (params LocalQuorum pair) + where + cql :: PrepQuery W (TeamId, UserId) () + cql = "INSERT INTO team_admin (team, user) values (?, ?)" + +isAdmin :: (TeamId, UserId, Maybe Permissions) -> Bool +isAdmin (_, _, Just p) = permissionsRole p == Just RoleAdmin || permissionsRole p == Just RoleOwner +isAdmin _ = False diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index a5b321e6af..1ce2a8ab1e 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -85,6 +85,7 @@ import qualified V79_TeamFeatureMlsE2EId import qualified V80_AddConversationCodePassword import qualified V81_TeamFeatureMlsE2EIdUpdate import qualified V82_RemoteDomainIndexes +import qualified V83_CreateTableTeamAdmin main :: IO () main = do @@ -155,7 +156,8 @@ main = do V79_TeamFeatureMlsE2EId.migration, V80_AddConversationCodePassword.migration, V81_TeamFeatureMlsE2EIdUpdate.migration, - V82_RemoteDomainIndexes.migration + V82_RemoteDomainIndexes.migration, + V83_CreateTableTeamAdmin.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Cassandra -- (see also docs/developer/cassandra-interaction.md) diff --git a/services/galley/schema/src/V83_CreateTableTeamAdmin.hs b/services/galley/schema/src/V83_CreateTableTeamAdmin.hs new file mode 100644 index 0000000000..f52cd0cebc --- /dev/null +++ b/services/galley/schema/src/V83_CreateTableTeamAdmin.hs @@ -0,0 +1,36 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module V83_CreateTableTeamAdmin + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 83 "Create table `team_admin`" $ do + schema' + [r| + CREATE TABLE team_admin ( + team uuid, + user uuid, + PRIMARY KEY (team, user) + ) WITH compaction = {'class': 'LeveledCompactionStrategy'}; + |] diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 3541162560..2aae9b9aaf 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -72,6 +72,7 @@ import Galley.Effects.MemberStore import qualified Galley.Effects.MemberStore as E import Galley.Effects.ProposalStore import Galley.Effects.TeamStore +import qualified Galley.Effects.TeamStore as E import qualified Galley.Intra.Push as Intra import Galley.Monad import Galley.Options @@ -375,8 +376,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 index 55dca14c2d..84f186386c 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -138,6 +138,7 @@ import Wire.API.Team.Conversation import qualified Wire.API.Team.Conversation as Public import Wire.API.Team.Export (TeamExportUser (..)) import Wire.API.Team.Member +import qualified Wire.API.Team.Member as M import qualified Wire.API.Team.Member as Public import Wire.API.Team.Permission (Perm (..), Permissions (..), SPerm (..), copy, fullPermissions, self) import Wire.API.Team.Role @@ -328,17 +329,13 @@ updateTeamH :: Sem r () updateTeamH zusr zcon tid updateData = do zusrMembership <- E.getTeamMember tid zusr - -- let zothers = map (view userId) membs - -- Log.debug $ - -- Log.field "targets" (toByteString . show $ toByteString <$> zothers) - -- . Log.field "action" (Log.val "Teams.updateTeam") 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. @@ -707,6 +704,7 @@ addTeamMember :: Member (ErrorS OperationDenied) r, Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'TooManyTeamMembers) r, + Member (ErrorS 'TooManyTeamAdmins) r, Member (ErrorS 'UserBindingExists) r, Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r, Member (Input Opts) r, @@ -739,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 :: @@ -748,6 +745,7 @@ uncheckedAddTeamMember :: ( Member BrigAccess r, Member GundeckAccess r, Member (ErrorS 'TooManyTeamMembers) r, + Member (ErrorS 'TooManyTeamAdmins) r, Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r, Member (Input Opts) r, Member (Input UTCTime) r, @@ -761,18 +759,18 @@ 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. ( Member BrigAccess r, Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'TeamMemberNotFound) r, + Member (ErrorS 'TooManyTeamAdmins) r, Member GundeckAccess r, Member (Input UTCTime) r, Member P.TinyLog r, @@ -797,33 +795,22 @@ uncheckedUpdateTeamMember mlzusr mZcon tid newMember = do previousMember <- E.getTeamMember tid targetId >>= noteS @'TeamMemberNotFound + admins <- E.getTeamAdmins tid + let admins' = [targetId | isAdminOrOwner targetPermissions] <> filter (/= targetId) admins + checkAdminLimit (length admins') + -- 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. @@ -832,6 +819,7 @@ updateTeamMember :: Member (ErrorS 'InvalidPermissions) r, Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'TeamMemberNotFound) r, + Member (ErrorS 'TooManyTeamAdmins) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, Member GundeckAccess r, @@ -962,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") @@ -980,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. @@ -997,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.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 (bots `zip` repeat y) @@ -1242,6 +1226,7 @@ ensureNotTooLargeForLegalHold tid teamSize = addTeamMemberInternal :: ( Member BrigAccess r, Member (ErrorS 'TooManyTeamMembers) r, + Member (ErrorS 'TooManyTeamAdmins) r, Member GundeckAccess r, Member (Input Opts) r, Member (Input UTCTime) r, @@ -1253,29 +1238,29 @@ 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") sizeBeforeAdd <- ensureNotTooLarge tid + + admins <- E.getTeamAdmins tid + let admins' = [new ^. userId | isAdminOrOwner (new ^. M.permissions)] <> admins + 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, @@ -1404,3 +1389,8 @@ queueTeamDeletion :: queueTeamDeletion tid zusr zcon = do ok <- E.tryPush (TeamItem tid zusr zcon) unless ok $ throwS @'DeleteQueueFull + +checkAdminLimit :: Member (ErrorS 'TooManyTeamAdmins) r => Int -> Sem r () +checkAdminLimit adminCount = + when (adminCount > 2000) $ + throwS @'TooManyTeamAdmins diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index 40bfdb094b..32044a86a2 100644 --- a/services/galley/src/Galley/Cassandra.hs +++ b/services/galley/src/Galley/Cassandra.hs @@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where import Imports schemaVersion :: Int32 -schemaVersion = 81 +schemaVersion = 83 diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 8d53bf938d..8e3b596361 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -167,6 +167,15 @@ deleteBillingTeamMember = "delete from billing_team_member where team = ? and us listBillingTeamMembers :: PrepQuery R (Identity TeamId) (Identity UserId) listBillingTeamMembers = "select user from billing_team_member where team = ?" +insertTeamAdmin :: PrepQuery W (TeamId, UserId) () +insertTeamAdmin = "insert into team_admin (team, user) values (?, ?)" + +deleteTeamAdmin :: PrepQuery W (TeamId, UserId) () +deleteTeamAdmin = "delete from team_admin where team = ? and user = ?" + +listTeamAdmins :: PrepQuery R (Identity TeamId) (Identity UserId) +listTeamAdmins = "select user from team_admin where team = ?" + updatePermissions :: PrepQuery W (Permissions, TeamId, UserId) () updatePermissions = "update team_member set perms = ? where team = ? and user = ?" diff --git a/services/galley/src/Galley/Cassandra/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs index 093faadb2a..69fecefa70 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -77,6 +77,7 @@ interpretTeamStoreToCassandra lh = interpret $ \case CreateTeam t uid n i k b -> embedClient $ createTeam t uid n i k b DeleteTeamMember tid uid -> embedClient $ removeTeamMember tid uid GetBillingTeamMembers tid -> embedClient $ listBillingTeamMembers tid + GetTeamAdmins tid -> embedClient $ listTeamAdmins tid GetTeam tid -> embedClient $ team tid GetTeamName tid -> embedClient $ getTeamName tid GetTeamConversation tid cid -> embedClient $ teamConversation tid cid @@ -171,6 +172,11 @@ listBillingTeamMembers tid = fmap runIdentity <$> retry x1 (query Cql.listBillingTeamMembers (params LocalQuorum (Identity tid))) +listTeamAdmins :: TeamId -> Client [UserId] +listTeamAdmins tid = + fmap runIdentity + <$> retry x1 (query Cql.listTeamAdmins (params LocalQuorum (Identity tid))) + getTeamName :: TeamId -> Client (Maybe Text) getTeamName tid = fmap runIdentity @@ -229,8 +235,11 @@ addTeamMember t m = when (m `hasPermission` SetBilling) $ addPrepQuery Cql.insertBillingTeamMember (t, m ^. userId) + when (isAdminOrOwner (m ^. permissions)) $ + addPrepQuery Cql.insertTeamAdmin (t, m ^. userId) + updateTeamMember :: - -- | Old permissions, used for maintaining 'billing_team_member' table + -- | Old permissions, used for maintaining 'billing_team_member' and 'team_admin' tables Permissions -> TeamId -> UserId -> @@ -243,15 +252,25 @@ updateTeamMember oldPerms tid uid newPerms = do setConsistency LocalQuorum addPrepQuery Cql.updatePermissions (newPerms, tid, uid) + -- update billing_team_member table + let permDiff = Set.difference `on` view self + acquiredPerms = newPerms `permDiff` oldPerms + lostPerms = oldPerms `permDiff` newPerms + when (SetBilling `Set.member` acquiredPerms) $ addPrepQuery Cql.insertBillingTeamMember (tid, uid) - when (SetBilling `Set.member` lostPerms) $ addPrepQuery Cql.deleteBillingTeamMember (tid, uid) - where - permDiff = Set.difference `on` view self - acquiredPerms = newPerms `permDiff` oldPerms - lostPerms = oldPerms `permDiff` newPerms + + -- update team_admin table + let wasAdmin = isAdminOrOwner oldPerms + isAdmin = isAdminOrOwner newPerms + + when (isAdmin && not wasAdmin) $ + addPrepQuery Cql.insertTeamAdmin (tid, uid) + + when (not isAdmin && wasAdmin) $ + addPrepQuery Cql.deleteTeamAdmin (tid, uid) removeTeamMember :: TeamId -> UserId -> Client () removeTeamMember t m = @@ -261,6 +280,7 @@ removeTeamMember t m = addPrepQuery Cql.deleteTeamMember (t, m) addPrepQuery Cql.deleteUserTeam (m, t) addPrepQuery Cql.deleteBillingTeamMember (t, m) + addPrepQuery Cql.deleteTeamAdmin (t, m) team :: TeamId -> Client (Maybe TeamData) team tid = diff --git a/services/galley/src/Galley/Effects/TeamStore.hs b/services/galley/src/Galley/Effects/TeamStore.hs index cbca2cc43a..ba6ae042ad 100644 --- a/services/galley/src/Galley/Effects/TeamStore.hs +++ b/services/galley/src/Galley/Effects/TeamStore.hs @@ -59,6 +59,7 @@ module Galley.Effects.TeamStore getTeamMembersWithLimit, getTeamMembers, getBillingTeamMembers, + getTeamAdmins, selectTeamMembers, -- ** Update team members @@ -105,6 +106,7 @@ data TeamStore m a where TeamStore m Team DeleteTeamMember :: TeamId -> UserId -> TeamStore m () GetBillingTeamMembers :: TeamId -> TeamStore m [UserId] + GetTeamAdmins :: TeamId -> TeamStore m [UserId] GetTeam :: TeamId -> TeamStore m (Maybe TeamData) GetTeamName :: TeamId -> TeamStore m (Maybe Text) GetTeamConversation :: TeamId -> ConvId -> TeamStore m (Maybe TeamConversation) diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 3c75268a3a..ca62c5459b 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -153,7 +153,6 @@ tests s = test s "update team data icon validation" testUpdateTeamIconValidation, test s "update team member" testUpdateTeamMember, test s "update team status" testUpdateTeamStatus, - test s "team tests around truncation limits - no events, too large team" testTeamAddRemoveMemberAboveThresholdNoEvents, test s "send billing events to owners even in large teams" testBillingInLargeTeam, testGroup "broadcast" $ [ (BroadcastLegacyBody, BroadcastJSON), @@ -1351,7 +1350,6 @@ testUpdateTeam = do WS.bracketR2 c owner member $ \(wsOwner, wsMember) -> do doPut (encode u) 200 checkTeamUpdateEvent tid u wsOwner - checkTeamUpdateEvent tid u wsMember WS.assertNoEvent timeout [wsOwner, wsMember] t <- Util.getTeam owner tid liftIO $ assertEqual "teamSplashScreen" (t ^. teamSplashScreen) (fromJust $ fromByteString "3-1-e1c89a56-882e-4694-bab3-c4f57803c57a") @@ -1369,154 +1367,6 @@ testUpdateTeam = do t' <- Util.getTeam owner tid liftIO $ assertEqual "teamSplashScreen" (t' ^. teamSplashScreen) DefaultIcon -testTeamAddRemoveMemberAboveThresholdNoEvents :: HasCallStack => TestM () -testTeamAddRemoveMemberAboveThresholdNoEvents = do - localDomain <- viewFederationDomain - o <- view tsGConf - c <- view tsCannon - let fanoutLimit = fromIntegral . fromRange $ Galley.currentFanoutLimit o - (owner, tid) <- Util.createBindingTeam - member1 <- addTeamMemberAndExpectEvent True tid owner - -- Now last fill the team until truncationSize - 2 - - replicateM_ (fanoutLimit - 4) $ Util.addUserToTeam owner tid - (extern, qextern) <- Util.randomUserTuple - modifyTeamDataAndExpectEvent True tid owner - -- Let's create and remove a member - member2 <- do - temp <- addTeamMemberAndExpectEvent True tid owner - Util.connectUsers extern (list1 temp []) - removeTeamMemberAndExpectEvent True owner tid temp [extern] - addTeamMemberAndExpectEvent True tid owner - modifyUserProfileAndExpectEvent True owner [member1, member2] - -- Let's connect an external to test the different behavior - Util.connectUsers extern (list1 owner [member1, member2]) - _memLastWithFanout <- addTeamMemberAndExpectEvent True tid owner - -- We should really wait until we see that the team is of full size - -- Due to the async nature of pushes, waiting even a second might not - -- be enough... - WS.bracketR c owner $ \wsOwner -> WS.assertNoEvent (1 # Second) [wsOwner] - -- No events are now expected - - -- Team member added also not - _memWithoutFanout <- addTeamMemberAndExpectEvent False tid owner - -- Team updates are not propagated - modifyTeamDataAndExpectEvent False tid owner - -- User event updates are not propagated in the team - modifyUserProfileAndExpectEvent False owner [member1, member2] - -- Let us remove 1 member that exceeds the limit, verify that team users - -- do not get the deletion event but the connections do! - removeTeamMemberAndExpectEvent False owner tid member2 [extern] - -- Now we are just on the limit, events are back! - removeTeamMemberAndExpectEvent True owner tid member1 [extern] - -- Let's go back to having a very large team - _memLastWithFanout <- addTeamMemberAndExpectEvent True tid owner - -- We should really wait until we see that the team is of full size - -- Due to the async nature of pushes, waiting even a second might not - -- be enough... - WS.bracketR c owner $ \wsOwner -> WS.assertNoEvent (1 # Second) [wsOwner] - _memWithoutFanout <- addTeamMemberAndExpectEvent False tid owner - -- Add extern to a team conversation - cid1 <- Util.createTeamConv owner tid [] (Just "blaa") Nothing Nothing - qcid1 <- Qualified cid1 <$> viewFederationDomain - Util.postMembers owner (pure qextern) qcid1 !!! const 200 === statusCode - -- Test team deletion (should contain only conv. removal and user.deletion for _non_ team members) - deleteTeam tid owner [] [Qualified cid1 localDomain] extern - where - modifyUserProfileAndExpectEvent :: HasCallStack => Bool -> UserId -> [UserId] -> TestM () - modifyUserProfileAndExpectEvent expect target listeners = do - c <- view tsCannon - b <- viewBrig - WS.bracketRN c listeners $ \wsListeners -> do - -- Do something - let u = U.UserUpdate (Just $ U.Name "name") Nothing Nothing Nothing - put - ( b - . paths ["self"] - . zUser target - . zConn "conn" - . json u - ) - !!! const 200 - === statusCode - if expect - then mapM_ (checkUserUpdateEvent target) wsListeners - else WS.assertNoEvent (1 # Second) wsListeners - modifyTeamDataAndExpectEvent :: HasCallStack => Bool -> TeamId -> UserId -> TestM () - modifyTeamDataAndExpectEvent expect tid origin = do - c <- view tsCannon - g <- viewGalley - let u = newTeamUpdateData & nameUpdate ?~ unsafeRange "bar" - WS.bracketR c origin $ \wsOrigin -> do - put - ( g - . paths ["teams", toByteString' tid] - . zUser origin - . zConn "conn" - . json u - ) - !!! const 200 - === statusCode - -- Due to the fact that the team is too large, we expect no events! - if expect - then checkTeamUpdateEvent tid u wsOrigin - else WS.assertNoEvent (1 # Second) [wsOrigin] - addTeamMemberAndExpectEvent :: HasCallStack => Bool -> TeamId -> UserId -> TestM UserId - addTeamMemberAndExpectEvent expect tid origin = do - c <- view tsCannon - WS.bracketR c origin $ \wsOrigin -> do - member <- view userId <$> Util.addUserToTeam origin tid - refreshIndex - if expect - then checkTeamMemberJoin tid member wsOrigin - else WS.assertNoEvent (1 # Second) [wsOrigin] - pure member - removeTeamMemberAndExpectEvent :: HasCallStack => Bool -> UserId -> TeamId -> UserId -> [UserId] -> TestM () - removeTeamMemberAndExpectEvent expect owner tid victim others = do - c <- view tsCannon - g <- viewGalley - WS.bracketRN c (owner : victim : others) $ \(wsOwner : _wsVictim : wsOthers) -> do - delete - ( g - . paths ["teams", toByteString' tid, "members", toByteString' victim] - . zUser owner - . zConn "conn" - . json (newTeamMemberDeleteData (Just $ Util.defPassword)) - ) - !!! const 202 - === statusCode - if expect - then checkTeamMemberLeave tid victim wsOwner - else WS.assertNoEvent (1 # Second) [wsOwner] - -- User deletion events - mapM_ (checkUserDeleteEvent victim checkTimeout) wsOthers - Util.ensureDeletedState True owner victim - deleteTeam :: HasCallStack => TeamId -> UserId -> [UserId] -> [Qualified ConvId] -> UserId -> TestM () - deleteTeam tid owner otherRealUsersInTeam teamCidsThatExternBelongsTo extern = do - c <- view tsCannon - g <- viewGalley - void . WS.bracketRN c (owner : extern : otherRealUsersInTeam) $ \(_wsOwner : wsExtern : _wsotherRealUsersInTeam) -> do - delete - ( g - . paths ["teams", toByteString' tid] - . zUser owner - . zConn "conn" - . json (newTeamDeleteData (Just Util.defPassword)) - ) - !!! const 202 - === statusCode - for_ (owner : otherRealUsersInTeam) $ \u -> checkUserDeleteEvent u (7 # Second) wsExtern - -- Ensure users are marked as deleted; since we already - -- received the event, should _really_ be deleted - for_ (owner : otherRealUsersInTeam) $ Util.ensureDeletedState True extern - mapM_ (flip checkConvDeleteEvent wsExtern) teamCidsThatExternBelongsTo - -- ensure the team has a deleted status - void $ - retryWhileN - 10 - ((/= TeamsIntra.Deleted) . TeamsIntra.tdStatus) - (getTeamInternal tid) - testBillingInLargeTeam :: TestM () testBillingInLargeTeam = do (firstOwner, team) <- Util.createBindingTeam @@ -1576,7 +1426,6 @@ testUpdateTeamMember = do member' <- Util.getTeamMember owner tid (member ^. userId) liftIO $ assertEqual "permissions" (member' ^. permissions) (demoteMember ^. nPermissions) checkTeamMemberUpdateEvent tid (member ^. userId) wsOwner (pure noPermissions) - checkTeamMemberUpdateEvent tid (member ^. userId) wsMember (pure noPermissions) WS.assertNoEvent timeout [wsOwner, wsMember] assertTeamUpdate "Member demoted" tid 2 [owner] -- owner can promote non-owner @@ -1614,7 +1463,6 @@ testUpdateTeamMember = do . json change ) checkTeamMemberUpdateEvent tid uid w mPerm = WS.assertMatch_ timeout w $ \notif -> do - ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) e ^. eventTeam @?= tid e ^. eventData @?= EdMemberUpdate uid mPerm @@ -1919,7 +1767,7 @@ putSearchVisibility g uid tid vis = do checkJoinEvent :: (MonadIO m, MonadCatch m) => TeamId -> UserId -> WS.WebSocket -> m () checkJoinEvent tid usr w = WS.assertMatch_ timeout w $ \notif -> do - ntfTransient notif @?= False + ntfTransient notif @?= True let e = List1.head (WS.unpackPayload notif) e ^. eventTeam @?= tid e ^. eventData @?= EdMemberJoin usr diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 7baa0fd89f..dc772a3a92 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -2716,21 +2716,21 @@ checkUserDeleteEvent uid timeout_ w = WS.assertMatch_ timeout_ w $ \notif -> do checkTeamMemberJoin :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM () checkTeamMemberJoin tid uid w = WS.awaitMatch_ checkTimeout w $ \notif -> do - ntfTransient notif @?= False + ntfTransient notif @?= True let e = List1.head (WS.unpackPayload notif) e ^. eventTeam @?= tid e ^. eventData @?= EdMemberJoin uid checkTeamMemberLeave :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM () checkTeamMemberLeave tid usr w = WS.assertMatch_ checkTimeout w $ \notif -> do - ntfTransient notif @?= False + ntfTransient notif @?= True let e = List1.head (WS.unpackPayload notif) e ^. eventTeam @?= tid e ^. eventData @?= EdMemberLeave usr checkTeamUpdateEvent :: (HasCallStack, MonadIO m, MonadCatch m) => TeamId -> TeamUpdateData -> WS.WebSocket -> m () checkTeamUpdateEvent tid upd w = WS.assertMatch_ checkTimeout w $ \notif -> do - ntfTransient notif @?= False + ntfTransient notif @?= True let e = List1.head (WS.unpackPayload notif) e ^. eventTeam @?= tid e ^. eventData @?= EdTeamUpdate upd @@ -2802,7 +2802,7 @@ checkConvMemberLeaveEvent cid usr w = WS.assertMatch_ checkTimeout w $ \notif -> other -> assertFailure $ "Unexpected event data: " <> show other checkTimeout :: WS.Timeout -checkTimeout = 4 # Second +checkTimeout = 60 # Second -- | The function is used in conjuction with 'withTempMockFederator' to mock -- responses by Brig on the mocked side of federation.