diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 0474d89325..5eb68efc44 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -168,7 +168,6 @@ CREATE TABLE galley_test.member ( conversation_role text, hidden boolean, hidden_ref text, - mls_clients_keypackages set>>, otr_archived boolean, otr_archived_ref text, otr_muted boolean, @@ -262,7 +261,6 @@ CREATE TABLE galley_test.member_remote_user ( user_remote_domain text, user_remote_id uuid, conversation_role text, - mls_clients_keypackages set>>, PRIMARY KEY (conv, user_remote_domain, user_remote_id) ) WITH CLUSTERING ORDER BY (user_remote_domain ASC, user_remote_id ASC) AND bloom_filter_fp_chance = 0.1 @@ -365,15 +363,18 @@ CREATE TABLE galley_test.group_id_conv_id ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; -CREATE TABLE galley_test.user ( - user uuid, +CREATE TABLE galley_test.member_client ( conv uuid, - PRIMARY KEY (user, conv) -) WITH CLUSTERING ORDER BY (conv ASC) - AND bloom_filter_fp_chance = 0.1 + user_domain text, + user uuid, + client text, + key_package_ref blob, + PRIMARY KEY (conv, user_domain, user, client) +) WITH CLUSTERING ORDER BY (user_domain ASC, user ASC, client ASC) + AND bloom_filter_fp_chance = 0.01 AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} AND comment = '' - AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'} + AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} 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 @@ -565,6 +566,26 @@ CREATE TABLE galley_test.mls_proposal_refs ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE galley_test.user ( + user uuid, + conv uuid, + PRIMARY KEY (user, conv) +) WITH CLUSTERING ORDER BY (conv 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'; + CREATE KEYSPACE gundeck_test WITH replication = {'class': 'SimpleStrategy', 'replication_factor': '1'} AND durable_writes = true; CREATE TABLE gundeck_test.push ( diff --git a/changelog.d/1-api-changes/leave-mls-conv b/changelog.d/1-api-changes/leave-mls-conv new file mode 100644 index 0000000000..0c9e0474ca --- /dev/null +++ b/changelog.d/1-api-changes/leave-mls-conv @@ -0,0 +1 @@ +Leaving an MLS conversation is now possible using the regular endpoint `DELETE /conversations/{cnv_domain}/{cnv}/members/{usr_domain}/{usr}`. When a user leaves, the backend sends external remove proposals for all their clients in the corresponding MLS group. diff --git a/changelog.d/5-internal/mls-clients-in-conv b/changelog.d/5-internal/mls-clients-in-conv new file mode 100644 index 0000000000..55d01f9304 --- /dev/null +++ b/changelog.d/5-internal/mls-clients-in-conv @@ -0,0 +1 @@ +Clients and key package refs in an MLS conversation are now stored in their own table. diff --git a/libs/galley-types/src/Galley/Types/Conversations/Members.hs b/libs/galley-types/src/Galley/Types/Conversations/Members.hs index 9c6b9b5eb0..eb602cfe10 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/Members.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/Members.hs @@ -33,18 +33,15 @@ where import Data.Domain import Data.Id as Id import Data.Qualified -import qualified Data.Set as Set import Imports import Wire.API.Conversation import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) -import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service (ServiceRef) -- | Internal (cassandra) representation of a remote conversation member. data RemoteMember = RemoteMember { rmId :: Remote UserId, - rmConvRoleName :: RoleName, - rmMLSClients :: Set (ClientId, KeyPackageRef) + rmConvRoleName :: RoleName } deriving stock (Show) @@ -64,8 +61,7 @@ data LocalMember = LocalMember { lmId :: UserId, lmStatus :: MemberStatus, lmService :: Maybe ServiceRef, - lmConvRoleName :: RoleName, - lmMLSClients :: Set (ClientId, KeyPackageRef) + lmConvRoleName :: RoleName } deriving stock (Show) @@ -78,8 +74,7 @@ newMemberWithRole (u, r) = { lmId = u, lmService = Nothing, lmStatus = defMemberStatus, - lmConvRoleName = r, - lmMLSClients = Set.empty + lmConvRoleName = r } localMemberToOther :: Domain -> LocalMember -> OtherMember diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 12180988f6..0eb22eb4d5 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -41,6 +41,7 @@ module Data.Qualified indexQualified, bucketQualified, bucketRemote, + isLocal, deprecatedSchema, qualifiedSchema, qualifiedObjectSchema, @@ -157,6 +158,9 @@ bucketRemote = . indexQualified . fmap qUntagged +isLocal :: Local x -> Qualified a -> Bool +isLocal loc = foldQualified loc (const True) (const False) + ---------------------------------------------------------------------- deprecatedSchema :: S.HasDescription doc (Maybe Text) => Text -> ValueSchema doc a -> ValueSchema doc a diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs index e19c3b6732..a9eebfde1f 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs @@ -72,5 +72,5 @@ testObject_ConversationUpdate2 = cuConvId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), cuAlreadyPresentUsers = [chad, dee], - cuAction = SomeConversationAction (sing @'ConversationLeaveTag) (pure qAlice) + cuAction = SomeConversationAction (sing @'ConversationLeaveTag) () } diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json index 21f5d72822..8b443934be 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json @@ -1,13 +1,6 @@ { "cuAction": { - "action": { - "users": [ - { - "domain": "golden.example.com", - "id": "00000000-0000-0000-0000-000100004007" - } - ] - }, + "action": {}, "tag": "ConversationLeaveTag" }, "cuAlreadyPresentUsers": [ diff --git a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json index d35a577690..e95ce811b4 100644 --- a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json +++ b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json @@ -1,49 +1,49 @@ { "Right": { - "failed_to_send": { + "deleted": { "golden.example.com": { - "00000000-0000-0000-0000-000200000008": [ - "0" - ], - "00000000-0000-0000-0000-000100000007": [ + "00000000-0000-0000-0000-000100000005": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000006": [ + "0" ] } }, - "redundant": { + "failed_to_send": { "golden.example.com": { - "00000000-0000-0000-0000-000100000003": [ + "00000000-0000-0000-0000-000100000007": [ "0", "1" ], - "00000000-0000-0000-0000-000200000004": [ + "00000000-0000-0000-0000-000200000008": [ "0" ] } }, - "time": "1864-04-12T12:22:43.673Z", "missing": { "golden.example.com": { - "00000000-0000-0000-0000-000200000000": [ - "0" - ], "00000000-0000-0000-0000-000100000002": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000000": [ + "0" ] } }, - "deleted": { + "redundant": { "golden.example.com": { - "00000000-0000-0000-0000-000100000005": [ + "00000000-0000-0000-0000-000100000003": [ "0", "1" ], - "00000000-0000-0000-0000-000200000006": [ + "00000000-0000-0000-0000-000200000004": [ "0" ] } - } + }, + "time": "1864-04-12T12:22:43.673Z" } } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json index 21fb6f1f90..7080dfa8c3 100644 --- a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json +++ b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json @@ -1,52 +1,52 @@ { "Left": { - "tag": "MessageNotSentClientMissing", "contents": { - "failed_to_send": { + "deleted": { "golden.example.com": { - "00000000-0000-0000-0000-000200000008": [ - "0" - ], - "00000000-0000-0000-0000-000100000007": [ + "00000000-0000-0000-0000-000100000005": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000006": [ + "0" ] } }, - "redundant": { + "failed_to_send": { "golden.example.com": { - "00000000-0000-0000-0000-000100000003": [ + "00000000-0000-0000-0000-000100000007": [ "0", "1" ], - "00000000-0000-0000-0000-000200000004": [ + "00000000-0000-0000-0000-000200000008": [ "0" ] } }, - "time": "1864-04-12T12:22:43.673Z", "missing": { "golden.example.com": { - "00000000-0000-0000-0000-000200000000": [ - "0" - ], "00000000-0000-0000-0000-000100000002": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000000": [ + "0" ] } }, - "deleted": { + "redundant": { "golden.example.com": { - "00000000-0000-0000-0000-000100000005": [ + "00000000-0000-0000-0000-000100000003": [ "0", "1" ], - "00000000-0000-0000-0000-000200000006": [ + "00000000-0000-0000-0000-000200000004": [ "0" ] } - } - } + }, + "time": "1864-04-12T12:22:43.673Z" + }, + "tag": "MessageNotSentClientMissing" } } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json index cebe1dfa47..0657122cdb 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json @@ -1,5 +1,5 @@ { - "to": "1669240c-c510-43e0-bf1a-33378fa4ba55", + "action": "RemoteConnect", "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", - "action": "RemoteConnect" + "to": "1669240c-c510-43e0-bf1a-33378fa4ba55" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json index 4610970610..32f52b7f30 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json @@ -1,5 +1,5 @@ { - "to": "1669240c-c510-43e0-bf1a-33378fa4ba55", + "action": "RemoteRescind", "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", - "action": "RemoteRescind" + "to": "1669240c-c510-43e0-bf1a-33378fa4ba55" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json index 61c94bf0db..8742918c4b 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json @@ -1,4 +1,4 @@ { - "tag": "NewConnectionResponseOk", - "contents": null + "contents": null, + "tag": "NewConnectionResponseOk" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json index 84fa71d736..d9f4636ea3 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json @@ -1,4 +1,4 @@ { - "tag": "NewConnectionResponseOk", - "contents": "RemoteConnect" + "contents": "RemoteConnect", + "tag": "NewConnectionResponseOk" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json index aeee3a6db9..d520e8340e 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json @@ -1,4 +1,4 @@ { - "tag": "NewConnectionResponseOk", - "contents": "RemoteRescind" + "contents": "RemoteRescind", + "tag": "NewConnectionResponseOk" } \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index bd0700a521..2d92ec4365 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -53,7 +53,7 @@ import Wire.Arbitrary (Arbitrary (..)) -- individual effects per conversation action. See 'HasConversationActionEffects'. type family ConversationAction (tag :: ConversationActionTag) :: * where ConversationAction 'ConversationJoinTag = ConversationJoin - ConversationAction 'ConversationLeaveTag = NonEmptyList.NonEmpty (Qualified UserId) + ConversationAction 'ConversationLeaveTag = () ConversationAction 'ConversationMemberUpdateTag = ConversationMemberUpdate ConversationAction 'ConversationDeleteTag = () ConversationAction 'ConversationRenameTag = ConversationRename @@ -87,7 +87,7 @@ conversationActionSchema SConversationLeaveTag = objectWithDocModifier "ConversationLeave" (S.description ?~ "The action of some users leaving a conversation on their own") - $ field "users" (nonEmptyArray schema) + $ pure () conversationActionSchema SConversationRemoveMembersTag = objectWithDocModifier "ConversationRemoveMembers" @@ -151,7 +151,7 @@ conversationActionToEvent tag now quid qcnv action = let ConversationJoin newMembers role = action in EdMembersJoin $ SimpleMembers (map (`SimpleMember` role) (toList newMembers)) SConversationLeaveTag -> - EdMembersLeave (QualifiedUserIdList (toList action)) + EdMembersLeave (QualifiedUserIdList [quid]) SConversationRemoveMembersTag -> EdMembersLeave (QualifiedUserIdList (toList action)) SConversationMemberUpdateTag -> diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs index 718caa3071..492a2ef68b 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -78,7 +78,7 @@ protocolTag (ProtocolMLS _) = ProtocolMLSTag protocolValidAction :: Protocol -> ConversationActionTag -> Bool protocolValidAction ProtocolProteus _ = True protocolValidAction (ProtocolMLS _) ConversationJoinTag = False -protocolValidAction (ProtocolMLS _) ConversationLeaveTag = False +protocolValidAction (ProtocolMLS _) ConversationLeaveTag = True protocolValidAction (ProtocolMLS _) ConversationRemoveMembersTag = False protocolValidAction (ProtocolMLS _) ConversationDeleteTag = False protocolValidAction (ProtocolMLS _) _ = True diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 080bd924a0..7596051650 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -59,7 +59,7 @@ import Data.List1 (List1) import qualified Data.List1 as List1 import Data.Misc (PlainTextPassword (..)) import Data.Proxy -import Data.Qualified +import Data.Qualified hiding (isLocal) import Data.Range import qualified Data.Sequence as Seq import Data.String.Conversions (cs) diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 7beab6843a..be5ca7e843 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -34,6 +34,9 @@ library Galley.API.MLS.KeyPackage Galley.API.MLS.Keys Galley.API.MLS.Message + Galley.API.MLS.Propagate + Galley.API.MLS.Removal + Galley.API.MLS.Types Galley.API.MLS.Welcome Galley.API.One2One Galley.API.Public @@ -665,6 +668,7 @@ executable galley-schema V70_MLSCipherSuite V71_MemberClientKeypackage V72_DropManagedConversations + V73_MemberClientTable hs-source-dirs: schema/src default-extensions: diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 13e3401d5f..ce3af1f4ce 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -75,6 +75,7 @@ import qualified V69_MLSProposal import qualified V70_MLSCipherSuite import qualified V71_MemberClientKeypackage import qualified V72_DropManagedConversations +import qualified V73_MemberClientTable main :: IO () main = do @@ -135,7 +136,8 @@ main = do V69_MLSProposal.migration, V70_MLSCipherSuite.migration, V71_MemberClientKeypackage.migration, - V72_DropManagedConversations.migration + V72_DropManagedConversations.migration, + V73_MemberClientTable.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/V73_MemberClientTable.hs b/services/galley/schema/src/V73_MemberClientTable.hs new file mode 100644 index 0000000000..15f642018b --- /dev/null +++ b/services/galley/schema/src/V73_MemberClientTable.hs @@ -0,0 +1,49 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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 V73_MemberClientTable where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 73 "Move mls_clients_keypackages to its own table" $ do + schema' + [r| + CREATE TABLE member_client ( + conv uuid, + user_domain text, + user uuid, + client text, + key_package_ref blob, + PRIMARY KEY (conv, user_domain, user, client) + ); + |] + schema' + [r| + ALTER TABLE member DROP ( + mls_clients_keypackages + ); + |] + schema' + [r| + ALTER TABLE member_remote_user DROP ( + mls_clients_keypackages + ); + |] diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index d3201e1c5e..d7e3ad707e 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -51,7 +51,9 @@ import qualified Data.Set as Set import Data.Singletons import Data.Time.Clock import Galley.API.Error +import Galley.API.MLS.Removal import Galley.API.Util +import Galley.App import Galley.Data.Conversation import qualified Galley.Data.Conversation as Data import Galley.Data.Services @@ -64,6 +66,7 @@ import qualified Galley.Effects.ConversationStore as E import qualified Galley.Effects.FederatorAccess as E import qualified Galley.Effects.FireAndForget as E import qualified Galley.Effects.MemberStore as E +import Galley.Effects.ProposalStore import qualified Galley.Effects.TeamStore as E import Galley.Options import Galley.Types.Conversations.Members @@ -73,6 +76,7 @@ import Imports import Polysemy import Polysemy.Error import Polysemy.Input +import Polysemy.TinyLog import qualified Polysemy.TinyLog as P import qualified System.Logger as Log import Wire.API.Conversation hiding (Conversation, Member) @@ -96,6 +100,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Members '[ BrigAccess, Error FederationError, + Error InternalError, ErrorS 'NotATeamMember, ErrorS 'NotConnected, ErrorS ('ActionDenied 'LeaveConversation), @@ -108,17 +113,33 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, + ProposalStore, TeamStore, + TinyLog, ConversationStore, Error NoChanges ] r HasConversationActionEffects 'ConversationLeaveTag r = - (Members '[MemberStore, Error NoChanges] r) + ( Members + '[ MemberStore, + Error InternalError, + Error NoChanges, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Input UTCTime, + Input Env, + ProposalStore, + TinyLog + ] + r + ) HasConversationActionEffects 'ConversationRemoveMembersTag r = (Members '[MemberStore, Error NoChanges] r) HasConversationActionEffects 'ConversationMemberUpdateTag r = @@ -132,6 +153,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con '[ BotAccess, BrigAccess, CodeStore, + Error InternalError, Error InvalidInput, Error NoChanges, ErrorS 'InvalidTargetAccess, @@ -140,8 +162,11 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con FederatorAccess, FireAndForget, GundeckAccess, + Input Env, MemberStore, + ProposalStore, TeamStore, + TinyLog, Input UTCTime, ConversationStore ] @@ -264,10 +289,28 @@ performAction tag origUser lconv action = do SConversationJoinTag -> do performConversationJoin origUser lconv action SConversationLeaveTag -> do - let presentVictims = filter (isConvMemberL lconv) (toList action) - when (null presentVictims) noChanges - E.deleteMembers (tUnqualified lcnv) (toUserList lconv presentVictims) - pure (mempty, action) -- FUTUREWORK: should we return the filtered action here? + let victims = [origUser] + E.deleteMembers (tUnqualified lcnv) (toUserList lconv victims) + -- update in-memory view of the conversation + let lconv' = + lconv <&> \c -> + foldQualified + lconv + ( \lu -> + c + { convLocalMembers = + filter (\lm -> lmId lm /= tUnqualified lu) (convLocalMembers c) + } + ) + ( \ru -> + c + { convRemoteMembers = + filter (\rm -> rmId rm /= ru) (convRemoteMembers c) + } + ) + origUser + traverse_ (removeUser lconv') victims + pure (mempty, action) SConversationRemoveMembersTag -> do let presentVictims = filter (isConvMemberL lconv) (toList action) when (null presentVictims) noChanges @@ -297,7 +340,7 @@ performAction tag origUser lconv action = do E.setConversationReceiptMode (tUnqualified lcnv) (cruReceiptMode action) pure (mempty, action) SConversationAccessDataTag -> do - (bm, act) <- performConversationAccessData origUser lconv action + (bm, act) <- performConversationAccessData lconv action pure (bm, act) performConversationJoin :: @@ -368,6 +411,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do checkLHPolicyConflictsLocal :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'InvalidOperation, ErrorS 'ConvNotFound, @@ -375,11 +419,14 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => [UserId] -> @@ -417,7 +464,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do (fmap convId lconv) (qUntagged lvictim) Nothing - $ pure (qUntagged lvictim) + () else throwS @'MissingLegalholdConsent checkLHPolicyConflictsRemote :: @@ -427,11 +474,10 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do performConversationAccessData :: (HasConversationActionEffects 'ConversationAccessDataTag r) => - Qualified UserId -> Local Conversation -> ConversationAccessData -> Sem r (BotsAndMembers, ConversationAccessData) -performConversationAccessData qusr lconv action = do +performConversationAccessData lconv action = do when (convAccessData conv == action) noChanges -- Remove conversation codes if CodeAccess is revoked when @@ -460,9 +506,17 @@ performConversationAccessData qusr lconv action = do let bmToNotify = current {bmBots = bmBots desired} -- Remove users and notify everyone - void . for_ (nonEmpty (bmQualifiedMembers lcnv toRemove)) $ \usersToRemove -> do - void . runError @NoChanges $ performAction SConversationLeaveTag qusr lconv usersToRemove - notifyConversationAction (sing @'ConversationLeaveTag) qusr Nothing lconv bmToNotify usersToRemove + for_ (bmQualifiedMembers lcnv toRemove) $ \userToRemove -> do + (extraTargets, action') <- performAction SConversationLeaveTag userToRemove lconv () + notifyConversationAction + (sing @'ConversationLeaveTag) + userToRemove + True + Nothing + lconv + (bmToNotify <> extraTargets) + action' + pure (mempty, action) where lcnv = fmap convId lconv @@ -519,6 +573,7 @@ updateLocalConversation :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r, @@ -584,6 +639,7 @@ updateLocalConversationUnchecked lconv qusr con action = do notifyConversationAction (sing @tag) qusr + False con lconv (convBotsAndMembers conv <> extraTargets) @@ -638,12 +694,13 @@ notifyConversationAction :: Members '[FederatorAccess, ExternalAccess, GundeckAccess, Input UTCTime] r => Sing tag -> Qualified UserId -> + Bool -> Maybe ConnId -> Local Conversation -> BotsAndMembers -> ConversationAction (tag :: ConversationActionTag) -> Sem r LocalConversationUpdate -notifyConversationAction tag quid con lconv targets action = do +notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do now <- input let lcnv = fmap convId lconv conv = tUnqualified lconv @@ -675,12 +732,12 @@ notifyConversationAction tag quid con lconv targets action = do . E.runFederatedConcurrently (toList (bmRemotes targets)) $ \ruids -> do let update = mkUpdate (tUnqualified ruids) - -- filter out user from quid's domain, because quid's backend will update - -- local state and notify its users itself using the ConversationUpdate - -- returned by this function - if tDomain ruids == qDomain quid - then pure (Just update) - else fedClient @'Galley @"on-conversation-updated" update $> Nothing + -- if notifyOrigDomain is false, filter out user from quid's domain, + -- because quid's backend will update local state and notify its users + -- itself using the ConversationUpdate returned by this function + if notifyOrigDomain || tDomain ruids /= qDomain quid + then fedClient @'Galley @"on-conversation-updated" update $> Nothing + else pure (Just update) -- notify local participants and bots pushConversationEvent con e (qualifyAs lcnv (bmLocals targets)) (bmBots targets) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 2aa7f3a092..fc70eafd35 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -40,6 +40,7 @@ import Galley.API.Action import Galley.API.Error import Galley.API.MLS.KeyPackage import Galley.API.MLS.Message +import Galley.API.MLS.Removal import Galley.API.MLS.Welcome import qualified Galley.API.Mapping as Mapping import Galley.API.Message @@ -227,8 +228,8 @@ onConversationUpdated requestingDomain cu = do [] -> pure (Nothing, []) -- If no users get added, its like no action was performed. (u : us) -> pure (Just (SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (u :| us) role)), addedLocalUsers) SConversationLeaveTag -> do - let localUsers = getLocalUsers (tDomain loc) action - E.deleteMembersInRemoteConversation rconvId localUsers + let users = foldQualified loc (pure . tUnqualified) (const []) (F.cuOrigUserId cu) + E.deleteMembersInRemoteConversation rconvId users pure (Just sca, []) SConversationRemoveMembersTag -> do let localUsers = getLocalUsers (tDomain loc) action @@ -291,13 +292,17 @@ addLocalUsersToRemoteConv remoteConvId qAdder localUsers = do leaveConversation :: Members '[ ConversationStore, + Error InternalError, Error InvalidInput, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input (Local ()), Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Domain -> @@ -322,24 +327,23 @@ leaveConversation requestingDomain lc = do lcnv (qUntagged leaver) Nothing - (pure (qUntagged leaver)) + () pure (update, conv) case res of Left e -> pure $ F.LeaveConversationResponse (Left e) Right (_update, conv) -> do - let action = pure (qUntagged leaver) - let remotes = filter ((== tDomain leaver) . tDomain) (rmId <$> Data.convRemoteMembers conv) let botsAndMembers = BotsAndMembers mempty (Set.fromList remotes) mempty _ <- notifyConversationAction SConversationLeaveTag (qUntagged leaver) + False Nothing (qualifyAs lcnv conv) botsAndMembers - action + () pure $ F.LeaveConversationResponse (Right ()) @@ -457,17 +461,17 @@ onUserDeleted origDomain udcn = do -- The self conv cannot be on a remote backend. Public.SelfConv -> pure () Public.RegularConv -> do - let action = pure untaggedDeletedUser - botsAndMembers = convBotsAndMembers conv - mlsRemoveUser conv (qUntagged deletedUser) + let botsAndMembers = convBotsAndMembers conv + removeUser (qualifyAs lc conv) (qUntagged deletedUser) void $ notifyConversationAction (sing @'ConversationLeaveTag) untaggedDeletedUser + False Nothing (qualifyAs lc conv) botsAndMembers - action + () pure EmptyResponse updateConversation :: @@ -483,11 +487,14 @@ updateConversation :: FederatorAccess, Error InternalError, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, + ProposalStore, TeamStore, + TinyLog, ConversationStore, Input (Local ()) ] @@ -563,6 +570,7 @@ sendMLSMessage :: FederatorAccess, GundeckAccess, Input (Local ()), + Input Env, Input Opts, Input UTCTime, LegalHoldStore, diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 120845565a..28c19f80d3 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -40,7 +40,7 @@ import qualified Galley.API.CustomBackend as CustomBackend import Galley.API.Error import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts -import Galley.API.MLS.Message (mlsRemoveUser) +import Galley.API.MLS.Removal import Galley.API.One2One import Galley.API.Public import Galley.API.Public.Servant @@ -684,7 +684,7 @@ rmUser lusr conn = do ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing RegularConv | tUnqualified lusr `isMember` Data.convLocalMembers c -> do - runError (mlsRemoveUser c (qUntagged lusr)) >>= \case + runError (removeUser (qualifyAs lusr c) (qUntagged lusr)) >>= \case Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) Right _ -> pure () deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) @@ -717,7 +717,7 @@ rmUser lusr conn = do cuOrigUserId = qUser, cuConvId = cid, cuAlreadyPresentUsers = tUnqualified remotes, - cuAction = SomeConversationAction (sing @'ConversationLeaveTag) (pure qUser) + cuAction = SomeConversationAction (sing @'ConversationLeaveTag) () } let rpc = fedClient @'Galley @"on-conversation-updated" convUpdate runFederatedEither remotes rpc diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 302ef62ad5..71288e7af5 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -48,11 +48,13 @@ import Galley.API.Error import Galley.API.Query (iterateConversations) import Galley.API.Update (removeMemberFromLocalConv) import Galley.API.Util +import Galley.App import qualified Galley.Data.Conversation as Data import Galley.Effects import Galley.Effects.BrigAccess import Galley.Effects.FireAndForget import qualified Galley.Effects.LegalHoldStore as LegalHoldData +import Galley.Effects.ProposalStore import qualified Galley.Effects.TeamFeatureStore as TeamFeatures import Galley.Effects.TeamMemberStore import Galley.Effects.TeamStore @@ -187,30 +189,32 @@ removeSettingsInternalPaging :: BrigAccess, CodeStore, ConversationStore, - Error InternalError, Error AuthenticationError, - ErrorS OperationDenied, - ErrorS 'NotATeamMember, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'InvalidOperation, - ErrorS 'LegalHoldNotEnabled, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'LegalHoldDisableUnimplemented, + ErrorS 'LegalHoldNotEnabled, ErrorS 'LegalHoldServiceNotRegistered, + ErrorS 'NotATeamMember, + ErrorS OperationDenied, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, ExternalAccess, FederatorAccess, FireAndForget, GundeckAccess, - Input UTCTime, + Input Env, Input (Local ()), + Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, TeamMemberStore InternalPaging, TeamStore, - P.TinyLog, WaiRoutes ] r => @@ -230,30 +234,32 @@ removeSettings :: BrigAccess, CodeStore, ConversationStore, - Error InternalError, Error AuthenticationError, - ErrorS 'NotATeamMember, - ErrorS OperationDenied, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'InvalidOperation, - ErrorS 'LegalHoldNotEnabled, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'LegalHoldDisableUnimplemented, + ErrorS 'LegalHoldNotEnabled, ErrorS 'LegalHoldServiceNotRegistered, + ErrorS 'NotATeamMember, + ErrorS OperationDenied, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, ExternalAccess, FederatorAccess, FireAndForget, GundeckAccess, - Input UTCTime, + Input Env, Input (Local ()), + Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, TeamMemberStore p, - TeamStore, - P.TinyLog + TeamStore ] r ) => @@ -305,11 +311,13 @@ removeSettings' :: GundeckAccess, Input UTCTime, Input (Local ()), + Input Env, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, TeamMemberStore p, TeamStore, + ProposalStore, P.TinyLog ] r @@ -386,18 +394,20 @@ grantConsent :: Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'InvalidOperation, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'TeamMemberNotFound, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, - TeamStore, - P.TinyLog + ProposalStore, + P.TinyLog, + TeamStore ] r => Local UserId -> @@ -422,27 +432,29 @@ requestDevice :: ConversationStore, Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), + ErrorS 'LegalHoldCouldNotBlockConnections, + ErrorS 'LegalHoldNotEnabled, + ErrorS 'LegalHoldServiceBadResponse, + ErrorS 'LegalHoldServiceNotRegistered, ErrorS 'NotATeamMember, + ErrorS 'NoUserLegalHoldConsent, ErrorS OperationDenied, ErrorS 'TeamMemberNotFound, - ErrorS 'LegalHoldNotEnabled, ErrorS 'UserLegalHoldAlreadyEnabled, - ErrorS 'NoUserLegalHoldConsent, - ErrorS 'LegalHoldServiceBadResponse, - ErrorS 'LegalHoldServiceNotRegistered, - ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'UserLegalHoldIllegalOperation, - Input (Local ()), ExternalAccess, FederatorAccess, GundeckAccess, + Input (Local ()), + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, - TeamStore, - P.TinyLog + TeamStore ] r => TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => @@ -498,29 +510,31 @@ approveDevice :: Members '[ BrigAccess, ConversationStore, - Error InternalError, Error AuthenticationError, + Error InternalError, ErrorS 'AccessDenied, ErrorS ('ActionDenied 'RemoveConversationMember), - ErrorS 'NotATeamMember, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'LegalHoldNotEnabled, - ErrorS 'UserLegalHoldNotPending, - ErrorS 'NoLegalHoldDeviceAllocated, ErrorS 'LegalHoldServiceNotRegistered, + ErrorS 'NoLegalHoldDeviceAllocated, + ErrorS 'NotATeamMember, ErrorS 'UserLegalHoldAlreadyEnabled, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, - Input (Local ()), + ErrorS 'UserLegalHoldNotPending, ExternalAccess, FederatorAccess, GundeckAccess, + Input (Local ()), + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, - TeamStore, - P.TinyLog + TeamStore ] r => TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => @@ -577,24 +591,26 @@ disableForUser :: Members '[ BrigAccess, ConversationStore, - Error InternalError, Error AuthenticationError, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), + ErrorS 'LegalHoldCouldNotBlockConnections, + ErrorS 'LegalHoldServiceNotRegistered, ErrorS 'NotATeamMember, ErrorS OperationDenied, - ErrorS 'LegalHoldServiceNotRegistered, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, - Input (Local ()), ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, + Input (Local ()), Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, - TeamStore, - P.TinyLog + ProposalStore, + P.TinyLog, + TeamStore ] r => Local UserId -> @@ -640,11 +656,13 @@ changeLegalholdStatus :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, TeamStore, + ProposalStore, P.TinyLog ] r => @@ -755,9 +773,12 @@ handleGroupConvPolicyConflicts :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamStore ] r => diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 2ace16c5d3..555dff1a11 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -20,15 +20,12 @@ module Galley.API.MLS.Message ( postMLSMessageFromLocalUser, postMLSMessageFromLocalUserV1, postMLSMessage, - mlsRemoveUser, MLSMessageStaticErrors, ) where import Control.Comonad -import Control.Lens (preview, to, view) -import Data.Bifunctor -import Data.Domain +import Control.Lens (preview, to) import Data.Id import Data.Json.Util import Data.List.NonEmpty (NonEmpty, nonEmpty) @@ -40,11 +37,11 @@ import Data.Time import Galley.API.Action import Galley.API.Error import Galley.API.MLS.KeyPackage -import Galley.API.Push +import Galley.API.MLS.Propagate +import Galley.API.MLS.Types import Galley.API.Util import Galley.Data.Conversation.Types hiding (Conversation) import qualified Galley.Data.Conversation.Types as Data -import Galley.Data.Services import Galley.Data.Types import Galley.Effects import Galley.Effects.BrigAccess @@ -56,14 +53,12 @@ import Galley.Env import Galley.Options import Galley.Types.Conversations.Members import Imports -import Network.Wai.Utilities.Server import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.Internal import Polysemy.Resource (Resource, bracket) import Polysemy.TinyLog -import qualified System.Logger.Class as Logger import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role @@ -78,7 +73,6 @@ import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage -import Wire.API.MLS.Keys import Wire.API.MLS.Message import Wire.API.MLS.Proposal import qualified Wire.API.MLS.Proposal as Proposal @@ -279,11 +273,15 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of isMember' <- foldQualified loc (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr unless isMember' $ throwS @'ConvNotFound + -- construct client map + cm <- lookupMLSClients lcnv + let lconv = qualifyAs lcnv conv + -- validate message events <- case tag of SMLSPlainText -> case msgPayload msg of CommitMessage c -> - processCommit qusr senderClient con (qualifyAs lcnv conv) (msgEpoch msg) (msgSender msg) c + processCommit qusr senderClient con lconv cm (msgEpoch msg) (msgSender msg) c ApplicationMessage _ -> throwS @'MLSUnsupportedMessage ProposalMessage prop -> processProposal qusr conv msg prop $> mempty @@ -294,7 +292,7 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of Left _ -> throwS @'MLSUnsupportedMessage -- forward message - propagateMessage lcnv qusr conv con (rmRaw smsg) + propagateMessage qusr lconv cm con (rmRaw smsg) pure events @@ -337,24 +335,27 @@ postMLSMessageToRemoteConv loc qusr _senderClient con smsg rcnv = do type HasProposalEffects r = ( Member BrigAccess r, Member ConversationStore r, + Member (Error InternalError) r, Member (Error MLSProposalFailure) r, Member (Error MLSProtocolError) r, - Member (ErrorS 'MLSKeyPackageRefNotFound) r, Member (ErrorS 'MLSClientMismatch) r, + Member (ErrorS 'MLSKeyPackageRefNotFound) r, Member (ErrorS 'MLSUnsupportedProposal) r, Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, + Member (Input Env) r, + Member (Input (Local ())) r, Member (Input Opts) r, Member (Input UTCTime) r, Member LegalHoldStore r, Member MemberStore r, + Member ProposalStore r, + Member TeamStore r, Member TeamStore r, - Member (Input (Local ())) r + Member TinyLog r ) -type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef)) - data ProposalAction = ProposalAction { paAdd :: ClientMap, paRemove :: ClientMap @@ -394,11 +395,12 @@ processCommit :: Maybe ClientId -> Maybe ConnId -> Local Data.Conversation -> + ClientMap -> Epoch -> Sender 'MLSPlainText -> Commit -> Sem r [LocalConversationUpdate] -processCommit qusr senderClient con lconv epoch sender commit = do +processCommit qusr senderClient con lconv cm epoch sender commit = do self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr -- check epoch number @@ -419,23 +421,24 @@ processCommit qusr senderClient con lconv epoch sender commit = do then do -- this is a newly created conversation, and it should contain exactly one -- client (the creator) - case (sender, first (fmap fst . toList . lmMLSClients) self) of - (MemberSender currentRef, Left [creatorClient]) -> do - -- use update path as sender reference and if not existing fall back to sender - senderRef <- - maybe - (pure currentRef) - ( note (mlsProtocolError "Could not compute key package ref") - . kpRef' - . upLeaf - ) - $ cPath commit - -- register the creator client - updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef + case (sender, self, cmAssocs cm) of + (MemberSender currentRef, Left lm, [(qu, (creatorClient, _))]) + | qu == qUntagged (qualifyAs lconv (lmId lm)) -> do + -- use update path as sender reference and if not existing fall back to sender + senderRef <- + maybe + (pure currentRef) + ( note (mlsProtocolError "Could not compute key package ref") + . kpRef' + . upLeaf + ) + $ cPath commit + -- register the creator client + updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef -- remote clients cannot send the first commit - (_, Right _) -> throwS @'MLSStaleMessage + (_, Right _, _) -> throwS @'MLSStaleMessage -- uninitialised conversations should contain exactly one client - (MemberSender _, _) -> + (MemberSender _, _, _) -> throw (InternalErrorWithDescription "Unexpected creator client set") -- the sender of the first commit must be a member _ -> throw (mlsProtocolError "Unexpected sender") @@ -458,7 +461,7 @@ processCommit qusr senderClient con lconv epoch sender commit = do -- process and execute proposals action <- foldMap (applyProposalRef (tUnqualified lconv) groupId epoch) (cProposals commit) - updates <- executeProposalAction qusr con lconv action + updates <- executeProposalAction qusr con lconv cm action -- update key package ref if necessary postponedKeyPackageRefUpdate @@ -490,8 +493,7 @@ updateKeyPackageMapping lconv qusr cid mOld new = do } -- remove old (client, key package) pair - let old = fromMaybe nullKeyPackageRef mOld - removeMLSClients lcnv qusr (Set.singleton (cid, old)) + removeMLSClients lcnv qusr (Set.singleton cid) -- add new (client, key package) pair addMLSClients lcnv qusr (Set.singleton (cid, new)) @@ -692,6 +694,7 @@ executeProposalAction :: forall r. ( Member BrigAccess r, Member ConversationStore r, + Member (Error InternalError) r, Member (ErrorS 'ConvNotFound) r, Member (Error FederationError) r, Member (ErrorS 'MLSClientMismatch) r, @@ -703,21 +706,24 @@ executeProposalAction :: Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, + Member (Input Env) r, Member (Input Opts) r, Member (Input UTCTime) r, Member LegalHoldStore r, Member MemberStore r, - Member TeamStore r + Member ProposalStore r, + Member TeamStore r, + Member TinyLog r ) => Qualified UserId -> Maybe ConnId -> Local Data.Conversation -> + ClientMap -> ProposalAction -> Sem r [LocalConversationUpdate] -executeProposalAction qusr con lconv action = do +executeProposalAction qusr con lconv cm action = do cs <- preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) (tUnqualified lconv) & noteS @'ConvNotFound let ss = csSignatureScheme cs - cm = convClientMap lconv newUserClients = Map.assocs (paAdd action) removeUserClients = Map.assocs (paRemove action) @@ -768,7 +774,7 @@ executeProposalAction qusr con lconv action = do -- remove clients in the conversation state for_ removeUserClients $ \(qtarget, clients) -> do - removeMLSClients (fmap convId lconv) qtarget clients + removeMLSClients (fmap convId lconv) qtarget (Set.map fst clients) pure (addEvents <> removeEvents) where @@ -808,96 +814,34 @@ executeProposalAction qusr con lconv action = do con $ ConversationJoin users roleNameWireMember + existingLocalMembers :: Set (Qualified UserId) + existingLocalMembers = + Set.fromList . map (fmap lmId . qUntagged) . sequenceA $ + fmap convLocalMembers lconv + + existingRemoteMembers :: Set (Qualified UserId) + existingRemoteMembers = + Set.fromList . map (qUntagged . rmId) . convRemoteMembers . tUnqualified $ + lconv + + existingMembers :: Set (Qualified UserId) + existingMembers = existingLocalMembers <> existingRemoteMembers + removeMembers :: NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate] removeMembers = - handleNoChanges - . handleMLSProposalFailures @ProposalErrors - . fmap pure - . updateLocalConversationUnchecked - @'ConversationRemoveMembersTag - lconv - qusr - con + foldMap + ( handleNoChanges + . handleMLSProposalFailures @ProposalErrors + . fmap pure + . updateLocalConversationUnchecked @'ConversationRemoveMembersTag lconv qusr con + ) + . nonEmpty + . filter (flip Set.member existingMembers) + . toList handleNoChanges :: Monoid a => Sem (Error NoChanges ': r) a -> Sem r a handleNoChanges = fmap fold . runError -convClientMap :: Local Data.Conversation -> ClientMap -convClientMap lconv = - mconcat - [ foldMap localMember . convLocalMembers, - foldMap remoteMember . convRemoteMembers - ] - (tUnqualified lconv) - where - localMember lm = Map.singleton (qUntagged (qualifyAs lconv (lmId lm))) (lmMLSClients lm) - remoteMember rm = Map.singleton (qUntagged (rmId rm)) (rmMLSClients rm) - --- | Propagate a message. -propagateMessage :: - ( Member ExternalAccess r, - Member FederatorAccess r, - Member GundeckAccess r, - Member (Input UTCTime) r, - Member TinyLog r - ) => - Local x -> - Qualified UserId -> - Data.Conversation -> - Maybe ConnId -> - ByteString -> - Sem r () -propagateMessage loc qusr conv con raw = do - -- FUTUREWORK: check the epoch - let lmems = Data.convLocalMembers conv - botMap = Map.fromList $ do - m <- lmems - b <- maybeToList $ newBotMember m - pure (lmId m, b) - mm = defMessageMetadata - now <- input @UTCTime - let lcnv = qualifyAs loc (Data.convId conv) - qcnv = qUntagged lcnv - e = Event qcnv qusr now $ EdMLSMessage raw - lclients = tUnqualified . clients <$> lmems - mkPush :: UserId -> ClientId -> MessagePush 'NormalMessage - mkPush u c = newMessagePush lcnv botMap con mm (u, c) e - runMessagePush loc (Just qcnv) $ - foldMap (uncurry mkPush) (cToList =<< lclients) - - -- send to remotes - traverse_ handleError <=< runFederatedConcurrentlyEither (map remoteMemberQualify (Data.convRemoteMembers conv)) $ - \(tUnqualified -> rs) -> - fedClient @'Galley @"on-mls-message-sent" $ - RemoteMLSMessage - { rmmTime = now, - rmmSender = qusr, - rmmMetadata = mm, - rmmConversation = tUnqualified lcnv, - rmmRecipients = rs >>= remoteMemberMLSClients, - rmmMessage = Base64ByteString raw - } - where - cToList :: (UserId, Set ClientId) -> [(UserId, ClientId)] - cToList (u, s) = (u,) <$> Set.toList s - - clients :: LocalMember -> Local (UserId, Set ClientId) - clients LocalMember {..} = qualifyAs loc (lmId, Set.map fst lmMLSClients) - - remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)] - remoteMemberMLSClients rm = - map - (tUnqualified (rmId rm),) - (toList (Set.map fst (rmMLSClients rm))) - - handleError :: Member TinyLog r => Either (Remote [a], FederationError) x -> Sem r () - handleError (Right _) = pure () - handleError (Left (r, e)) = - warn $ - Logger.msg ("A message could not be delivered to a remote backend" :: ByteString) - . Logger.field "remote_domain" (domainText (tDomain r)) - . logErrorMsg (toWai e) - getMLSClients :: Members '[BrigAccess, FederatorAccess] r => Local x -> @@ -1011,39 +955,3 @@ withCommitLock gid epoch ttl action = ) (const $ releaseCommitLock gid epoch) (const action) - -mlsRemoveUser :: - ( Members - '[ Input UTCTime, - TinyLog, - ExternalAccess, - FederatorAccess, - GundeckAccess, - Error InternalError, - ProposalStore, - Input Env, - Input (Local ()) - ] - r - ) => - Data.Conversation -> - Qualified UserId -> - Sem r () -mlsRemoveUser c qusr = do - loc <- qualifyLocal () - case Data.convProtocol c of - ProtocolProteus -> pure () - ProtocolMLS meta -> do - keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose) - (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair - for_ (getConvMemberMLSClients loc c qusr) $ \cpks -> - for_ cpks $ \(_client, kpref) -> do - let proposal = mkRemoveProposal kpref - msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal) - msgEncoded = encodeMLS' msg - storeProposal - (cnvmlsGroupId meta) - (cnvmlsEpoch meta) - (proposalRef (cnvmlsCipherSuite meta) proposal) - proposal - propagateMessage loc qusr c Nothing msgEncoded diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs new file mode 100644 index 0000000000..6af4e1d61b --- /dev/null +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE RecordWildCards #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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 Galley.API.MLS.Propagate where + +import Control.Comonad +import Data.Domain +import Data.Id +import Data.Json.Util +import qualified Data.Map as Map +import Data.Qualified +import Data.Time +import Galley.API.MLS.Types +import Galley.API.Push +import qualified Galley.Data.Conversation.Types as Data +import Galley.Data.Services +import Galley.Effects +import Galley.Effects.FederatorAccess +import Galley.Types.Conversations.Members +import Imports +import Network.Wai.Utilities.Server +import Polysemy +import Polysemy.Input +import Polysemy.TinyLog +import qualified System.Logger.Class as Logger +import Wire.API.Error +import Wire.API.Event.Conversation +import Wire.API.Federation.API +import Wire.API.Federation.API.Galley +import Wire.API.Federation.Error +import Wire.API.Message + +-- | Propagate a message. +propagateMessage :: + ( Member ExternalAccess r, + Member FederatorAccess r, + Member GundeckAccess r, + Member (Input UTCTime) r, + Member TinyLog r + ) => + Qualified UserId -> + Local Data.Conversation -> + ClientMap -> + Maybe ConnId -> + ByteString -> + Sem r () +propagateMessage qusr lconv cm con raw = do + -- FUTUREWORK: check the epoch + let lmems = Data.convLocalMembers . tUnqualified $ lconv + botMap = Map.fromList $ do + m <- lmems + b <- maybeToList $ newBotMember m + pure (lmId m, b) + mm = defMessageMetadata + now <- input @UTCTime + let lcnv = fmap Data.convId lconv + qcnv = qUntagged lcnv + e = Event qcnv qusr now $ EdMLSMessage raw + mkPush :: UserId -> ClientId -> MessagePush 'NormalMessage + mkPush u c = newMessagePush lcnv botMap con mm (u, c) e + runMessagePush lconv (Just qcnv) $ + foldMap (uncurry mkPush) (lmems >>= localMemberMLSClients lcnv) + + -- send to remotes + traverse_ handleError + <=< runFederatedConcurrentlyEither (map remoteMemberQualify (Data.convRemoteMembers . tUnqualified $ lconv)) + $ \(tUnqualified -> rs) -> + fedClient @'Galley @"on-mls-message-sent" $ + RemoteMLSMessage + { rmmTime = now, + rmmSender = qusr, + rmmMetadata = mm, + rmmConversation = tUnqualified lcnv, + rmmRecipients = rs >>= remoteMemberMLSClients, + rmmMessage = Base64ByteString raw + } + where + localMemberMLSClients :: Local x -> LocalMember -> [(UserId, ClientId)] + localMemberMLSClients loc lm = + let localUserQId = qUntagged (qualifyAs loc localUserId) + localUserId = lmId lm + in map + (\(c, _) -> (localUserId, c)) + (toList (Map.findWithDefault mempty localUserQId cm)) + + remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)] + remoteMemberMLSClients rm = + let remoteUserQId = qUntagged (rmId rm) + remoteUserId = qUnqualified remoteUserQId + in map + (\(c, _) -> (remoteUserId, c)) + (toList (Map.findWithDefault mempty remoteUserQId cm)) + + handleError :: Member TinyLog r => Either (Remote [a], FederationError) x -> Sem r () + handleError (Right _) = pure () + handleError (Left (r, e)) = + warn $ + Logger.msg ("A message could not be delivered to a remote backend" :: ByteString) + . Logger.field "remote_domain" (domainText (tDomain r)) + . logErrorMsg (toWai e) diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs new file mode 100644 index 0000000000..04b3c6f28f --- /dev/null +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -0,0 +1,103 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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 Galley.API.MLS.Removal + ( removeUserWithClientMap, + removeUser, + ) +where + +import Control.Comonad +import Control.Lens (view) +import Data.Id +import qualified Data.Map as Map +import Data.Qualified +import Data.Time +import Galley.API.Error +import Galley.API.MLS.Propagate +import Galley.API.MLS.Types +import qualified Galley.Data.Conversation.Types as Data +import Galley.Effects +import Galley.Effects.MemberStore +import Galley.Effects.ProposalStore +import Galley.Env +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.TinyLog +import Wire.API.Conversation.Protocol +import Wire.API.MLS.Credential +import Wire.API.MLS.Keys +import Wire.API.MLS.Message +import Wire.API.MLS.Proposal +import Wire.API.MLS.Serialisation + +removeUserWithClientMap :: + ( Members + '[ Input UTCTime, + TinyLog, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Error InternalError, + ProposalStore, + Input Env + ] + r + ) => + Local Data.Conversation -> + ClientMap -> + Qualified UserId -> + Sem r () +removeUserWithClientMap lc cm qusr = do + case Data.convProtocol (tUnqualified lc) of + ProtocolProteus -> pure () + ProtocolMLS meta -> do + keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose) + (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair + for_ (Map.findWithDefault mempty qusr cm) $ \(_client, kpref) -> do + let proposal = mkRemoveProposal kpref + msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal) + msgEncoded = encodeMLS' msg + storeProposal + (cnvmlsGroupId meta) + (cnvmlsEpoch meta) + (proposalRef (cnvmlsCipherSuite meta) proposal) + proposal + propagateMessage qusr lc cm Nothing msgEncoded + +removeUser :: + ( Members + '[ Error InternalError, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Input Env, + Input UTCTime, + MemberStore, + ProposalStore, + TinyLog + ] + r + ) => + Local Data.Conversation -> + Qualified UserId -> + Sem r () +removeUser lc qusr = do + cm <- lookupMLSClients (fmap Data.convId lc) + removeUserWithClientMap lc cm qusr diff --git a/services/galley/src/Galley/API/MLS/Types.hs b/services/galley/src/Galley/API/MLS/Types.hs new file mode 100644 index 0000000000..f9b6cefb8e --- /dev/null +++ b/services/galley/src/Galley/API/MLS/Types.hs @@ -0,0 +1,43 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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 Galley.API.MLS.Types + ( ClientMap, + mkClientMap, + cmAssocs, + ) +where + +import Data.Domain +import Data.Id +import qualified Data.Map as Map +import Data.Qualified +import qualified Data.Set as Set +import Imports +import Wire.API.MLS.KeyPackage + +type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef)) + +mkClientMap :: [(Domain, UserId, ClientId, KeyPackageRef)] -> ClientMap +mkClientMap = foldr addEntry mempty + where + addEntry :: (Domain, UserId, ClientId, KeyPackageRef) -> ClientMap -> ClientMap + addEntry (dom, usr, c, kpr) = + Map.insertWith (<>) (Qualified usr dom) (Set.singleton (c, kpr)) + +cmAssocs :: ClientMap -> [(Qualified UserId, (ClientId, KeyPackageRef))] +cmAssocs cm = Map.assocs cm >>= traverse toList diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs index 3481feb6f6..6e97ab8adc 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/services/galley/src/Galley/API/Mapping.hs @@ -27,7 +27,6 @@ where import Data.Domain (Domain) import Data.Id (UserId, idToText) import Data.Qualified -import qualified Data.Set as Set import Galley.API.Error import qualified Galley.Data.Conversation as Data import Galley.Data.Types (convId) @@ -95,8 +94,7 @@ remoteConversationView uid status (qUntagged -> Qualified rconv rDomain) = { lmId = tUnqualified uid, lmService = Nothing, lmStatus = status, - lmConvRoleName = rcmSelfRole mems, - lmMLSClients = Set.empty + lmConvRoleName = rcmSelfRole mems } in Conversation (Qualified (rcnvId rconv) rDomain) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 73ff6660d3..bff05ef910 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1061,6 +1061,7 @@ deleteTeamConversation :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, TeamStore ] diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 260781cec4..57c93ebcaa 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -52,10 +52,12 @@ import Galley.API.LegalHold (isLegalHoldEnabledForTeam) import qualified Galley.API.LegalHold as LegalHold import Galley.API.Teams (ensureNotTooLargeToActivateLegalHold) import Galley.API.Util (assertTeamExists, getTeamMembersForFanout, membersToRecipients, permissionCheck) +import Galley.App import Galley.Effects import Galley.Effects.BrigAccess (getAccountConferenceCallingConfigClient, updateSearchVisibilityInbound) import Galley.Effects.ConversationStore as ConversationStore import Galley.Effects.GundeckAccess +import Galley.Effects.ProposalStore import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData import Galley.Effects.TeamFeatureStore import qualified Galley.Effects.TeamFeatureStore as TeamFeatures @@ -726,10 +728,12 @@ instance SetFeatureConfig db LegalholdConfig where FireAndForget, GundeckAccess, Input (Local ()), + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, TeamFeatureStore db, TeamStore, TeamMemberStore InternalPaging, diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 4257c7b863..27b2d6c806 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -85,6 +85,7 @@ import Galley.API.Mapping import Galley.API.Message import qualified Galley.API.Query as Query import Galley.API.Util +import Galley.App import qualified Galley.Data.Conversation as Data import Galley.Data.Services as Data import Galley.Data.Types hiding (Conversation) @@ -96,6 +97,7 @@ import qualified Galley.Effects.ExternalAccess as E import qualified Galley.Effects.FederatorAccess as E import qualified Galley.Effects.GundeckAccess as E import qualified Galley.Effects.MemberStore as E +import Galley.Effects.ProposalStore import qualified Galley.Effects.ServiceStore as E import Galley.Effects.TeamFeatureStore (FeaturePersistentConstraint) import Galley.Effects.WaiRoutes @@ -265,20 +267,24 @@ type UpdateConversationAccessEffects = BrigAccess, CodeStore, ConversationStore, - ExternalAccess, - FederatorAccess, - FireAndForget, - GundeckAccess, - MemberStore, - TeamStore, - Error InvalidInput, Error FederationError, + Error InternalError, + Error InvalidInput, ErrorS ('ActionDenied 'ModifyConversationAccess), ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ErrorS 'InvalidTargetAccess, - Input UTCTime + ExternalAccess, + FederatorAccess, + FireAndForget, + GundeckAccess, + Input Env, + Input UTCTime, + MemberStore, + ProposalStore, + TeamStore, + TinyLog ] updateConversationAccess :: @@ -310,18 +316,19 @@ updateConversationAccessUnqualified lusr con cnv update = updateConversationReceiptMode :: Members - '[ Error FederationError, + '[ BrigAccess, + ConversationStore, + Error FederationError, ErrorS ('ActionDenied 'ModifyConversationReceiptMode), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, - BrigAccess, - ConversationStore, - MemberStore, - Input UTCTime, Input (Local ()), + Input Env, + Input UTCTime, + MemberStore, TinyLog ] r => @@ -385,7 +392,8 @@ updateRemoteConversation rcnv lusr conn action = getUpdateResult $ do updateConversationReceiptModeUnqualified :: Members - '[ ConversationStore, + '[ BrigAccess, + ConversationStore, Error FederationError, ErrorS ('ActionDenied 'ModifyConversationReceiptMode), ErrorS 'ConvNotFound, @@ -393,10 +401,10 @@ updateConversationReceiptModeUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, - BrigAccess, - MemberStore, - Input UTCTime, Input (Local ()), + Input Env, + Input UTCTime, + MemberStore, TinyLog ] r => @@ -417,6 +425,7 @@ updateConversationMessageTimer :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -451,6 +460,7 @@ updateConversationMessageTimerUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -473,6 +483,7 @@ deleteLocalConversation :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, TeamStore ] @@ -765,6 +776,7 @@ joinConversation lusr zcon conv access = do <$> notifyConversationAction (sing @'ConversationJoinTag) (qUntagged lusr) + False (Just zcon) (qualifyAs lusr conv) (convBotsAndMembers conv <> extraTargets) @@ -775,6 +787,7 @@ addMembers :: '[ BrigAccess, ConversationStore, Error FederationError, + Error InternalError, ErrorS ('ActionDenied 'AddConversationMember), ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'ConvAccessDenied, @@ -787,11 +800,14 @@ addMembers :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => Local UserId -> @@ -810,6 +826,7 @@ addMembersUnqualifiedV2 :: '[ BrigAccess, ConversationStore, Error FederationError, + Error InternalError, ErrorS ('ActionDenied 'AddConversationMember), ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'ConvAccessDenied, @@ -822,11 +839,14 @@ addMembersUnqualifiedV2 :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => Local UserId -> @@ -845,6 +865,7 @@ addMembersUnqualified :: '[ BrigAccess, ConversationStore, Error FederationError, + Error InternalError, ErrorS ('ActionDenied 'AddConversationMember), ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'ConvAccessDenied, @@ -857,11 +878,14 @@ addMembersUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => Local UserId -> @@ -952,6 +976,7 @@ updateOtherMemberLocalConv :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, MemberStore ] @@ -979,6 +1004,7 @@ updateOtherMemberUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, MemberStore ] @@ -1006,6 +1032,7 @@ updateOtherMember :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, MemberStore ] @@ -1033,14 +1060,18 @@ updateOtherMemberRemoteConv _ _ _ _ _ = throw FederationNotImplemented removeMemberUnqualified :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Local UserId -> @@ -1056,14 +1087,18 @@ removeMemberUnqualified lusr con cnv victim = do removeMemberQualified :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Local UserId -> @@ -1120,6 +1155,7 @@ removeMemberFromRemoteConv cnv lusr victim removeMemberFromLocalConv :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'LeaveConversation), ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, @@ -1127,8 +1163,11 @@ removeMemberFromLocalConv :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Local ConvId -> @@ -1141,8 +1180,7 @@ removeMemberFromLocalConv lcnv lusr con victim fmap (fmap lcuEvent . hush) . runError @NoChanges . updateLocalConversation @'ConversationLeaveTag lcnv (qUntagged lusr) con - . pure - $ victim + $ () | otherwise = fmap (fmap lcuEvent . hush) . runError @NoChanges @@ -1335,6 +1373,7 @@ updateConversationName :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -1361,6 +1400,7 @@ updateUnqualifiedConversationName :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -1383,6 +1423,7 @@ updateLocalConversationName :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 62908700dd..34d890bb55 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -391,6 +391,7 @@ data BotsAndMembers = BotsAndMembers bmRemotes :: Set (Remote UserId), bmBots :: Set BotMember } + deriving (Show) bmQualifiedMembers :: Local x -> BotsAndMembers -> [Qualified UserId] bmQualifiedMembers loc bm = diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index 9e6c24f7fb..6bc6719a2b 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 = 72 +schemaVersion = 73 diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 25e2a3cb3d..4d2c03fc9d 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -32,6 +32,7 @@ import qualified Data.List.Extra as List import Data.Monoid import Data.Qualified import qualified Data.Set as Set +import Galley.API.MLS.Types import Galley.Cassandra.Instances () import qualified Galley.Cassandra.Queries as Cql import Galley.Cassandra.Services @@ -74,7 +75,7 @@ addMembers conv (fmap toUserRole -> UserList lusers rusers) = do setConsistency LocalQuorum for_ chunk $ \(u, r) -> do -- User is local, too, so we add it to both the member and the user table - addPrepQuery Cql.insertMember (conv, u, Nothing, Nothing, r, Nothing) + addPrepQuery Cql.insertMember (conv, u, Nothing, Nothing, r) addPrepQuery Cql.insertUserConv (u, conv) for_ (List.chunksOf 32 rusers) $ \chunk -> do @@ -157,18 +158,16 @@ toMember :: Maybe Bool, Maybe Text, -- conversation role name - Maybe RoleName, - Maybe (Cassandra.Set (ClientId, KeyPackageRef)) + Maybe RoleName ) -> Maybe LocalMember -toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn, cs) = +toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn) = Just $ LocalMember { lmId = usr, lmService = newServiceRef <$> srv <*> prv, lmStatus = toMemberStatus (omus, omur, oar, oarr, hid, hidr), - lmConvRoleName = fromMaybe roleNameWireAdmin crn, - lmMLSClients = maybe Set.empty (Set.fromList . fromSet) cs + lmConvRoleName = fromMaybe roleNameWireAdmin crn } toMember _ = Nothing @@ -176,30 +175,27 @@ newRemoteMemberWithRole :: Remote (UserId, RoleName) -> RemoteMember newRemoteMemberWithRole ur@(qUntagged -> (Qualified (u, r) _)) = RemoteMember { rmId = qualifyAs ur u, - rmConvRoleName = r, - rmMLSClients = mempty + rmConvRoleName = r } lookupRemoteMember :: ConvId -> Domain -> UserId -> Client (Maybe RemoteMember) lookupRemoteMember conv domain usr = do mkMem <$$> retry x1 (query1 Cql.selectRemoteMember (params LocalQuorum (conv, domain, usr))) where - mkMem (role, clients) = + mkMem (Identity role) = RemoteMember { rmId = toRemoteUnsafe domain usr, - rmConvRoleName = role, - rmMLSClients = Set.fromList (fromSet clients) + rmConvRoleName = role } lookupRemoteMembers :: ConvId -> Client [RemoteMember] lookupRemoteMembers conv = do fmap (map mkMem) . retry x1 $ query Cql.selectRemoteMembers (params LocalQuorum (Identity conv)) where - mkMem (domain, usr, role, clients) = + mkMem (domain, usr, role) = RemoteMember { rmId = toRemoteUnsafe domain usr, - rmConvRoleName = role, - rmMLSClients = Set.fromList (fromSet clients) + rmConvRoleName = role } member :: @@ -346,58 +342,25 @@ removeLocalMembersFromRemoteConv (qUntagged -> Qualified conv convDomain) victim for_ victims $ \u -> addPrepQuery Cql.deleteUserRemoteConv (u, convDomain, conv) addMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -addMLSClients lcnv = - foldQualified - lcnv - (addLocalMLSClients (tUnqualified lcnv)) - (addRemoteMLSClients (tUnqualified lcnv)) - -addRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -addRemoteMLSClients cid ruid cs = - retry x5 $ - write - Cql.addRemoteMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tDomain ruid, tUnqualified ruid) - ) - -addLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -addLocalMLSClients cid lusr cs = - retry x5 $ - write - Cql.addLocalMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tUnqualified lusr) - ) +addMLSClients lcnv (Qualified usr domain) cs = retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + for_ cs $ \(c, kpr) -> + addPrepQuery Cql.addMLSClient (tUnqualified lcnv, domain, usr, c, kpr) -removeMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -removeMLSClients lcnv = - foldQualified - lcnv - (removeLocalMLSClients (tUnqualified lcnv)) - (removeRemoteMLSClients (tUnqualified lcnv)) - -removeLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -removeLocalMLSClients cid lusr cs = - retry x5 $ - write - Cql.removeLocalMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tUnqualified lusr) - ) +removeMLSClients :: Local ConvId -> Qualified UserId -> Set.Set ClientId -> Client () +removeMLSClients lcnv (Qualified usr domain) cs = retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + for_ cs $ \c -> + addPrepQuery Cql.removeMLSClient (tUnqualified lcnv, domain, usr, c) -removeRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -removeRemoteMLSClients cid rusr cs = - retry x5 $ - write - Cql.removeRemoteMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tDomain rusr, tUnqualified rusr) - ) +lookupMLSClients :: Local ConvId -> Client ClientMap +lookupMLSClients lcnv = + mkClientMap + <$> retry + x5 + (query Cql.lookupMLSClients (params LocalQuorum (Identity (tUnqualified lcnv)))) interpretMemberStoreToCassandra :: Members '[Embed IO, Input ClientState] r => @@ -423,3 +386,4 @@ interpretMemberStoreToCassandra = interpret $ \case removeLocalMembersFromRemoteConv rcnv uids AddMLSClients lcnv quid cs -> embedClient $ addMLSClients lcnv quid cs RemoveMLSClients lcnv quid cs -> embedClient $ removeMLSClients lcnv quid cs + LookupMLSClients lcnv -> embedClient $ lookupMLSClients lcnv diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index c46fb5afdb..07b45150fc 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -272,14 +272,14 @@ lookupGroupId = "SELECT conv_id, domain from group_id_conv_id where group_id = ? type MemberStatus = Int32 -selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) -selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ? and user = ?" +selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) +selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from member where conv = ? and user = ?" -selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) -selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ?" +selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) +selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from member where conv = ?" -insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) () -insertMember = "insert into member (conv, user, service, provider, status, conversation_role, mls_clients_keypackages) values (?, ?, ?, ?, 0, ?, ?)" +insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName) () +insertMember = "insert into member (conv, user, service, provider, status, conversation_role) values (?, ?, ?, ?, 0, ?)" removeMember :: PrepQuery W (ConvId, UserId) () removeMember = "delete from member where conv = ? and user = ?" @@ -308,11 +308,11 @@ insertRemoteMember = "insert into member_remote_user (conv, user_remote_domain, removeRemoteMember :: PrepQuery W (ConvId, Domain, UserId) () removeRemoteMember = "delete from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" -selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (RoleName, C.Set (ClientId, KeyPackageRef)) -selectRemoteMember = "select conversation_role, mls_clients_keypackages from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" +selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (Identity RoleName) +selectRemoteMember = "select conversation_role from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" -selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName, C.Set (ClientId, KeyPackageRef)) -selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role, mls_clients_keypackages from member_remote_user where conv = ?" +selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName) +selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role from member_remote_user where conv = ?" updateRemoteMemberConvRoleName :: PrepQuery W (RoleName, ConvId, Domain, UserId) () updateRemoteMemberConvRoleName = "update member_remote_user set conversation_role = ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" @@ -368,17 +368,14 @@ rmMemberClient c = -- MLS Clients -------------------------------------------------------------- -addLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) () -addLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user = ?" +addMLSClient :: PrepQuery W (ConvId, Domain, UserId, ClientId, KeyPackageRef) () +addMLSClient = "insert into member_client (conv, user_domain, user, client, key_package_ref) values (?, ?, ?, ?, ?)" -addRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) () -addRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" +removeMLSClient :: PrepQuery W (ConvId, Domain, UserId, ClientId) () +removeMLSClient = "delete from member_client where conv = ? and user_domain = ? and user = ? and client = ?" -removeLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) () -removeLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user = ?" - -removeRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) () -removeRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" +lookupMLSClients :: PrepQuery R (Identity ConvId) (Domain, UserId, ClientId, KeyPackageRef) +lookupMLSClients = "select user_domain, user, client, key_package_ref from member_client where conv = ?" acquireCommitLock :: PrepQuery W (GroupId, Epoch, Int32) Row acquireCommitLock = "insert into mls_commit_locks (group_id, epoch) values (?, ?) if not exists using ttl ?" diff --git a/services/galley/src/Galley/Data/Conversation/Types.hs b/services/galley/src/Galley/Data/Conversation/Types.hs index 5f7add6555..b93bd616c5 100644 --- a/services/galley/src/Galley/Data/Conversation/Types.hs +++ b/services/galley/src/Galley/Data/Conversation/Types.hs @@ -18,14 +18,12 @@ module Galley.Data.Conversation.Types where import Data.Id -import Data.Qualified import Galley.Types.Conversations.Members import Galley.Types.UserList import Imports import Wire.API.Conversation hiding (Conversation) import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role -import Wire.API.MLS.KeyPackage -- | Internal conversation type, corresponding directly to database schema. -- Should never be sent to users (and therefore doesn't have 'FromJSON' or @@ -45,11 +43,3 @@ data NewConversation = NewConversation ncUsers :: UserList (UserId, RoleName), ncProtocol :: ProtocolTag } - -getConvMemberMLSClients :: Local () -> Conversation -> Qualified UserId -> Maybe (Set (ClientId, KeyPackageRef)) -getConvMemberMLSClients loc conv qusr = - foldQualified - loc - (\lusr -> lmMLSClients <$> find ((==) (tUnqualified lusr) . lmId) (convLocalMembers conv)) - (\rusr -> rmMLSClients <$> find ((==) rusr . rmId) (convRemoteMembers conv)) - qusr diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs index d9d8c779f8..1bd42b5533 100644 --- a/services/galley/src/Galley/Effects/MemberStore.hs +++ b/services/galley/src/Galley/Effects/MemberStore.hs @@ -40,6 +40,7 @@ module Galley.Effects.MemberStore setOtherMember, addMLSClients, removeMLSClients, + lookupMLSClients, -- * Delete members deleteMembers, @@ -74,7 +75,10 @@ data MemberStore m a where DeleteMembers :: ConvId -> UserList UserId -> MemberStore m () DeleteMembersInRemoteConversation :: Remote ConvId -> [UserId] -> MemberStore m () AddMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () - RemoveMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () + RemoveMLSClients :: Local ConvId -> Qualified UserId -> Set ClientId -> MemberStore m () + LookupMLSClients :: + Local ConvId -> + MemberStore m (Map (Qualified UserId) (Set (ClientId, KeyPackageRef))) makeSem ''MemberStore diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 7bccfdaefa..7ecd707a9f 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1452,7 +1452,7 @@ postConvertTeamConv = do dave <- view Teams.userId <$> addUserToTeam alice tid assertQueue "team member (dave) join" $ tUpdate 3 [alice] refreshIndex - eve <- randomUser + (eve, qeve) <- randomUserTuple connectUsers alice (singleton eve) let acc = Just $ Set.fromList [InviteAccess, CodeAccess] -- creating a team-only conversation containing eve should fail @@ -1481,9 +1481,11 @@ postConvertTeamConv = do WS.assertMatchN (5 # Second) [wsA, wsB, wsE, wsM] $ wsAssertConvAccessUpdate qconv qalice teamAccess -- non-team members get kicked out - void . liftIO $ - WS.assertMatchN (5 # Second) [wsA, wsB, wsE, wsM] $ - wsAssertMemberLeave qconv qalice $ (`Qualified` localDomain) <$> [eve, mallory] + liftIO $ do + WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ + wsAssertMemberLeave qconv qeve (pure qeve) + WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ + wsAssertMemberLeave qconv qmallory (pure qmallory) -- joining (for mallory) is no longer possible postJoinCodeConv mallory j !!! const 403 === statusCode -- team members (dave) can still join @@ -1535,16 +1537,41 @@ 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) alice [charlie, dee] + wsAssertMembersLeave (cnvQualifiedId conv) charlie [charlie] + WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $ + wsAssertMembersLeave (cnvQualifiedId conv) dee [dee] -- dee's remote receives a notification - liftIO . assertBool "remote users are not notified" . isJust . flip find reqs $ \freq -> - (frComponent freq == Galley) - && ( frRPC freq == "on-conversation-updated" - ) - && ( fmap F.cuAction (eitherDecode (frBody freq)) - == Right (SomeConversationAction (sing @'ConversationLeaveTag) (charlie :| [dee])) - ) + liftIO $ + sortOn + (fmap fst) + ( map + ( \fr -> do + cu <- eitherDecode (frBody fr) + pure (F.cuOrigUserId cu, F.cuAction cu) + ) + ( filter + ( \fr -> + frComponent fr == Galley + && frRPC fr == "on-conversation-updated" + ) + 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] + } + ) + ] -- only alice and bob remain conv2 <- @@ -2412,7 +2439,7 @@ testGetQualifiedRemoteConv = do remoteConvId = Qualified convId remoteDomain bobAsOtherMember = OtherMember bobQ Nothing roleNameWireAdmin aliceAsLocal = - LocalMember aliceId defMemberStatus Nothing roleNameWireAdmin Set.empty + LocalMember aliceId defMemberStatus Nothing roleNameWireAdmin aliceAsOtherMember = localMemberToOther (qDomain aliceQ) aliceAsLocal aliceAsSelfMember = localMemberToSelf loc aliceAsLocal @@ -3375,7 +3402,6 @@ putRemoteConvMemberOk update = do defMemberStatus Nothing roleNameWireAdmin - Set.empty let mockConversation = mkProteusConv (qUnqualified qconv) @@ -3743,25 +3769,29 @@ removeUser = do bConvUpdates <- mapM (assertRight . eitherDecode . frBody) bConvUpdateRPCs bConvUpdatesA2 <- assertOne $ filter (\cu -> cuConvId cu == convA2) bConvUpdates - cuAction bConvUpdatesA2 @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId bConvUpdatesA2 @?= alexDel + cuAction bConvUpdatesA2 @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers bConvUpdatesA2 @?= [qUnqualified berta] bConvUpdatesA4 <- assertOne $ filter (\cu -> cuConvId cu == convA4) bConvUpdates - cuAction bConvUpdatesA4 @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId bConvUpdatesA4 @?= alexDel + cuAction bConvUpdatesA4 @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers bConvUpdatesA4 @?= [qUnqualified bart] liftIO $ do cConvUpdateRPC <- assertOne $ filter (matchFedRequest cDomain "on-conversation-updated") fedRequests Right convUpdate <- pure . eitherDecode . frBody $ cConvUpdateRPC cuConvId convUpdate @?= convA4 - cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId convUpdate @?= alexDel + cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers convUpdate @?= [qUnqualified carl] liftIO $ do dConvUpdateRPC <- assertOne $ filter (matchFedRequest dDomain "on-conversation-updated") fedRequests Right convUpdate <- pure . eitherDecode . frBody $ dConvUpdateRPC cuConvId convUpdate @?= convA2 - cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId convUpdate @?= alexDel + cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers convUpdate @?= [qUnqualified dwight] -- Check memberships diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 2f632a4c2e..436a283970 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -331,11 +331,11 @@ removeLocalUser = do cuRemove = FedGalley.ConversationUpdate { FedGalley.cuTime = addUTCTime (secondsToNominalDiffTime 5) now, - FedGalley.cuOrigUserId = qBob, + FedGalley.cuOrigUserId = qAlice, FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [alice], FedGalley.cuAction = - SomeConversationAction (sing @'ConversationLeaveTag) (pure qAlice) + SomeConversationAction (sing @'ConversationLeaveTag) () } connectWithRemoteUser alice qBob @@ -347,7 +347,7 @@ removeLocalUser = do void . WS.assertMatch (3 # Second) ws $ wsAssertMemberJoinWithRole qconv qBob [qAlice] roleNameWireMember void . WS.assertMatch (3 # Second) ws $ - wsAssertMembersLeave qconv qBob [qAlice] + wsAssertMembersLeave qconv qAlice [qAlice] afterRemoval <- listRemoteConvs remoteDomain alice liftIO $ do afterAddition @?= [qconv] @@ -399,7 +399,7 @@ removeRemoteUser = do FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [alice, charlie, dee], FedGalley.cuAction = - SomeConversationAction (sing @'ConversationLeaveTag) (pure user) + SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure user) } WS.bracketRN c [alice, charlie, dee, flo] $ \[wsA, wsC, wsD, wsF] -> do @@ -682,7 +682,7 @@ leaveConversationSuccess = do liftIO $ fedRequestsForDomain remoteDomain1 Galley federatedRequests @?= [] let [remote2GalleyFederatedRequest] = fedRequestsForDomain remoteDomain2 Galley federatedRequests - assertLeaveUpdate remote2GalleyFederatedRequest qconvId qChad [qUnqualified qEve] qChad + assertLeaveUpdate remote2GalleyFederatedRequest qconvId qChad [qUnqualified qEve] leaveConversationNonExistent :: TestM () leaveConversationNonExistent = do @@ -1031,7 +1031,7 @@ onUserDeleted = do FedGalley.cuOrigUserId cDomainRPCReq @?= qUntagged bob FedGalley.cuConvId cDomainRPCReq @?= qUnqualified groupConvId FedGalley.cuAlreadyPresentUsers cDomainRPCReq @?= [qUnqualified carl] - FedGalley.cuAction cDomainRPCReq @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure $ qUntagged bob) + FedGalley.cuAction cDomainRPCReq @?= SomeConversationAction (sing @'ConversationLeaveTag) () -- | We test only ReceiptMode update here -- diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 20ffd37612..9e89c58315 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -150,7 +150,16 @@ tests s = testGroup "Backend-side External Remove Proposals" [ test s "local conversation, local user deleted" testBackendRemoveProposalLocalConvLocalUser, - test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser + test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser, + test + s + "local conversation, creator leaving" + testBackendRemoveProposalLocalConvLocalLeaverCreator, + test + s + "local conversation, local committer leaving" + testBackendRemoveProposalLocalConvLocalLeaverCommitter, + test s "local conversation, remote user leaving" testBackendRemoveProposalLocalConvRemoteLeaver ], testGroup "Protocol mismatch" @@ -1386,13 +1395,9 @@ testBackendRemoveProposalLocalConvLocalUser = do [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] traverse_ uploadNewKeyPackage [bob1, bob2] (_, qcnv) <- setupMLSGroup alice1 - void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit - bobClients <- - fmap (filter (\(cid, _) -> cidQualifiedUser cid == bob)) $ - currentGroupFile alice1 >>= liftIO . readGroupState - + bobClients <- getClientsFromGroupState alice1 bob mlsBracket [alice1] $ \wss -> void $ do liftTest $ deleteUser (qUnqualified bob) !!! const 200 === statusCode -- remove bob clients from the test state @@ -1434,10 +1439,7 @@ testBackendRemoveProposalLocalConvRemoteUser = do mlsBracket [alice1] $ \[wsA] -> do void $ sendAndConsumeCommit commit - bobClients <- - fmap (filter (\(cid, _) -> cidQualifiedUser cid == bob)) $ - currentGroupFile alice1 >>= liftIO . readGroupState - + bobClients <- getClientsFromGroupState alice1 bob fedGalleyClient <- view tsFedGalleyClient void $ runFedClient @@ -1503,3 +1505,128 @@ sendRemoteMLSWelcomeKPNotFound = do liftIO $ do -- check that no event is received WS.assertNoEvent (1 # Second) [wsB] + +testBackendRemoveProposalLocalConvLocalLeaverCreator :: TestM () +testBackendRemoveProposalLocalConvLocalLeaverCreator = do + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + traverse_ uploadNewKeyPackage [bob1, bob2] + (_, qcnv) <- setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + + aliceClients <- getClientsFromGroupState alice1 alice + mlsBracket [alice1, bob1, bob2] $ \wss -> void $ do + liftTest $ + deleteMemberQualified (qUnqualified alice) alice qcnv + !!! const 200 === statusCode + -- remove alice's client from the test state + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [alice1]) + } + + for_ aliceClients $ \(_, ref) -> do + -- only bob's clients should receive the external proposals + msgs <- WS.assertMatchN (5 # Second) (drop 1 wss) $ \n -> + wsAssertBackendRemoveProposal alice qcnv ref n + traverse_ (uncurry consumeMessage1) (zip [bob1, bob2] msgs) + + -- but everyone should receive leave events + WS.assertMatchN_ (5 # WS.Second) wss $ + wsAssertMembersLeave qcnv alice [alice] + + -- check that no more events are sent, so in particular alice does not + -- receive any MLS messages + WS.assertNoEvent (1 # WS.Second) wss + + -- bob commits the external proposals + events <- createPendingProposalCommit bob1 >>= sendAndConsumeCommit + liftIO $ events @?= [] + +testBackendRemoveProposalLocalConvLocalLeaverCommitter :: TestM () +testBackendRemoveProposalLocalConvLocalLeaverCommitter = do + [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing) + + runMLSTest $ do + [alice1, bob1, bob2, charlie1] <- traverse createMLSClient [alice, bob, bob, charlie] + traverse_ uploadNewKeyPackage [bob1, bob2, charlie1] + (_, qcnv) <- setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + + -- promote bob + putOtherMemberQualified (ciUser alice1) bob (OtherMemberUpdate (Just roleNameWireAdmin)) qcnv + !!! const 200 === statusCode + + void $ createAddCommit bob1 [charlie] >>= sendAndConsumeCommit + + bobClients <- getClientsFromGroupState alice1 bob + mlsBracket [alice1, charlie1, bob1, bob2] $ \wss -> void $ do + liftTest $ + deleteMemberQualified (qUnqualified bob) bob qcnv + !!! const 200 === statusCode + -- remove bob clients from the test state + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [bob1, bob2]) + } + + for_ bobClients $ \(_, ref) -> do + -- only alice and charlie should receive the external proposals + msgs <- WS.assertMatchN (5 # Second) (take 2 wss) $ \n -> + wsAssertBackendRemoveProposal bob qcnv ref n + traverse_ (uncurry consumeMessage1) (zip [alice1, charlie1] msgs) + + -- but everyone should receive leave events + WS.assertMatchN_ (5 # WS.Second) wss $ + wsAssertMembersLeave qcnv bob [bob] + + -- check that no more events are sent, so in particular bob does not + -- receive any MLS messages + WS.assertNoEvent (1 # WS.Second) wss + + -- alice commits the external proposals + events <- createPendingProposalCommit alice1 >>= sendAndConsumeCommit + liftIO $ events @?= [] + +testBackendRemoveProposalLocalConvRemoteLeaver :: TestM () +testBackendRemoveProposalLocalConvRemoteLeaver = do + [alice, bob] <- createAndConnectUsers [Nothing, Just "bob.example.com"] + + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + (_, qcnv) <- setupMLSGroup alice1 + commit <- createAddCommit alice1 [bob] + + let mock req = case frRPC req of + "on-conversation-updated" -> pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True . ciClient) + $ [bob1, bob2] + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + bobClients <- getClientsFromGroupState alice1 bob + void . withTempMockFederator' mock $ do + mlsBracket [alice1] $ \[wsA] -> void $ do + void $ sendAndConsumeCommit commit + fedGalleyClient <- view tsFedGalleyClient + void $ + runFedClient + @"update-conversation" + fedGalleyClient + (qDomain bob) + ConversationUpdateRequest + { curUser = qUnqualified bob, + curConvId = qUnqualified qcnv, + curAction = SomeConversationAction SConversationLeaveTag () + } + + for_ bobClients $ \(_, ref) -> + WS.assertMatch_ (5 # WS.Second) wsA $ + wsAssertBackendRemoveProposal bob qcnv ref diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index f4425091cf..731ff774f5 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -765,6 +765,15 @@ readGroupState fp = do kpr <- (unhexM . T.encodeUtf8 =<<) $ leafNode ^.. key "key_package_ref" . _String pure (identity, KeyPackageRef kpr) +getClientsFromGroupState :: + ClientIdentity -> + Qualified UserId -> + MLSTest [(ClientIdentity, KeyPackageRef)] +getClientsFromGroupState cid u = do + groupFile <- currentGroupFile cid + groupState <- liftIO $ readGroupState groupFile + pure $ filter (\(cid', _) -> cidQualifiedUser cid' == u) groupState + clientKeyPair :: ClientIdentity -> MLSTest (ByteString, ByteString) clientKeyPair cid = do bd <- State.gets mlsBaseDir diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index bd42d1b55a..d486dee0f7 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -54,7 +54,7 @@ import qualified Data.Map.Strict as Map import Data.Misc import qualified Data.ProtoLens as Protolens import Data.ProtocolBuffers (encodeMessage) -import Data.Qualified +import Data.Qualified hiding (isLocal) import Data.Range import Data.Serialize (runPut) import qualified Data.Set as Set @@ -1716,15 +1716,15 @@ assertRemoveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do sort (cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers cuAction cu @?= SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure victim) -assertLeaveUpdate :: (MonadIO m, HasCallStack) => FederatedRequest -> Qualified ConvId -> Qualified UserId -> [UserId] -> Qualified UserId -> m () -assertLeaveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do +assertLeaveUpdate :: (MonadIO m, HasCallStack) => FederatedRequest -> Qualified ConvId -> Qualified UserId -> [UserId] -> m () +assertLeaveUpdate req qconvId remover alreadyPresentUsers = liftIO $ do frRPC req @?= "on-conversation-updated" frOriginDomain req @?= qDomain qconvId let Just cu = decode (frBody req) cuOrigUserId cu @?= remover cuConvId cu @?= qUnqualified qconvId sort (cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers - cuAction cu @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure victim) + cuAction cu @?= SomeConversationAction (sing @'ConversationLeaveTag) () ------------------------------------------------------------------------------- -- Helpers diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index da4ca972fc..7ad96398c1 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -107,10 +107,9 @@ genLocalMember = <*> pure defMemberStatus <*> pure Nothing <*> arbitrary - <*> arbitrary genRemoteMember :: Gen RemoteMember -genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember <*> arbitrary +genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember genConversation :: Gen Data.Conversation genConversation =