diff --git a/Makefile b/Makefile index ab9d0da850f..9822fb18664 100644 --- a/Makefile +++ b/Makefile @@ -211,7 +211,10 @@ git-add-cassandra-schema: db-reset git-add-cassandra-schema-impl .PHONY: git-add-cassandra-schema-impl git-add-cassandra-schema-impl: $(eval CASSANDRA_CONTAINER := $(shell docker ps | grep '/cassandra:' | perl -ne '/^(\S+)\s/ && print $$1')) - ( echo '-- automatically generated with `make git-add-cassandra-schema`' ; docker exec -i $(CASSANDRA_CONTAINER) /usr/bin/cqlsh -e "DESCRIBE schema;" ) > ./cassandra-schema.cql + ( echo '-- automatically generated with `make git-add-cassandra-schema`'; \ + docker exec -i $(CASSANDRA_CONTAINER) /usr/bin/cqlsh -e "DESCRIBE schema;" ) \ + | sed "s/CREATE TABLE galley_test.member_client/-- NOTE: this table is unused. It was replaced by mls_group_member_client\nCREATE TABLE galley_test.member_client/g" \ + > ./cassandra-schema.cql git add ./cassandra-schema.cql .PHONY: cqlsh diff --git a/cassandra-schema.cql b/cassandra-schema.cql index f86616538b8..e9e0b6c8b96 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -364,6 +364,7 @@ CREATE TABLE galley_test.group_id_conv_id ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +-- NOTE: this table is unused. It was replaced by mls_group_member_client CREATE TABLE galley_test.member_client ( conv uuid, user_domain text, @@ -430,6 +431,29 @@ CREATE TABLE galley_test.conversation_codes ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE galley_test.mls_group_member_client ( + group_id blob, + user_domain text, + user uuid, + client text, + key_package_ref blob, + PRIMARY KEY (group_id, 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.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 + 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 TABLE galley_test.clients ( user uuid PRIMARY KEY, clients set diff --git a/changelog.d/0-release-notes/member_clients_migration b/changelog.d/0-release-notes/member_clients_migration new file mode 100644 index 00000000000..56b91f75698 --- /dev/null +++ b/changelog.d/0-release-notes/member_clients_migration @@ -0,0 +1 @@ +This realease migrates data from `galley.member_client` to `galley.mls_group_member_client`. When upgrading wire-server no manual steps are required. diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index e77b64924bd..470372cc4a7 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -538,11 +538,15 @@ executable galley-integration executable galley-migrate-data main-is: Main.hs + + -- cabal-fmt: expand migrate-data/src other-modules: Galley.DataMigration Galley.DataMigration.Types + Main Paths_galley V1_BackfillBillingTeamMembers + V2_MigrateMLSMembers hs-source-dirs: migrate-data/src default-extensions: @@ -598,6 +602,7 @@ executable galley-migrate-data , exceptions , extended , extra >=1.3 + , galley , galley-types , imports , lens @@ -685,6 +690,7 @@ executable galley-schema V74_ExposeInvitationsToTeamAdmin V75_MLSGroupInfo V76_ProposalOrigin + V77_MLSGroupMemberClient hs-source-dirs: schema/src default-extensions: diff --git a/services/galley/migrate-data/src/Galley/DataMigration/Types.hs b/services/galley/migrate-data/src/Galley/DataMigration/Types.hs index 3cc0f74cbbf..76aad12dad1 100644 --- a/services/galley/migrate-data/src/Galley/DataMigration/Types.hs +++ b/services/galley/migrate-data/src/Galley/DataMigration/Types.hs @@ -42,7 +42,8 @@ newtype MigrationActionT m a = MigrationActionT {unMigrationAction :: ReaderT En Monad, MonadIO, MonadThrow, - MonadReader Env + MonadReader Env, + MonadUnliftIO ) instance MonadTrans MigrationActionT where diff --git a/services/galley/migrate-data/src/Main.hs b/services/galley/migrate-data/src/Main.hs index 08b6e51cfa3..f6a051b8d57 100644 --- a/services/galley/migrate-data/src/Main.hs +++ b/services/galley/migrate-data/src/Main.hs @@ -22,11 +22,17 @@ import Imports import Options.Applicative import qualified System.Logger.Extended as Log import qualified V1_BackfillBillingTeamMembers +import qualified V2_MigrateMLSMembers main :: IO () main = do o <- execParser (info (helper <*> cassandraSettingsParser) desc) l <- Log.mkLogger Log.Debug Nothing Nothing - migrate l o [V1_BackfillBillingTeamMembers.migration] + migrate + l + o + [ V1_BackfillBillingTeamMembers.migration, + V2_MigrateMLSMembers.migration + ] where desc = header "Galley Cassandra Data Migrations" <> fullDesc diff --git a/services/galley/migrate-data/src/V2_MigrateMLSMembers.hs b/services/galley/migrate-data/src/V2_MigrateMLSMembers.hs new file mode 100644 index 00000000000..f0a444ec547 --- /dev/null +++ b/services/galley/migrate-data/src/V2_MigrateMLSMembers.hs @@ -0,0 +1,101 @@ +-- 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 V2_MigrateMLSMembers where + +import Cassandra +import Conduit +import Data.Conduit.Internal (zipSources) +import qualified Data.Conduit.List as C +import Data.Domain +import Data.Id +import Data.Map.Strict (lookup) +import qualified Data.Map.Strict as Map +import Galley.Cassandra.Instances () +import Galley.DataMigration.Types +import Imports hiding (lookup) +import qualified System.Logger.Class as Log +import UnliftIO (pooledMapConcurrentlyN_) +import UnliftIO.Async (pooledMapConcurrentlyN) +import Wire.API.MLS.Group +import Wire.API.MLS.KeyPackage + +migration :: Migration +migration = + Migration + { version = MigrationVersion 2, + text = "Migrating from member_client to mls_group_member_client", + action = + runConduit $ + zipSources + (C.sourceList [(1 :: Int32) ..]) + getMemberClientsFromLegacy + .| C.mapM_ + ( \(i, rows) -> do + Log.info (Log.field "Entries " (show (i * pageSize))) + let convIds = map rowConvId rows + m <- lookupGroupIds convIds + let newRows = flip mapMaybe rows $ \(conv, domain, uid, client, ref) -> + conv `lookup` m >>= \groupId -> pure (groupId, domain, uid, client, ref) + insertMemberClients newRows + ) + } + +rowConvId :: (ConvId, Domain, UserId, ClientId, KeyPackageRef) -> ConvId +rowConvId (conv, _, _, _, _) = conv + +pageSize :: Int32 +pageSize = 1000 + +getMemberClientsFromLegacy :: MonadClient m => ConduitM () [(ConvId, Domain, UserId, ClientId, KeyPackageRef)] m () +getMemberClientsFromLegacy = paginateC cql (paramsP LocalQuorum () pageSize) x5 + where + cql :: PrepQuery R () (ConvId, Domain, UserId, ClientId, KeyPackageRef) + cql = "SELECT conv, user_domain, user, client, key_package_ref from member_client" + +lookupGroupIds :: [ConvId] -> MigrationActionT IO (Map ConvId GroupId) +lookupGroupIds convIds = do + rows <- pooledMapConcurrentlyN 8 (\convId -> retry x5 (query1 cql (params LocalQuorum (Identity convId)))) convIds + rows' <- + rows + & mapM + ( \case + (Just (c, mg)) -> do + case mg of + Nothing -> do + Log.warn (Log.msg ("No group found for conv " <> show c)) + pure Nothing + Just g -> pure (Just (c, g)) + Nothing -> do + Log.warn (Log.msg ("Conversation is missing for entry" :: Text)) + pure Nothing + ) + + rows' + & catMaybes + & Map.fromList + & pure + where + cql :: PrepQuery R (Identity ConvId) (ConvId, Maybe GroupId) + cql = "SELECT conv, group_id from conversation where conv = ?" + +insertMemberClients :: (MonadUnliftIO m, MonadClient m) => [(GroupId, Domain, UserId, ClientId, KeyPackageRef)] -> m () +insertMemberClients rows = do + pooledMapConcurrentlyN_ 8 (\row -> retry x5 (write cql (params LocalQuorum row))) rows + where + cql :: PrepQuery W (GroupId, Domain, UserId, ClientId, KeyPackageRef) () + cql = "INSERT INTO mls_group_member_client (group_id, user_domain, user, client, key_package_ref) VALUES (?, ?, ?, ?, ?)" diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 343773c6912..bb3642744b7 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -79,6 +79,7 @@ import qualified V73_MemberClientTable import qualified V74_ExposeInvitationsToTeamAdmin import qualified V75_MLSGroupInfo import qualified V76_ProposalOrigin +import qualified V77_MLSGroupMemberClient main :: IO () main = do @@ -143,7 +144,8 @@ main = do V73_MemberClientTable.migration, V74_ExposeInvitationsToTeamAdmin.migration, V75_MLSGroupInfo.migration, - V76_ProposalOrigin.migration + V76_ProposalOrigin.migration, + V77_MLSGroupMemberClient.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/V77_MLSGroupMemberClient.hs b/services/galley/schema/src/V77_MLSGroupMemberClient.hs new file mode 100644 index 00000000000..8847b53c22c --- /dev/null +++ b/services/galley/schema/src/V77_MLSGroupMemberClient.hs @@ -0,0 +1,36 @@ +-- 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 V77_MLSGroupMemberClient (migration) where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 77 "Add table mls_group_member_client which replaces member_client" $ do + schema' + [r| CREATE TABLE mls_group_member_client ( + group_id blob, + user_domain text, + user uuid, + client text, + key_package_ref blob, + PRIMARY KEY (group_id, user_domain, user, client) + ); + |] diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index b8233a3c70d..0df2dbe3530 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -126,11 +126,11 @@ createGroupConversation lusr conn newConv = do conv <- E.createConversation lcnv nc -- set creator client for MLS conversations - case (newConvProtocol newConv, newConvCreatorClient newConv) of - (ProtocolProteusTag, _) -> pure () - (ProtocolMLSTag, Just c) -> - E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, nullKeyPackageRef)) - (ProtocolMLSTag, Nothing) -> + case (convProtocol conv, newConvCreatorClient newConv) of + (ProtocolProteus, _) -> pure () + (ProtocolMLS mlsMeta, Just c) -> + E.addMLSClients (cnvmlsGroupId mlsMeta) (qUntagged lusr) (Set.singleton (c, nullKeyPackageRef)) + (ProtocolMLS _mlsMeta, Nothing) -> throw (InvalidPayload "Missing creator_client field when creating an MLS conversation") now <- input diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 85b25d25586..7bd31569e0a 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -28,7 +28,7 @@ where import Control.Comonad import Control.Error.Util (hush) -import Control.Lens (preview, to) +import Control.Lens (preview) import Data.Id import Data.Json.Util import Data.List.NonEmpty (NonEmpty, nonEmpty) @@ -273,15 +273,17 @@ postMLSCommitBundleToLocalConv :: postMLSCommitBundleToLocalConv qusr mc conn bundle lcnv = do let msg = rmValue (cbCommitMsg bundle) conv <- getLocalConvForUser qusr lcnv + mlsMeta <- Data.mlsMetadata conv & noteS @'ConvNotFound + let lconv = qualifyAs lcnv conv - cm <- lookupMLSClients lcnv + cm <- lookupMLSClients (cnvmlsGroupId mlsMeta) senderClient <- fmap ciClient <$> getSenderIdentity qusr mc SMLSPlainText msg events <- case msgPayload msg of CommitMessage commit -> do - (groupId, action) <- getCommitData lconv (msgEpoch msg) commit + action <- getCommitData lconv mlsMeta (msgEpoch msg) commit -- check that the welcome message matches the action for_ (cbWelcome bundle) $ \welcome -> when @@ -295,9 +297,9 @@ postMLSCommitBundleToLocalConv qusr mc conn bundle lcnv = do senderClient conn lconv + mlsMeta cm (msgEpoch msg) - groupId action (msgSender msg) commit @@ -476,19 +478,20 @@ postMLSMessageToLocalConv :: postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of SomeMessage tag msg -> do conv <- getLocalConvForUser qusr lcnv + mlsMeta <- Data.mlsMetadata conv & noteS @'ConvNotFound -- construct client map - cm <- lookupMLSClients lcnv + cm <- lookupMLSClients (cnvmlsGroupId mlsMeta) let lconv = qualifyAs lcnv conv -- validate message events <- case tag of SMLSPlainText -> case msgPayload msg of CommitMessage c -> - processCommit qusr senderClient con lconv cm (msgEpoch msg) (msgSender msg) c + processCommit qusr senderClient con lconv mlsMeta cm (msgEpoch msg) (msgSender msg) c ApplicationMessage _ -> throwS @'MLSUnsupportedMessage ProposalMessage prop -> - processProposal qusr conv msg prop $> mempty + processProposal qusr conv mlsMeta msg prop $> mempty SMLSCipherText -> case toMLSEnum' (msgContentType (msgPayload msg)) of Right CommitMessageTag -> throwS @'MLSUnsupportedMessage Right ProposalMessageTag -> throwS @'MLSUnsupportedMessage @@ -598,21 +601,18 @@ getCommitData :: Member TinyLog r ) => Local Data.Conversation -> + ConversationMLSData -> Epoch -> Commit -> - Sem r (GroupId, ProposalAction) -getCommitData lconv epoch commit = do - convMeta <- - preview (to convProtocol . _ProtocolMLS) (tUnqualified lconv) - & noteS @'ConvNotFound - - let curEpoch = cnvmlsEpoch convMeta - groupId = cnvmlsGroupId convMeta + Sem r ProposalAction +getCommitData lconv mlsMeta epoch commit = do + let curEpoch = cnvmlsEpoch mlsMeta + groupId = cnvmlsGroupId mlsMeta + suite = cnvmlsCipherSuite mlsMeta -- check epoch number when (epoch /= curEpoch) $ throwS @'MLSStaleMessage - action <- foldMap (applyProposalRef (tUnqualified lconv) groupId epoch) (cProposals commit) - pure (groupId, action) + foldMap (applyProposalRef (tUnqualified lconv) mlsMeta groupId epoch suite) (cProposals commit) processCommit :: ( HasProposalEffects r, @@ -635,14 +635,15 @@ processCommit :: Maybe ClientId -> Maybe ConnId -> Local Data.Conversation -> + ConversationMLSData -> ClientMap -> Epoch -> Sender 'MLSPlainText -> Commit -> Sem r [LocalConversationUpdate] -processCommit qusr senderClient con lconv cm epoch sender commit = do - (groupId, action) <- getCommitData lconv epoch commit - processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit +processCommit qusr senderClient con lconv mlsMeta cm epoch sender commit = do + action <- getCommitData lconv mlsMeta epoch commit + processCommitWithAction qusr senderClient con lconv mlsMeta cm epoch action sender commit processExternalCommit :: forall r. @@ -669,13 +670,13 @@ processExternalCommit :: Qualified UserId -> Maybe ClientId -> Local Data.Conversation -> + ConversationMLSData -> ClientMap -> Epoch -> - GroupId -> ProposalAction -> Maybe UpdatePath -> Sem r () -processExternalCommit qusr mSenderClient lconv cm epoch groupId action updatePath = withCommitLock groupId epoch $ do +processExternalCommit qusr mSenderClient lconv mlsMeta cm epoch action updatePath = withCommitLock (cnvmlsGroupId mlsMeta) epoch $ do newKeyPackage <- upLeaf <$> note @@ -724,14 +725,14 @@ processExternalCommit qusr mSenderClient lconv cm epoch groupId action updatePat $ "The external commit attempts to remove a client from a user other than themselves" pure (Just r) - updateKeyPackageMapping lconv qusr (ciClient cid) remRef newRef + updateKeyPackageMapping lconv (cnvmlsGroupId mlsMeta) qusr (ciClient cid) remRef newRef -- increment epoch number setConversationEpoch (Data.convId (tUnqualified lconv)) (succ epoch) -- fetch local conversation with new epoch lc <- qualifyAs lconv <$> getLocalConvForUser qusr (convId <$> lconv) -- fetch backend remove proposals of the previous epoch - kpRefs <- getPendingBackendRemoveProposals groupId epoch + kpRefs <- getPendingBackendRemoveProposals (cnvmlsGroupId mlsMeta) epoch -- requeue backend remove proposals for the current epoch removeClientsWithClientMap lc kpRefs cm qusr where @@ -776,17 +777,17 @@ processCommitWithAction :: Maybe ClientId -> Maybe ConnId -> Local Data.Conversation -> + ConversationMLSData -> ClientMap -> Epoch -> - GroupId -> ProposalAction -> Sender 'MLSPlainText -> Commit -> Sem r [LocalConversationUpdate] -processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit = +processCommitWithAction qusr senderClient con lconv mlsMeta cm epoch action sender commit = case sender of - MemberSender ref -> processInternalCommit qusr senderClient con lconv cm epoch groupId action ref commit - NewMemberSender -> processExternalCommit qusr senderClient lconv cm epoch groupId action (cPath commit) $> [] + MemberSender ref -> processInternalCommit qusr senderClient con lconv mlsMeta cm epoch action ref commit + NewMemberSender -> processExternalCommit qusr senderClient lconv mlsMeta cm epoch action (cPath commit) $> [] _ -> throw (mlsProtocolError "Unexpected sender") processInternalCommit :: @@ -811,17 +812,17 @@ processInternalCommit :: Maybe ClientId -> Maybe ConnId -> Local Data.Conversation -> + ConversationMLSData -> ClientMap -> Epoch -> - GroupId -> ProposalAction -> KeyPackageRef -> Commit -> Sem r [LocalConversationUpdate] -processInternalCommit qusr senderClient con lconv cm epoch groupId action senderRef commit = do +processInternalCommit qusr senderClient con lconv mlsMeta cm epoch action senderRef commit = do self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr - withCommitLock groupId epoch $ do + withCommitLock (cnvmlsGroupId mlsMeta) epoch $ do postponedKeyPackageRefUpdate <- if epoch == Epoch 0 then do @@ -838,7 +839,7 @@ processInternalCommit qusr senderClient con lconv cm epoch groupId action sender ) $ cPath commit addMLSClients - (convId <$> lconv) + (cnvmlsGroupId mlsMeta) qusr (Set.singleton (creatorClient, creatorRef)) (Left _, SelfConv, _) -> @@ -858,7 +859,7 @@ processInternalCommit qusr senderClient con lconv cm epoch groupId action sender ) $ cPath commit addMLSClients - (convId <$> lconv) + (cnvmlsGroupId mlsMeta) qusr (Set.singleton (creatorClient, creatorRef)) (Left _, GlobalTeamConv, _) -> @@ -876,7 +877,7 @@ processInternalCommit qusr senderClient con lconv cm epoch groupId action sender ) $ cPath commit -- register the creator client - updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef' + updateKeyPackageMapping lconv (cnvmlsGroupId mlsMeta) qusr creatorClient Nothing senderRef' -- remote clients cannot send the first commit (Right _, _, _) -> throwS @'MLSStaleMessage -- uninitialised conversations should contain exactly one client @@ -888,18 +889,18 @@ processInternalCommit qusr senderClient con lconv cm epoch groupId action sender updatedRef <- kpRef' updatedKeyPackage & note (mlsProtocolError "Could not compute key package ref") -- postpone key package ref update until other checks/processing passed case senderClient of - Just cli -> pure (updateKeyPackageMapping lconv qusr cli (Just senderRef) updatedRef) + Just cli -> pure (updateKeyPackageMapping lconv (cnvmlsGroupId mlsMeta) qusr cli (Just senderRef) updatedRef) Nothing -> pure (pure ()) Nothing -> pure (pure ()) -- ignore commits without update path -- check all pending proposals are referenced in the commit - allPendingProposals <- getAllPendingProposalRefs groupId epoch + allPendingProposals <- getAllPendingProposalRefs (cnvmlsGroupId mlsMeta) epoch let referencedProposals = Set.fromList $ mapMaybe (\x -> preview Proposal._Ref x) (cProposals commit) unless (all (`Set.member` referencedProposals) allPendingProposals) $ throwS @'MLSCommitMissingReferences -- process and execute proposals - updates <- executeProposalAction qusr con lconv cm action + updates <- executeProposalAction qusr con lconv mlsMeta cm action -- update key package ref if necessary postponedKeyPackageRefUpdate @@ -912,12 +913,13 @@ processInternalCommit qusr senderClient con lconv cm epoch groupId action sender updateKeyPackageMapping :: Members '[BrigAccess, MemberStore] r => Local Data.Conversation -> + GroupId -> Qualified UserId -> ClientId -> Maybe KeyPackageRef -> KeyPackageRef -> Sem r () -updateKeyPackageMapping lconv qusr cid mOld new = do +updateKeyPackageMapping lconv groupId qusr cid mOld new = do let lcnv = fmap Data.convId lconv -- update actual mapping in brig case mOld of @@ -931,9 +933,9 @@ updateKeyPackageMapping lconv qusr cid mOld new = do } -- remove old (client, key package) pair - removeMLSClients lcnv qusr (Set.singleton cid) + removeMLSClients groupId qusr (Set.singleton cid) -- add new (client, key package) pair - addMLSClients lcnv qusr (Set.singleton (cid, new)) + addMLSClients groupId qusr (Set.singleton (cid, new)) applyProposalRef :: ( HasProposalEffects r, @@ -946,29 +948,29 @@ applyProposalRef :: r ) => Data.Conversation -> + ConversationMLSData -> GroupId -> Epoch -> + CipherSuiteTag -> ProposalOrRef -> Sem r ProposalAction -applyProposalRef conv groupId epoch (Ref ref) = do +applyProposalRef conv mlsMeta groupId epoch _suite (Ref ref) = do p <- getProposal groupId epoch ref >>= noteS @'MLSProposalNotFound - checkEpoch epoch conv - checkGroup groupId conv - applyProposal (convId conv) (rmValue p) -applyProposalRef conv _groupId _epoch (Inline p) = do - suite <- - preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) conv - & noteS @'ConvNotFound + checkEpoch epoch mlsMeta + checkGroup groupId mlsMeta + applyProposal (convId conv) groupId (rmValue p) +applyProposalRef conv _mlsMeta groupId _epoch suite (Inline p) = do checkProposalCipherSuite suite p - applyProposal (convId conv) p + applyProposal (convId conv) groupId p applyProposal :: forall r. HasProposalEffects r => ConvId -> + GroupId -> Proposal -> Sem r ProposalAction -applyProposal convId (AddProposal kp) = do +applyProposal convId groupId (AddProposal kp) = do ref <- kpRef' kp & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal") mbClientIdentity <- getClientByKeyPackageRef ref clientIdentity <- case mbClientIdentity of @@ -995,16 +997,16 @@ applyProposal convId (AddProposal kp) = do let qcid = cidQualifiedClient cid let qusr = fst <$> qcid -- update mapping in galley - addMLSClients lconv qusr (Set.singleton (ciClient cid, ref)) + addMLSClients groupId qusr (Set.singleton (ciClient cid, ref)) pure cid -applyProposal _conv (RemoveProposal ref) = do +applyProposal _conv _groupId (RemoveProposal ref) = do qclient <- cidQualifiedClient <$> derefKeyPackage ref pure (paRemoveClient ((,ref) <$$> qclient)) -applyProposal _conv (ExternalInitProposal _) = +applyProposal _conv _groupId (ExternalInitProposal _) = -- only record the fact there was an external init proposal, but do not -- process it in any way. pure paExternalInitPresent -applyProposal _conv _ = pure mempty +applyProposal _conv _groupId _ = pure mempty checkProposalCipherSuite :: Members @@ -1040,15 +1042,14 @@ processProposal :: r => Qualified UserId -> Data.Conversation -> + ConversationMLSData -> Message 'MLSPlainText -> RawMLS Proposal -> Sem r () -processProposal qusr conv msg prop = do - checkEpoch (msgEpoch msg) conv - checkGroup (msgGroupId msg) conv - suiteTag <- - preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) conv - & noteS @'ConvNotFound +processProposal qusr conv mlsMeta msg prop = do + checkEpoch (msgEpoch msg) mlsMeta + checkGroup (msgGroupId msg) mlsMeta + let suiteTag = cnvmlsCipherSuite mlsMeta -- validate the proposal -- @@ -1162,12 +1163,12 @@ executeProposalAction :: Qualified UserId -> Maybe ConnId -> Local Data.Conversation -> + ConversationMLSData -> ClientMap -> ProposalAction -> Sem r [LocalConversationUpdate] -executeProposalAction qusr con lconv cm action = do - cs <- preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) (tUnqualified lconv) & noteS @'ConvNotFound - let ss = csSignatureScheme cs +executeProposalAction qusr con lconv mlsMeta cm action = do + let ss = csSignatureScheme (cnvmlsCipherSuite mlsMeta) newUserClients = Map.assocs (paAdd action) -- Note [client removal] @@ -1229,7 +1230,7 @@ executeProposalAction qusr con lconv cm action = do -- add clients in the conversation state for_ newUserClients $ \(qtarget, newClients) -> do - addMLSClients (fmap convId lconv) qtarget newClients + addMLSClients (cnvmlsGroupId mlsMeta) qtarget newClients -- remove users from the conversation and send events removeEvents <- foldMap removeMembers (nonEmpty membersToRemove) @@ -1237,7 +1238,7 @@ executeProposalAction qusr con lconv cm action = do -- Remove clients from the conversation state. This includes client removals -- of all types (see Note [client removal]). for_ (Map.assocs (paRemove action)) $ \(qtarget, clients) -> do - removeMLSClients (fmap convId lconv) qtarget (Set.map fst clients) + removeMLSClients (cnvmlsGroupId mlsMeta) qtarget (Set.map fst clients) pure (addEvents <> removeEvents) where @@ -1319,30 +1320,23 @@ getRemoteMLSClients rusr ss = do -- | Check if the epoch number matches that of a conversation checkEpoch :: Members - '[ ErrorS 'ConvNotFound, - ErrorS 'MLSStaleMessage + '[ ErrorS 'MLSStaleMessage ] r => Epoch -> - Data.Conversation -> + ConversationMLSData -> Sem r () -checkEpoch epoch conv = do - curEpoch <- - preview (to convProtocol . _ProtocolMLS . to cnvmlsEpoch) conv - & noteS @'ConvNotFound - unless (epoch == curEpoch) $ throwS @'MLSStaleMessage +checkEpoch epoch mlsMeta = do + unless (epoch == cnvmlsEpoch mlsMeta) $ throwS @'MLSStaleMessage -- | Check if the group ID matches that of a conversation checkGroup :: Member (ErrorS 'ConvNotFound) r => GroupId -> - Data.Conversation -> + ConversationMLSData -> Sem r () -checkGroup gId conv = do - groupId <- - preview (to convProtocol . _ProtocolMLS . to cnvmlsGroupId) conv - & noteS @'ConvNotFound - unless (gId == groupId) $ throwS @'ConvNotFound +checkGroup gId mlsMeta = do + unless (gId == cnvmlsGroupId mlsMeta) $ throwS @'ConvNotFound -------------------------------------------------------------------------------- -- Error handling of proposal execution diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index 4b66236c88e..f16edf2bd26 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -23,7 +23,6 @@ module Galley.API.MLS.Removal ) where -import Control.Comonad import Data.Id import qualified Data.Map as Map import Data.Qualified @@ -110,9 +109,10 @@ removeClient :: ClientId -> Sem r () removeClient lc qusr cid = do - cm <- lookupMLSClients (fmap Data.convId lc) - let cidAndKP = Set.toList . Set.map snd . Set.filter ((==) cid . fst) $ Map.findWithDefault mempty qusr cm - removeClientsWithClientMap lc cidAndKP cm qusr + for_ (cnvmlsGroupId <$> Data.mlsMetadata (tUnqualified lc)) $ \groupId -> do + cm <- lookupMLSClients groupId + let cidAndKP = Set.toList . Set.map snd . Set.filter ((==) cid . fst) $ Map.findWithDefault mempty qusr cm + removeClientsWithClientMap lc cidAndKP cm qusr -- | Send remove proposals for all clients of the user to clients in the ClientMap. -- @@ -156,5 +156,6 @@ removeUser :: Qualified UserId -> Sem r () removeUser lc qusr = do - cm <- lookupMLSClients (fmap Data.convId lc) - removeUserWithClientMap lc cm qusr + for_ (Data.mlsMetadata (tUnqualified lc)) $ \meta -> do + cm <- lookupMLSClients (cnvmlsGroupId meta) + removeUserWithClientMap lc cm qusr diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index 76377682ac8..ea4d501ef69 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 = 76 +schemaVersion = 77 diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 30a5a4c7dab..85b37b634eb 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -370,26 +370,26 @@ removeLocalMembersFromRemoteConv (qUntagged -> Qualified conv convDomain) victim setConsistency LocalQuorum for_ victims $ \u -> addPrepQuery Cql.deleteUserRemoteConv (u, convDomain, conv) -addMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -addMLSClients lcnv (Qualified usr domain) cs = retry x5 . batch $ do +addMLSClients :: GroupId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () +addMLSClients groupId (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) + addPrepQuery Cql.addMLSClient (groupId, domain, usr, c, kpr) -removeMLSClients :: Local ConvId -> Qualified UserId -> Set.Set ClientId -> Client () -removeMLSClients lcnv (Qualified usr domain) cs = retry x5 . batch $ do +removeMLSClients :: GroupId -> Qualified UserId -> Set.Set ClientId -> Client () +removeMLSClients groupId (Qualified usr domain) cs = retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum for_ cs $ \c -> - addPrepQuery Cql.removeMLSClient (tUnqualified lcnv, domain, usr, c) + addPrepQuery Cql.removeMLSClient (groupId, domain, usr, c) -lookupMLSClients :: Local ConvId -> Client ClientMap -lookupMLSClients lcnv = +lookupMLSClients :: GroupId -> Client ClientMap +lookupMLSClients groupId = mkClientMap <$> retry x5 - (query Cql.lookupMLSClients (params LocalQuorum (Identity (tUnqualified lcnv)))) + (query Cql.lookupMLSClients (params LocalQuorum (Identity groupId))) interpretMemberStoreToCassandra :: Members '[Embed IO, Input ClientState] r => diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 2dabd2ab727..ce8ec549730 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -438,14 +438,14 @@ rmMemberClient c = -- MLS Clients -------------------------------------------------------------- -addMLSClient :: PrepQuery W (ConvId, Domain, UserId, ClientId, KeyPackageRef) () -addMLSClient = "insert into member_client (conv, user_domain, user, client, key_package_ref) values (?, ?, ?, ?, ?)" +addMLSClient :: PrepQuery W (GroupId, Domain, UserId, ClientId, KeyPackageRef) () +addMLSClient = "insert into mls_group_member_client (group_id, user_domain, user, client, key_package_ref) values (?, ?, ?, ?, ?)" -removeMLSClient :: PrepQuery W (ConvId, Domain, UserId, ClientId) () -removeMLSClient = "delete from member_client where conv = ? and user_domain = ? and user = ? and client = ?" +removeMLSClient :: PrepQuery W (GroupId, Domain, UserId, ClientId) () +removeMLSClient = "delete from mls_group_member_client where group_id = ? and user_domain = ? and user = ? and client = ?" -lookupMLSClients :: PrepQuery R (Identity ConvId) (Domain, UserId, ClientId, KeyPackageRef) -lookupMLSClients = "select user_domain, user, client, key_package_ref from member_client where conv = ?" +lookupMLSClients :: PrepQuery R (Identity GroupId) (Domain, UserId, ClientId, KeyPackageRef) +lookupMLSClients = "select user_domain, user, client, key_package_ref from mls_group_member_client where group_id = ?" 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 b93bd616c57..a8ad662a210 100644 --- a/services/galley/src/Galley/Data/Conversation/Types.hs +++ b/services/galley/src/Galley/Data/Conversation/Types.hs @@ -43,3 +43,9 @@ data NewConversation = NewConversation ncUsers :: UserList (UserId, RoleName), ncProtocol :: ProtocolTag } + +mlsMetadata :: Conversation -> Maybe ConversationMLSData +mlsMetadata conv = + case convProtocol conv of + ProtocolProteus -> Nothing + ProtocolMLS meta -> pure meta diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs index 1bd42b55338..f9f5b57d505 100644 --- a/services/galley/src/Galley/Effects/MemberStore.hs +++ b/services/galley/src/Galley/Effects/MemberStore.hs @@ -57,6 +57,7 @@ import Galley.Types.UserList import Imports import Polysemy import Wire.API.Conversation.Member hiding (Member) +import Wire.API.MLS.Group import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service @@ -74,10 +75,10 @@ data MemberStore m a where SetOtherMember :: Local ConvId -> Qualified UserId -> OtherMemberUpdate -> MemberStore m () 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 -> MemberStore m () + AddMLSClients :: GroupId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () + RemoveMLSClients :: GroupId -> Qualified UserId -> Set ClientId -> MemberStore m () LookupMLSClients :: - Local ConvId -> + GroupId -> MemberStore m (Map (Qualified UserId) (Set (ClientId, KeyPackageRef))) makeSem ''MemberStore