From e1253d4bb465d8b4498beaef53584ed725c1ea8c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Feb 2023 19:19:34 +0100 Subject: [PATCH] [FS-1335] Remove clients from subconversations when user is removed from main conversation (#2942) --- .../reflect-user-removal-from-parent-in-sub | 1 + libs/wire-api/src/Wire/API/User/Client.hs | 19 ++ services/galley/src/Galley/API/Action.hs | 53 ++-- services/galley/src/Galley/API/Clients.hs | 3 +- services/galley/src/Galley/API/Federation.hs | 1 + services/galley/src/Galley/API/Internal.hs | 36 ++- services/galley/src/Galley/API/MLS/Message.hs | 140 +++++----- services/galley/src/Galley/API/MLS/Removal.hs | 64 ++++- services/galley/src/Galley/API/Util.hs | 26 +- .../src/Galley/Cassandra/SubConversation.hs | 5 +- services/galley/test/integration/API/MLS.hs | 261 +++++++++++++++++- .../galley/test/integration/API/MLS/Util.hs | 8 +- services/galley/test/integration/API/Util.hs | 27 +- 13 files changed, 515 insertions(+), 129 deletions(-) create mode 100644 changelog.d/2-features/reflect-user-removal-from-parent-in-sub diff --git a/changelog.d/2-features/reflect-user-removal-from-parent-in-sub b/changelog.d/2-features/reflect-user-removal-from-parent-in-sub new file mode 100644 index 00000000000..8f411ae91f2 --- /dev/null +++ b/changelog.d/2-features/reflect-user-removal-from-parent-in-sub @@ -0,0 +1 @@ +Removing or kicking a user from a conversation also removes the user's clients from any subconversation. diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 230e926982b..a6e0911acb0 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -63,6 +63,9 @@ module Wire.API.User.Client longitude, Latitude (..), Longitude (..), + + -- * List of MLS client ids + ClientList (..), ) where @@ -472,6 +475,22 @@ instance ToSchema Client where mlsPublicKeysFieldSchema :: ObjectSchema SwaggerDoc MLSPublicKeys mlsPublicKeysFieldSchema = fromMaybe mempty <$> optField "mls_public_keys" mlsPublicKeysSchema +-------------------------------------------------------------------------------- +-- ClientList + +-- | Client list for internal API. +data ClientList = ClientList {clClients :: [ClientId]} + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ClientList) + deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema ClientList + +instance ToSchema ClientList where + schema = + object "ClientList" $ + ClientList + <$> clClients + .= field "client_ids" (array schema) + -------------------------------------------------------------------------------- -- PubClient diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index bbd8ff3b235..dc471c8e870 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -132,21 +132,36 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con r HasConversationActionEffects 'ConversationLeaveTag r = ( Members - '[ MemberStore, - Error InternalError, + '[ Error InternalError, Error NoChanges, ExternalAccess, FederatorAccess, GundeckAccess, - Input UTCTime, Input Env, + Input UTCTime, + MemberStore, ProposalStore, + SubConversationStore, TinyLog ] r ) HasConversationActionEffects 'ConversationRemoveMembersTag r = - (Members '[MemberStore, Error NoChanges] r) + ( Members + '[ MemberStore, + SubConversationStore, + ProposalStore, + Input Env, + Input UTCTime, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Error InternalError, + Error NoChanges, + TinyLog + ] + r + ) HasConversationActionEffects 'ConversationMemberUpdateTag r = (Members '[MemberStore, ErrorS 'ConvMemberNotFound] r) HasConversationActionEffects 'ConversationDeleteTag r = @@ -309,6 +324,9 @@ type family PerformActionCalls tag where PerformActionCalls 'ConversationLeaveTag = ( CallsFed 'Galley "on-mls-message-sent" ) + PerformActionCalls 'ConversationRemoveMembersTag = + ( CallsFed 'Galley "on-mls-message-sent" + ) PerformActionCalls 'ConversationDeleteTag = ( CallsFed 'Galley "on-delete-mls-conversation" ) @@ -334,31 +352,16 @@ performAction tag origUser lconv action = do performConversationJoin origUser lconv action SConversationLeaveTag -> do 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 + lconv' <- traverse (convDeleteMembers (toUserList lconv victims)) lconv + -- send remove proposals in the MLS case traverse_ (removeUser lconv') victims pure (mempty, action) SConversationRemoveMembersTag -> do let presentVictims = filter (isConvMemberL lconv) (toList action) when (null presentVictims) noChanges - E.deleteMembers (tUnqualified lcnv) (toUserList lconv presentVictims) + traverse_ (convDeleteMembers (toUserList lconv presentVictims)) lconv + -- send remove proposals in the MLS case + traverse_ (removeUser lconv) presentVictims pure (mempty, action) -- FUTUREWORK: should we return the filtered action here? SConversationMemberUpdateTag -> do void $ ensureOtherMember lconv (cmuTarget action) conv @@ -487,8 +490,8 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do '[ ConversationStore, Error InternalError, ErrorS ('ActionDenied 'LeaveConversation), - ErrorS 'InvalidOperation, ErrorS 'ConvNotFound, + ErrorS 'InvalidOperation, ErrorS 'MissingLegalholdConsent, ExternalAccess, FederatorAccess, diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs index b16dc16f0f0..ce563439f38 100644 --- a/services/galley/src/Galley/API/Clients.hs +++ b/services/galley/src/Galley/API/Clients.hs @@ -104,7 +104,8 @@ rmClientH :: MemberStore, Error InternalError, ProposalStore, - P.TinyLog + P.TinyLog, + SubConversationStore ] r, CallsFed 'Galley "on-client-removed", diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 7008b3f247a..f017c1fe831 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -145,6 +145,7 @@ onClientRemoved :: Input UTCTime, MemberStore, ProposalStore, + SubConversationStore, TinyLog ] r, diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 8e5d1b647a8..11ea5e607da 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -28,6 +28,7 @@ import Control.Exception.Safe (catchAny) import Control.Lens hiding (Getter, Setter, (.=)) import Data.Id as Id import Data.List1 (maybeList1) +import qualified Data.Map as Map import Data.Qualified import Data.Range import Data.Singletons @@ -60,6 +61,7 @@ import Galley.Effects.FederatorAccess import Galley.Effects.GundeckAccess import Galley.Effects.LegalHoldStore as LegalHoldStore import Galley.Effects.MemberStore +import qualified Galley.Effects.MemberStore as E import Galley.Effects.TeamStore import qualified Galley.Intra.Push as Intra import Galley.Monad @@ -86,7 +88,7 @@ import qualified Servant hiding (WithStatus) import System.Logger.Class hiding (Path, name) import qualified System.Logger.Class as Log import Wire.API.ApplyMods -import Wire.API.Conversation hiding (Member) +import Wire.API.Conversation import Wire.API.Conversation.Action import Wire.API.Conversation.Role import Wire.API.CustomBackend @@ -96,6 +98,7 @@ import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error +import Wire.API.MLS.Group import Wire.API.Provider.Service hiding (Service) import Wire.API.Routes.API import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti @@ -109,6 +112,7 @@ import Wire.API.Team import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.SearchVisibility +import Wire.API.User.Client import Wire.Sem.Paging import Wire.Sem.Paging.Cassandra @@ -271,6 +275,19 @@ type InternalAPIBase = :> ReqBody '[Servant.JSON] Connect :> ConversationVerb ) + -- This endpoint is meant for testing membership of a conversation + :<|> Named + "get-conversation-clients" + ( Summary "Get mls conversation client list" + :> ZLocalUser + :> CanThrow 'ConvNotFound + :> "conversation" + :> Capture "cnv" ConvId + :> MultiVerb1 + 'GET + '[Servant.JSON] + (Respond 200 "Clients" ClientList) + ) :<|> Named "guard-legalhold-policy-conflicts" ( "guard-legalhold-policy-conflicts" @@ -479,6 +496,7 @@ internalAPI = mkNamedAPI @"status" (pure ()) <@> mkNamedAPI @"delete-user" (callsFed rmUser) <@> mkNamedAPI @"connect" (callsFed Create.createConnectConversation) + <@> mkNamedAPI @"get-conversation-clients" iGetMLSClientListForConv <@> mkNamedAPI @"guard-legalhold-policy-conflicts" guardLegalholdPolicyConflictsH <@> legalholdWhitelistedTeamsAPI <@> iTeamsAPI @@ -688,6 +706,7 @@ rmUser :: MemberStore, ProposalStore, P.TinyLog, + SubConversationStore, TeamStore ] r, @@ -842,3 +861,18 @@ guardLegalholdPolicyConflictsH :: guardLegalholdPolicyConflictsH glh = do mapError @LegalholdConflicts (const $ Tagged @'MissingLegalholdConsent ()) $ guardLegalholdPolicyConflicts (glhProtectee glh) (glhUserClients glh) + +-- | Get an MLS conversation client list +iGetMLSClientListForConv :: + forall r. + Members + '[ MemberStore, + ErrorS 'ConvNotFound + ] + r => + Local UserId -> + ConvId -> + Sem r ClientList +iGetMLSClientListForConv lusr cnv = do + cm <- E.lookupMLSClients (convToGroupId (qualifyAs lusr cnv)) + pure $ ClientList (concatMap (Map.keys . snd) (Map.assocs cm)) diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index de873b1224a..b4836b518b9 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -662,6 +662,7 @@ data ProposalAction = ProposalAction -- to know if a commit has one when processing external commits paExternalInit :: Any } + deriving (Show) instance Semigroup ProposalAction where ProposalAction add1 rem1 init1 <> ProposalAction add2 rem2 init2 = @@ -769,71 +770,72 @@ processExternalCommit :: ProposalAction -> Maybe UpdatePath -> Sem r () -processExternalCommit qusr mSenderClient lConvOrSub epoch action updatePath = withCommitLock (cnvmlsGroupId . mlsMetaConvOrSub . tUnqualified $ lConvOrSub) epoch $ do - let convOrSub = tUnqualified lConvOrSub - newKeyPackage <- - upLeaf - <$> note - (mlsProtocolError "External commits need an update path") - updatePath - when (paExternalInit action == mempty) $ - throw . mlsProtocolError $ - "The external commit is missing an external init proposal" - unless (paAdd action == mempty) $ - throw . mlsProtocolError $ - "The external commit must not have add proposals" - - newRef <- - kpRef' newKeyPackage - & note (mlsProtocolError "An invalid key package in the update path") - - -- validate and update mapping in brig - eithCid <- - nkpresClientIdentity - <$$> validateAndAddKeyPackageRef - NewKeyPackage - { nkpConversation = tUntagged (convOfConvOrSub . idForConvOrSub <$> lConvOrSub), - nkpKeyPackage = KeyPackageData (rmRaw newKeyPackage) - } - cid <- either (\errMsg -> throw (mlsProtocolError ("Tried to add invalid KeyPackage: " <> errMsg))) pure eithCid - - unless (cidQualifiedUser cid == qusr) $ - throw . mlsProtocolError $ - "The external commit attempts to add another user" - - senderClient <- noteS @'MLSMissingSenderClient mSenderClient - - unless (ciClient cid == senderClient) $ - throw . mlsProtocolError $ - "The external commit attempts to add another client of the user, it must only add itself" - - -- only members can join a subconversation - forOf_ _SubConv convOrSub $ \(mlsConv, _) -> - unless (isClientMember cid (mcMembers mlsConv)) $ - throwS @'MLSSubConvClientNotInParent - - -- check if there is a key package ref in the remove proposal - remRef <- - if Map.null (paRemove action) - then pure Nothing - else do - (remCid, r) <- derefUser (paRemove action) qusr - unless (cidQualifiedUser cid == cidQualifiedUser remCid) - . throw - . mlsProtocolError - $ "The external commit attempts to remove a client from a user other than themselves" - pure (Just r) - - updateKeyPackageMapping lConvOrSub qusr (ciClient cid) remRef newRef - - -- increment epoch number - lConvOrSub' <- for lConvOrSub incrementEpoch - - -- fetch backend remove proposals of the previous epoch - kpRefs <- getPendingBackendRemoveProposals (cnvmlsGroupId . mlsMetaConvOrSub . tUnqualified $ lConvOrSub') epoch - -- requeue backend remove proposals for the current epoch - let cm = membersConvOrSub (tUnqualified lConvOrSub') - createAndSendRemoveProposals lConvOrSub' kpRefs qusr cm +processExternalCommit qusr mSenderClient lConvOrSub epoch action updatePath = + withCommitLock (cnvmlsGroupId . mlsMetaConvOrSub . tUnqualified $ lConvOrSub) epoch $ do + let convOrSub = tUnqualified lConvOrSub + newKeyPackage <- + upLeaf + <$> note + (mlsProtocolError "External commits need an update path") + updatePath + when (paExternalInit action == mempty) $ + throw . mlsProtocolError $ + "The external commit is missing an external init proposal" + unless (paAdd action == mempty) $ + throw . mlsProtocolError $ + "The external commit must not have add proposals" + + newRef <- + kpRef' newKeyPackage + & note (mlsProtocolError "An invalid key package in the update path") + + -- validate and update mapping in brig + eithCid <- + nkpresClientIdentity + <$$> validateAndAddKeyPackageRef + NewKeyPackage + { nkpConversation = tUntagged (convOfConvOrSub . idForConvOrSub <$> lConvOrSub), + nkpKeyPackage = KeyPackageData (rmRaw newKeyPackage) + } + cid <- either (\errMsg -> throw (mlsProtocolError ("Tried to add invalid KeyPackage: " <> errMsg))) pure eithCid + + unless (cidQualifiedUser cid == qusr) $ + throw . mlsProtocolError $ + "The external commit attempts to add another user" + + senderClient <- noteS @'MLSMissingSenderClient mSenderClient + + unless (ciClient cid == senderClient) $ + throw . mlsProtocolError $ + "The external commit attempts to add another client of the user, it must only add itself" + + -- only members can join a subconversation + forOf_ _SubConv convOrSub $ \(mlsConv, _) -> + unless (isClientMember cid (mcMembers mlsConv)) $ + throwS @'MLSSubConvClientNotInParent + + -- check if there is a key package ref in the remove proposal + remRef <- + if Map.null (paRemove action) + then pure Nothing + else do + (remCid, r) <- derefUser (paRemove action) qusr + unless (cidQualifiedUser cid == cidQualifiedUser remCid) + . throw + . mlsProtocolError + $ "The external commit attempts to remove a client from a user other than themselves" + pure (Just r) + + updateKeyPackageMapping lConvOrSub qusr (ciClient cid) remRef newRef + + -- increment epoch number + lConvOrSub' <- for lConvOrSub incrementEpoch + + -- fetch backend remove proposals of the previous epoch + kpRefs <- getPendingBackendRemoveProposals (cnvmlsGroupId . mlsMetaConvOrSub . tUnqualified $ lConvOrSub') epoch + -- requeue backend remove proposals for the current epoch + let cm = membersConvOrSub (tUnqualified lConvOrSub') + createAndSendRemoveProposals lConvOrSub' kpRefs qusr cm where derefUser :: ClientMap -> Qualified UserId -> Sem r (ClientIdentity, KeyPackageRef) derefUser cm user = case Map.assocs cm of @@ -1331,7 +1333,7 @@ executeProposalAction qusr con lconvOrSub action = do -- FUTUREWORK: turn this error into a proper response throwS @'MLSClientMismatch - membersToRemove <- catMaybes <$> for removedUsers (uncurry (checkRemoval cm)) + membersToRemove <- catMaybes <$> for removedUsers (uncurry (checkRemoval (is _SubConv convOrSub) cm)) -- add users to the conversation and send events addEvents <- @@ -1377,13 +1379,15 @@ executeProposalAction qusr con lconvOrSub action = do pure (addEvents <> removeEvents) where checkRemoval :: + Bool -> ClientMap -> Qualified UserId -> Set ClientId -> Sem r (Maybe (Qualified UserId)) - checkRemoval cm qtarget clients = do + checkRemoval isSubConv cm qtarget clients = do let clientsInConv = Map.keysSet (Map.findWithDefault mempty qtarget cm) - when (clients /= clientsInConv) $ do + -- FUTUREWORK: add tests against this situation for conv v subconv + when (not isSubConv && clients /= clientsInConv) $ do -- FUTUREWORK: turn this error into a proper response throwS @'MLSClientMismatch when (qusr == qtarget) $ diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index 72c0d83560b..914a55fa2de 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -34,6 +34,8 @@ import Galley.API.MLS.Types import qualified Galley.Data.Conversation.Types as Data import Galley.Effects import Galley.Effects.ProposalStore +import Galley.Effects.SubConversationStore +import qualified Galley.Effects.SubConversationStore as E import Galley.Env import Imports import Polysemy @@ -62,7 +64,7 @@ createAndSendRemoveProposals :: Input Env ] r, - Traversable t, + Foldable t, CallsFed 'Galley "on-mls-message-sent" ) => Local ConvOrSubConv -> @@ -95,6 +97,41 @@ createAndSendRemoveProposals lConvOrSubConv cs qusr cm = do proposal propagateMessage qusr lConvOrSubConv Nothing msgEncoded cm +removeClientsWithClientMapRecursively :: + ( Members + '[ Input UTCTime, + TinyLog, + ExternalAccess, + FederatorAccess, + GundeckAccess, + ProposalStore, + SubConversationStore, + Input Env + ] + r, + Foldable f, + CallsFed 'Galley "on-mls-message-sent" + ) => + Local MLSConversation -> + (ConvOrSubConv -> f KeyPackageRef) -> + Qualified UserId -> + Sem r () +removeClientsWithClientMapRecursively lMlsConv getKPs qusr = do + let mainConv = fmap Conv lMlsConv + cm = mcMembers (tUnqualified lMlsConv) + createAndSendRemoveProposals mainConv (getKPs (tUnqualified mainConv)) qusr cm + + -- remove this client from all subconversations + subs <- listSubConversations' (mcId (tUnqualified lMlsConv)) + for_ subs $ \sub -> do + let subConv = fmap (flip SubConv sub) lMlsConv + + createAndSendRemoveProposals + subConv + (getKPs (tUnqualified subConv)) + qusr + cm + -- | Send remove proposals for a single client of a user to the local conversation. removeClient :: ( Members @@ -106,6 +143,7 @@ removeClient :: Input UTCTime, MemberStore, ProposalStore, + SubConversationStore, TinyLog ] r, @@ -118,10 +156,8 @@ removeClient :: removeClient lc qusr cid = do mMlsConv <- mkMLSConversation (tUnqualified lc) for_ mMlsConv $ \mlsConv -> do - -- FUTUREWORK: also remove the client from from subconversations of lc - let cidAndKPs = maybeToList (cmLookupRef (mkClientIdentity qusr cid) (mcMembers mlsConv)) - cm = mcMembers mlsConv - createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) cidAndKPs qusr cm + let getKPs = cmLookupRef (mkClientIdentity qusr cid) . membersConvOrSub + removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getKPs qusr -- | Send remove proposals for all clients of the user to the local conversation. removeUser :: @@ -134,6 +170,7 @@ removeUser :: Input UTCTime, MemberStore, ProposalStore, + SubConversationStore, TinyLog ] r, @@ -145,7 +182,16 @@ removeUser :: removeUser lc qusr = do mMlsConv <- mkMLSConversation (tUnqualified lc) for_ mMlsConv $ \mlsConv -> do - -- FUTUREWORK: also remove the client from from subconversations of lc - let kprefs = toList (Map.findWithDefault mempty qusr (mcMembers mlsConv)) - cm = mcMembers mlsConv - createAndSendRemoveProposals (qualifyAs lc (Conv mlsConv)) kprefs qusr cm + let getKPs = Map.findWithDefault mempty qusr . membersConvOrSub + removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getKPs qusr + +-- | Convert cassandra subconv maps into SubConversations +listSubConversations' :: + Member SubConversationStore r => + ConvId -> + Sem r [SubConversation] +listSubConversations' cid = do + subs <- E.listSubConversations cid + msubs <- for (Map.assocs subs) $ \(subId, _) -> do + getSubConversation cid subId + pure (catMaybes msubs) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index bebf559bcea..a4a24524f0c 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -39,7 +39,7 @@ import Galley.API.Error import Galley.API.Mapping import qualified Galley.Data.Conversation as Data import Galley.Data.Services (BotMember, newBotMember) -import qualified Galley.Data.Types as DataTypes +import qualified Galley.Data.Types as Data import Galley.Effects import Galley.Effects.BrigAccess import Galley.Effects.CodeStore @@ -329,6 +329,24 @@ memberJoinEvent lorig qconv t lmems rmems = localToSimple u = SimpleMember (tUntagged (qualifyAs lorig (lmId u))) (lmConvRoleName u) remoteToSimple u = SimpleMember (tUntagged (rmId u)) (rmConvRoleName u) +convDeleteMembers :: + Members '[MemberStore] r => + UserList UserId -> + Data.Conversation -> + Sem r Data.Conversation +convDeleteMembers ul conv = do + deleteMembers (Data.convId conv) ul + let locals = Set.fromList (ulLocals ul) + remotes = Set.fromList (ulRemotes ul) + -- update in-memory view of the conversation + pure $ + conv + { Data.convLocalMembers = + filter (\lm -> Set.notMember (lmId lm) locals) (Data.convLocalMembers conv), + Data.convRemoteMembers = + filter (\rm -> Set.notMember (rmId rm) remotes) (Data.convRemoteMembers conv) + } + isMember :: Foldable m => UserId -> m LocalMember -> Bool isMember u = isJust . find ((u ==) . lmId) @@ -579,12 +597,12 @@ pushConversationEvent conn e lusers bots = do verifyReusableCode :: Members '[CodeStore, ErrorS 'CodeNotFound] r => ConversationCode -> - Sem r DataTypes.Code + Sem r Data.Code verifyReusableCode convCode = do c <- - getCode (conversationKey convCode) DataTypes.ReusableCode + getCode (conversationKey convCode) Data.ReusableCode >>= noteS @'CodeNotFound - unless (DataTypes.codeValue c == conversationCode convCode) $ + unless (Data.codeValue c == conversationCode convCode) $ throwS @'CodeNotFound pure c diff --git a/services/galley/src/Galley/Cassandra/SubConversation.hs b/services/galley/src/Galley/Cassandra/SubConversation.hs index 574e32d3b3c..ad143121146 100644 --- a/services/galley/src/Galley/Cassandra/SubConversation.hs +++ b/services/galley/src/Galley/Cassandra/SubConversation.hs @@ -15,7 +15,10 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Cassandra.SubConversation where +module Galley.Cassandra.SubConversation + ( interpretSubConversationStoreToCassandra, + ) +where import Cassandra import Cassandra.Util diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 94a51a58b27..1dc6f91f91f 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -70,6 +70,7 @@ import Wire.API.MLS.Welcome import Wire.API.Message import Wire.API.Routes.MultiTablePaging import Wire.API.Routes.Version +import Wire.API.User.Client tests :: IO TestSetup -> TestTree tests s = @@ -223,6 +224,9 @@ tests s = test s "fail to reset a subconversation with wrong epoch" testDeleteSubConvStale, test s "leave a subconversation" testLeaveSubConv, test s "leave a subconversation as a non-member" testLeaveSubConvNonMember, + test s "remove user from parent conversation" testRemoveUserParent, + test s "remove creator from parent conversation" testRemoveCreatorParent, + test s "creator removes user from parent conversation" testCreatorRemovesUserFromParent, test s "delete parent conversation of a subconversation" testDeleteParentOfSubConv ], testGroup @@ -813,7 +817,12 @@ testAdminRemovesUserFromConv = do do convs <- getAllConvs (qUnqualified bob) - liftIO $ + clients <- getConvClients (qUnqualified alice) (qUnqualified qcnv) + liftIO $ do + assertEqual + ("Expected only one client, got " <> show clients) + (length . clClients $ clients) + 1 assertBool "bob is not longer part of conversation after the commit" (qcnv `notElem` map cnvQualifiedId convs) @@ -1618,7 +1627,7 @@ testBackendRemoveProposalRecreateClient = do createExternalCommit alice2 Nothing cnv >>= sendAndConsumeCommitBundle WS.assertMatch (5 # WS.Second) wsA $ - wsAssertBackendRemoveProposal alice qcnv ref + wsAssertBackendRemoveProposal alice (Conv <$> qcnv) ref consumeMessage1 alice2 proposal void $ createPendingProposalCommit alice2 >>= sendAndConsumeCommitBundle @@ -1645,7 +1654,7 @@ testBackendRemoveProposalLocalConvLocalUser = do for bobClients $ \(_, ref) -> do [msg] <- WS.assertMatchN (5 # Second) wss $ \n -> - wsAssertBackendRemoveProposal bob qcnv ref n + wsAssertBackendRemoveProposal bob (Conv <$> qcnv) ref n consumeMessage1 alice1 msg -- alice commits the external proposals @@ -1680,7 +1689,7 @@ testBackendRemoveProposalLocalConvRemoteUser = do for_ bobClients $ \(_, ref) -> WS.assertMatch (5 # WS.Second) wsA $ - wsAssertBackendRemoveProposal bob qcnv ref + wsAssertBackendRemoveProposal bob (Conv <$> qcnv) ref sendRemoteMLSWelcome :: TestM () sendRemoteMLSWelcome = do @@ -1756,7 +1765,7 @@ testBackendRemoveProposalLocalConvLocalLeaverCreator = do 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 + wsAssertBackendRemoveProposal alice (Conv <$> qcnv) ref n traverse_ (uncurry consumeMessage1) (zip [bob1, bob2] msgs) -- but everyone should receive leave events @@ -1801,7 +1810,7 @@ testBackendRemoveProposalLocalConvLocalLeaverCommitter = do 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 + wsAssertBackendRemoveProposal bob (Conv <$> qcnv) ref n traverse_ (uncurry consumeMessage1) (zip [alice1, charlie1] msgs) -- but everyone should receive leave events @@ -1844,7 +1853,7 @@ testBackendRemoveProposalLocalConvRemoteLeaver = do for_ bobClients $ \(_, ref) -> WS.assertMatch_ (5 # WS.Second) wsA $ - wsAssertBackendRemoveProposal bob qcnv ref + wsAssertBackendRemoveProposal bob (Conv <$> qcnv) ref testBackendRemoveProposalLocalConvLocalClient :: TestM () testBackendRemoveProposalLocalConvLocalClient = do @@ -1871,7 +1880,7 @@ testBackendRemoveProposalLocalConvLocalClient = do wsAssertClientRemoved (ciClient bob1) msg <- WS.assertMatch (5 # WS.Second) wsA $ \notification -> do - wsAssertBackendRemoveProposal bob qcnv kpBob1 notification + wsAssertBackendRemoveProposal bob (Conv <$> qcnv) kpBob1 notification for_ [alice1, bob2, charlie1] $ flip consumeMessage1 msg @@ -1905,7 +1914,7 @@ testBackendRemoveProposalLocalConvRemoteClient = do WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> - void $ wsAssertBackendRemoveProposal bob qcnv bob1KP notification + void $ wsAssertBackendRemoveProposal bob (Conv <$> qcnv) bob1KP notification testGetGroupInfoOfLocalConv :: TestM () testGetGroupInfoOfLocalConv = do @@ -2943,7 +2952,7 @@ testLeaveSubConv = do msgs <- WS.assertMatchN (5 # WS.Second) wss $ - wsAssertBackendRemoveProposal bob qcnv bob1KP + wsAssertBackendRemoveProposal bob (Conv <$> qcnv) bob1KP traverse_ (uncurry consumeMessage1) (zip [alice1, bob2] msgs) -- assert the leaver gets no proposal or event void . liftIO $ WS.assertNoEvent (5 # WS.Second) [wsBob1] @@ -2970,7 +2979,7 @@ testLeaveSubConv = do msgs <- WS.assertMatchN (5 # WS.Second) wss $ - wsAssertBackendRemoveProposal charlie qcnv charlie1KP + wsAssertBackendRemoveProposal charlie (Conv <$> qcnv) charlie1KP traverse_ (uncurry consumeMessage1) (zip [alice1, bob2] msgs) -- alice commits the pending proposal @@ -3055,3 +3064,233 @@ testLeaveRemoteSubConv = do -- check that leave-sub-conversation is called void $ assertOne (filter ((== "leave-sub-conversation") . frRPC) reqs) + +testRemoveUserParent :: TestM () +testRemoveUserParent = do + [alice, bob, charlie] <- createAndConnectUsers [Nothing, Nothing, Nothing] + + runMLSTest $ + do + [alice1, bob1, bob2, charlie1, charlie2] <- + traverse + createMLSClient + [alice, bob, bob, charlie, charlie] + traverse_ uploadNewKeyPackage [bob1, bob2, charlie1, charlie2] + (_, qcnv) <- setupMLSGroup alice1 + void $ createAddCommit alice1 [bob, charlie] >>= sendAndConsumeCommit + + let subname = SubConvId "conference" + void $ createSubConv qcnv bob1 subname + let qcs = fmap (flip SubConv subname) qcnv + + -- all clients join + for_ [alice1, bob2, charlie1, charlie2] $ \c -> + void $ createExternalCommit c Nothing qcs >>= sendAndConsumeCommitBundle + + [(_, kpref1), (_, kpref2)] <- getClientsFromGroupState alice1 charlie + + -- charlie leaves the main conversation + mlsBracket [alice1, bob1, bob2] $ \wss -> do + liftTest $ do + deleteMemberQualified (qUnqualified charlie) charlie qcnv + !!! const 200 === statusCode + + -- Remove charlie from our state as well + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [charlie1, charlie2]) + } + + msg1 <- WS.assertMatchN (5 # Second) wss $ \n -> + wsAssertBackendRemoveProposal charlie (Conv <$> qcnv) kpref1 n + + traverse_ (uncurry consumeMessage1) (zip [alice1, bob1, bob2] msg1) + + msg2 <- WS.assertMatchN (5 # Second) wss $ \n -> + wsAssertBackendRemoveProposal charlie (Conv <$> qcnv) kpref2 n + + traverse_ (uncurry consumeMessage1) (zip [alice1, bob1, bob2] msg2) + + void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle + + liftTest $ do + getSubConv (qUnqualified charlie) qcnv (SubConvId "conference") + !!! const 403 === statusCode + + sub :: PublicSubConversation <- + responseJsonError + =<< getSubConv (qUnqualified bob) qcnv (SubConvId "conference") + >= sendAndConsumeCommit + + let subname = SubConvId "conference" + void $ createSubConv qcnv alice1 subname + let qcs = fmap (flip SubConv subname) qcnv + + -- all clients join + for_ [bob1, bob2, charlie1, charlie2] $ \c -> + void $ createExternalCommit c Nothing qcs >>= sendAndConsumeCommitBundle + + [(_, kpref1)] <- getClientsFromGroupState alice1 alice + + -- creator leaves the main conversation + mlsBracket [bob1, bob2, charlie1, charlie2] $ \wss -> do + liftTest $ do + deleteMemberQualified (qUnqualified alice) alice qcnv + !!! const 200 === statusCode + + -- Remove alice1 from our state as well + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [alice1]) + } + + msg <- WS.assertMatchN (5 # Second) wss $ \n -> + -- Checks proposal for subconv, parent doesn't get one + -- since alice is not notified of her own removal + wsAssertBackendRemoveProposal alice (Conv <$> qcnv) kpref1 n + + traverse_ (uncurry consumeMessage1) (zip [bob1, bob2, charlie1, charlie2] msg) + + void $ createPendingProposalCommit bob1 >>= sendAndConsumeCommitBundle + + liftTest $ do + getSubConv (qUnqualified alice) qcnv subname + !!! const 403 === statusCode + + -- charlie sees updated memberlist + sub :: PublicSubConversation <- + responseJsonError + =<< getSubConv (qUnqualified charlie) qcnv subname + >= sendAndConsumeCommit + + stateParent <- State.get + + let subId = SubConvId "conference" + qcs <- createSubConv qcnv alice1 subId + liftTest $ + getSubConv (qUnqualified alice) qcnv subId + !!! do const 200 === statusCode + + for_ [bob1, bob2, charlie1, charlie2] $ \c -> do + void $ createExternalCommit c Nothing qcs >>= sendAndConsumeCommitBundle + + stateSub <- State.get + State.put stateParent + + mlsBracket [alice1, charlie1, charlie2] $ \wss -> do + events <- createRemoveCommit alice1 [bob1, bob2] >>= sendAndConsumeCommitBundle + State.modify $ \s -> s {mlsMembers = Set.difference (mlsMembers s) (Set.fromList [bob1, bob2])} + + liftIO $ assertOne events >>= assertLeaveEvent qcnv alice [bob] + + WS.assertMatchN_ (5 # Second) wss $ \n -> do + wsAssertMemberLeave qcnv alice [bob] n + + State.put stateSub + -- Get client state for alice and fetch bob client identities + [(_, kprefBob1), (_, kprefBob2)] <- getClientsFromGroupState alice1 bob + + -- handle bob1 removal + msgs <- WS.assertMatchN (5 # Second) wss $ \n -> do + -- it was an alice proposal for the parent, + -- but it's a backend proposal for the sub + wsAssertBackendRemoveProposal bob qcs kprefBob1 n + + traverse_ (uncurry consumeMessage1) (zip [alice1, charlie1, charlie2] msgs) + + -- handle bob2 removal + msgs2 <- WS.assertMatchN (5 # Second) wss $ \n -> do + -- it was an alice proposal for the parent, + -- but it's a backend proposal for the sub + wsAssertBackendRemoveProposal bob qcs kprefBob2 n + + traverse_ (uncurry consumeMessage1) (zip [alice1, charlie1, charlie2] msgs2) + + -- Remove bob from our state as well + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [bob1, bob2]) + } + -- alice commits the proposal and sends over for the backend to also process it + void $ + createPendingProposalCommit alice1 + >>= sendAndConsumeCommitBundle + + liftTest $ do + getSubConv (qUnqualified bob) qcnv (SubConvId "conference") + !!! const 403 === statusCode + + -- charlie sees updated memberlist + sub1 :: PublicSubConversation <- + responseJsonError + =<< getSubConv (qUnqualified charlie) qcnv (SubConvId "conference") + (show . length . pscMembers $ sub1) + ) + (sort [alice1, charlie1, charlie2]) + (sort $ pscMembers sub1) + + -- alice also sees updated memberlist + sub2 :: PublicSubConversation <- + responseJsonError + =<< getSubConv (qUnqualified alice) qcnv (SubConvId "conference") + (show . length . pscMembers $ sub2) + ) + (sort [alice1, charlie1, charlie2]) + (sort $ pscMembers sub2) diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 10ab5f2ca37..4e3da83c5ec 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -253,6 +253,7 @@ data MLSState = MLSState mlsConvId :: Maybe (Qualified ConvOrSubConvId), mlsEpoch :: Word64 } + deriving (Show) newtype MLSTest a = MLSTest {unMLSTest :: StateT MLSState TestM a} deriving newtype @@ -307,6 +308,7 @@ data MessagePackage = MessagePackage mpWelcome :: Maybe ByteString, mpPublicGroupState :: Maybe ByteString } + deriving (Show) takeLastPrekeyNG :: HasCallStack => MLSTest LastPrekey takeLastPrekeyNG = do @@ -502,7 +504,6 @@ createGroup cid qcs gid = do resetGroup :: ClientIdentity -> Qualified ConvOrSubConvId -> GroupId -> MLSTest () resetGroup cid qcs gid = do - groupJSON <- mlscli cid ["group", "create", T.unpack (toBase64Text (unGroupId gid))] Nothing State.modify $ \s -> s { mlsGroupId = Just gid, @@ -511,6 +512,11 @@ resetGroup cid qcs gid = do mlsEpoch = 0, mlsNewMembers = mempty } + resetClientGroup cid gid + +resetClientGroup :: ClientIdentity -> GroupId -> MLSTest () +resetClientGroup cid gid = do + groupJSON <- mlscli cid ["group", "create", T.unpack (toBase64Text (unGroupId gid))] Nothing setClientGroupState cid groupJSON getConvId :: MLSTest (Qualified ConvOrSubConvId) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 49a496195f2..d68b47df74e 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -188,7 +188,7 @@ createBindingTeam' :: HasCallStack => TestM (User, TeamId) createBindingTeam' = do owner <- randomTeamCreator' teams <- getTeams (userId owner) [] - let [team] = view teamListTeams teams + team <- assertOne $ view teamListTeams teams let tid = view teamId team SQS.assertTeamActivate "create team" tid refreshIndex @@ -998,6 +998,17 @@ getConvs u cids = do . zConn "conn" . json (ListConversations (unsafeRange cids)) +getConvClients :: HasCallStack => UserId -> ConvId -> TestM ClientList +getConvClients usr cnv = do + g <- viewGalley + responseJsonError + =<< get + ( g + . paths ["i", "conversation", toByteString' cnv] + . zUser usr + . zConn "conn" + ) + getAllConvs :: HasCallStack => UserId -> TestM [Conversation] getAllConvs u = do g <- viewGalley @@ -1811,7 +1822,7 @@ assertRemoveUpdate :: (MonadIO m, HasCallStack) => FederatedRequest -> Qualified assertRemoveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do frRPC req @?= "on-conversation-updated" frOriginDomain req @?= qDomain qconvId - let Just cu = decode (frBody req) + cu <- assertJust $ decode (frBody req) cuOrigUserId cu @?= remover cuConvId cu @?= qUnqualified qconvId sort (cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers @@ -1821,7 +1832,7 @@ assertLeaveUpdate :: (MonadIO m, HasCallStack) => FederatedRequest -> Qualified assertLeaveUpdate req qconvId remover alreadyPresentUsers = liftIO $ do frRPC req @?= "on-conversation-updated" frOriginDomain req @?= qDomain qconvId - let Just cu = decode (frBody req) + cu <- assertJust $ decode (frBody req) cuOrigUserId cu @?= remover cuConvId cu @?= qUnqualified qconvId sort (cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers @@ -2153,7 +2164,7 @@ getInternalClientsFull userSet = do ensureClientCaps :: HasCallStack => UserId -> ClientId -> Client.ClientCapabilityList -> TestM () ensureClientCaps uid cid caps = do UserClientsFull (Map.lookup uid -> (Just clnts)) <- getInternalClientsFull (UserSet $ Set.singleton uid) - let [clnt] = filter ((== cid) . clientId) $ Set.toList clnts + clnt <- assertOne . filter ((== cid) . clientId) $ Set.toList clnts liftIO $ assertEqual ("ensureClientCaps: " <> show (uid, cid, caps)) (clientCapabilities clnt) caps -- TODO: Refactor, as used also in brig @@ -2857,17 +2868,17 @@ wsAssertConvReceiptModeUpdate conv usr new n = do wsAssertBackendRemoveProposalWithEpoch :: HasCallStack => Qualified UserId -> Qualified ConvId -> KeyPackageRef -> Epoch -> Notification -> IO ByteString wsAssertBackendRemoveProposalWithEpoch fromUser convId kpref epoch n = do - bs <- wsAssertBackendRemoveProposal fromUser convId kpref n + bs <- wsAssertBackendRemoveProposal fromUser (Conv <$> convId) kpref n let msg = fromRight (error "Failed to parse Message 'MLSPlaintext") $ decodeMLS' @(Message 'MLSPlainText) bs let tbs = rmValue . msgTBS $ msg tbsMsgEpoch tbs @?= epoch pure bs -wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified ConvId -> KeyPackageRef -> Notification -> IO ByteString -wsAssertBackendRemoveProposal fromUser convId kpref n = do +wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified ConvOrSubConvId -> KeyPackageRef -> Notification -> IO ByteString +wsAssertBackendRemoveProposal fromUser cnvOrSubCnv kpref n = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False - evtConv e @?= convId + evtConv e @?= convOfConvOrSub <$> cnvOrSubCnv evtType e @?= MLSMessageAdd evtFrom e @?= fromUser let bs = getMLSMessageData (evtData e)