diff --git a/libs/wire-api/src/Wire/API/MLS/Proposal.hs b/libs/wire-api/src/Wire/API/MLS/Proposal.hs index c0c69ae1eaf..cef7ca42005 100644 --- a/libs/wire-api/src/Wire/API/MLS/Proposal.hs +++ b/libs/wire-api/src/Wire/API/MLS/Proposal.hs @@ -24,14 +24,13 @@ import Cassandra import Control.Lens (makePrisms) import Data.Binary import Data.Binary.Get -import Data.Binary.Put -import qualified Data.ByteString.Lazy as LBS import Imports import Wire.API.MLS.CipherSuite import Wire.API.MLS.Context import Wire.API.MLS.Extension import Wire.API.MLS.Group import Wire.API.MLS.KeyPackage +import Wire.API.MLS.LeafNode import Wire.API.MLS.ProposalTag import Wire.API.MLS.ProtocolVersion import Wire.API.MLS.Serialisation @@ -39,10 +38,10 @@ import Wire.Arbitrary data Proposal = AddProposal (RawMLS KeyPackage) - | UpdateProposal KeyPackage - | RemoveProposal KeyPackageRef - | PreSharedKeyProposal PreSharedKeyID -- TODO - | ReInitProposal ReInit + | UpdateProposal (RawMLS LeafNode) + | RemoveProposal Word32 + | PreSharedKeyProposal (RawMLS PreSharedKeyID) + | ReInitProposal (RawMLS ReInit) | ExternalInitProposal ByteString | GroupContextExtensionsProposal [Extension] deriving stock (Eq, Show) @@ -59,12 +58,28 @@ instance ParseMLS Proposal where GroupContextExtensionsProposalTag -> GroupContextExtensionsProposal <$> parseMLSVector @VarInt parseMLS -mkRemoveProposal :: KeyPackageRef -> RawMLS Proposal -mkRemoveProposal ref = RawMLS bytes (RemoveProposal ref) - where - bytes = LBS.toStrict . runPut $ do - serialiseMLS RemoveProposalTag - serialiseMLS ref +instance SerialiseMLS Proposal where + serialiseMLS (AddProposal kp) = do + serialiseMLS AddProposalTag + serialiseMLS kp + serialiseMLS (UpdateProposal ln) = do + serialiseMLS UpdateProposalTag + serialiseMLS ln + serialiseMLS (RemoveProposal i) = do + serialiseMLS RemoveProposalTag + serialiseMLS i + serialiseMLS (PreSharedKeyProposal k) = do + serialiseMLS PreSharedKeyProposalTag + serialiseMLS k + serialiseMLS (ReInitProposal ri) = do + serialiseMLS ReInitProposalTag + serialiseMLS ri + serialiseMLS (ExternalInitProposal ko) = do + serialiseMLS ExternalInitProposalTag + serialiseMLSBytes @VarInt ko + serialiseMLS (GroupContextExtensionsProposal es) = do + serialiseMLS GroupContextExtensionsProposalTag + serialiseMLSVector @VarInt serialiseMLS es -- | Compute the proposal ref given a ciphersuite and the raw proposal data. proposalRef :: CipherSuiteTag -> RawMLS Proposal -> ProposalRef diff --git a/libs/wire-api/src/Wire/API/MLS/Welcome.hs b/libs/wire-api/src/Wire/API/MLS/Welcome.hs index 117d9492dcd..cacb183cba0 100644 --- a/libs/wire-api/src/Wire/API/MLS/Welcome.hs +++ b/libs/wire-api/src/Wire/API/MLS/Welcome.hs @@ -22,13 +22,11 @@ import Imports import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.KeyPackage -import Wire.API.MLS.ProtocolVersion import Wire.API.MLS.Serialisation import Wire.Arbitrary data Welcome = Welcome - { welProtocolVersion :: ProtocolVersion, - welCipherSuite :: CipherSuite, + { welCipherSuite :: CipherSuite, welSecrets :: [GroupSecrets], welGroupInfo :: ByteString } @@ -41,14 +39,12 @@ instance S.ToSchema Welcome where instance ParseMLS Welcome where parseMLS = Welcome - <$> parseMLS @ProtocolVersion - <*> parseMLS + <$> parseMLS <*> parseMLSVector @VarInt parseMLS <*> parseMLSBytes @VarInt instance SerialiseMLS Welcome where - serialiseMLS (Welcome pv cs ss gi) = do - serialiseMLS pv + serialiseMLS (Welcome cs ss gi) = do serialiseMLS cs serialiseMLSVector @VarInt serialiseMLS ss serialiseMLSBytes @VarInt gi diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index 0cc901f3a88..6a2dd5949a7 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs @@ -344,7 +344,6 @@ type ConversationAPI = :> CanThrow 'MissingLegalholdConsent :> Description "This returns 201 when a new conversation is created, and 200 when the conversation already existed" :> ZLocalUser - :> ZOptClient :> ZOptConn :> "conversations" :> VersionedReqBody 'V2 '[Servant.JSON] NewConv @@ -366,7 +365,6 @@ type ConversationAPI = :> CanThrow 'MissingLegalholdConsent :> Description "This returns 201 when a new conversation is created, and 200 when the conversation already existed" :> ZLocalUser - :> ZOptClient :> ZOptConn :> "conversations" :> ReqBody '[Servant.JSON] NewConv diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs index ec5d4b5c522..9a755bcf298 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs @@ -121,7 +121,9 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do usr <- flip Qualified (Domain "example.com") <$> (Id <$> UUID.nextRandom) pure (userClientQid usr c) void . liftIO $ spawn (cli qcid2 tmp ["init", qcid2]) Nothing - kp <- liftIO $ decodeMLSError <$> spawn (cli qcid2 tmp ["key-package", "create"]) Nothing + kp :: RawMLS KeyPackage <- + liftIO $ + decodeMLSError <$> spawn (cli qcid2 tmp ["key-package", "create"]) Nothing liftIO $ BS.writeFile (tmp qcid2) (rmRaw kp) let groupFilename = "group" @@ -132,7 +134,7 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do secretKey <- Ed25519.generateSecretKey let publicKey = Ed25519.toPublic secretKey - let proposal = mkRemoveProposal (fromJust (kpRef' kp)) + let proposal = mkRawMLS (RemoveProposal (error "TODO: remove proposal")) let message = mkSignedMessage secretKey diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs index 0ffa420aa9f..894f176d9ef 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs @@ -147,7 +147,7 @@ newtype RemoveProposalPayload = RemoveProposalPayload {unRemoveProposalPayload : deriving newtype (ParseMLS, SerialiseMLS, Eq, Show) instance Arbitrary RemoveProposalPayload where - arbitrary = RemoveProposalPayload . FramedContentProposal . mkRemoveProposal <$> arbitrary + arbitrary = RemoveProposalPayload . FramedContentProposal . mkRawMLS . RemoveProposal <$> arbitrary instance ArbitraryFramedContentData RemoveProposalPayload where arbitraryFramedContentData = unRemoveProposalPayload <$> arbitrary diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index d09b56a05aa..a29a3699654 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -590,6 +590,7 @@ executable galley-schema V78_TeamFeatureOutlookCalIntegration V79_TeamFeatureMlsE2EId V80_MLSSubconversation + V81_MLSDraft17 hs-source-dirs: schema/src default-extensions: TemplateHaskell diff --git a/services/galley/schema/src/Run.hs b/services/galley/schema/src/Run.hs index 5d586e6cd42..01a9b77b803 100644 --- a/services/galley/schema/src/Run.hs +++ b/services/galley/schema/src/Run.hs @@ -83,6 +83,7 @@ import qualified V77_MLSGroupMemberClient import qualified V78_TeamFeatureOutlookCalIntegration import qualified V79_TeamFeatureMlsE2EId import qualified V80_MLSSubconversation +import qualified V81_MLSDraft17 main :: IO () main = do @@ -151,7 +152,8 @@ main = do V77_MLSGroupMemberClient.migration, V78_TeamFeatureOutlookCalIntegration.migration, V79_TeamFeatureMlsE2EId.migration, - V80_MLSSubconversation.migration + V80_MLSSubconversation.migration, + V81_MLSDraft17.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/V81_MLSDraft17.hs b/services/galley/schema/src/V81_MLSDraft17.hs new file mode 100644 index 00000000000..bbc31c54f51 --- /dev/null +++ b/services/galley/schema/src/V81_MLSDraft17.hs @@ -0,0 +1,31 @@ +-- 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 V81_MLSDraft17 (migration) where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 81 "Upgrade to MLS draft 17 structures" $ do + schema' + [r| ALTER TABLE mls_group_member_client + ADD (leaf_node_index int + ); + |] diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 514e7ae9b5a..82c0b65d343 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -55,7 +55,6 @@ import Data.Singletons import Data.Time.Clock import Galley.API.Error import Galley.API.MLS.Removal -import Galley.API.MLS.Types (cmAssocs) import Galley.API.Util import Galley.App import Galley.Data.Conversation @@ -342,9 +341,6 @@ performAction tag origUser lconv action = do pure (mempty, action) SConversationDeleteTag -> do let deleteGroup groupId = do - cm <- E.lookupMLSClients groupId - let refs = cm & cmAssocs & map (snd . snd) - E.deleteKeyPackageRefs refs E.removeAllMLSClients groupId E.deleteAllProposals groupId diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 0fb2457b465..e6fb1b873f9 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -41,7 +41,6 @@ import Data.Time import qualified Data.UUID.Tagged as U import Galley.API.Error import Galley.API.MLS -import Galley.API.MLS.KeyPackage (nullKeyPackageRef) import Galley.API.MLS.Keys (getMLSRemovalKey) import Galley.API.Mapping import Galley.API.One2One @@ -86,7 +85,6 @@ import Wire.API.Team.Permission hiding (self) createGroupConversation :: ( Member BrigAccess r, Member ConversationStore r, - Member MemberStore r, Member (ErrorS 'ConvAccessDenied) r, Member (Error InternalError) r, Member (Error InvalidInput) r, @@ -95,7 +93,6 @@ createGroupConversation :: Member (ErrorS 'NotConnected) r, Member (ErrorS 'MLSNotEnabled) r, Member (ErrorS 'MLSNonEmptyMemberList) r, - Member (ErrorS 'MLSMissingSenderClient) r, Member (ErrorS 'MissingLegalholdConsent) r, Member FederatorAccess r, Member GundeckAccess r, @@ -107,11 +104,10 @@ createGroupConversation :: Member P.TinyLog r ) => Local UserId -> - Maybe ClientId -> Maybe ConnId -> NewConv -> Sem r ConversationResponse -createGroupConversation lusr mCreatorClient mConn newConv = do +createGroupConversation lusr mConn newConv = do (nc, fromConvSize -> allUsers) <- newRegularConversation lusr newConv let tinfo = newConvTeam newConv checkCreateConvPermissions lusr newConv tinfo allUsers @@ -132,13 +128,6 @@ createGroupConversation lusr mCreatorClient mConn newConv = do -- conversation is already in the database. conv <- E.createConversation lcnv nc - -- set creator client for MLS conversations - case (convProtocol conv, mCreatorClient) of - (ProtocolProteus, _) -> pure () - (ProtocolMLS mlsMeta, Just c) -> - E.addMLSClients (cnvmlsGroupId mlsMeta) (tUntagged lusr) (Set.singleton (c, nullKeyPackageRef)) - (ProtocolMLS _mlsMeta, Nothing) -> throwS @'MLSMissingSenderClient - now <- input -- NOTE: We only send (conversation) events to members of the conversation notifyCreatedConversation (Just now) lusr mConn conv diff --git a/services/galley/src/Galley/API/MLS/Conversation.hs b/services/galley/src/Galley/API/MLS/Conversation.hs index fb2396d9c83..9202755c0f7 100644 --- a/services/galley/src/Galley/API/MLS/Conversation.hs +++ b/services/galley/src/Galley/API/MLS/Conversation.hs @@ -42,7 +42,8 @@ mkMLSConversation conv = mcLocalMembers = Data.convLocalMembers conv, mcRemoteMembers = Data.convRemoteMembers conv, mcMLSData = mlsData, - mcMembers = cm + mcMembers = cm, + mcIndexMap = mempty -- TODO } mcConv :: MLSConversation -> Data.Conversation diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index e3f2dbec237..83d3a03ac8f 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -47,7 +47,6 @@ import Galley.API.Action import Galley.API.Error import Galley.API.MLS.Conversation import Galley.API.MLS.Enabled -import Galley.API.MLS.KeyPackage import Galley.API.MLS.Propagate import Galley.API.MLS.Removal import Galley.API.MLS.Types @@ -100,9 +99,14 @@ import Wire.API.Message import Wire.API.User.Client -- TODO: --- [ ] replace ref with index in remove proposals +-- [x] replace ref with index in remove proposals -- [ ] validate leaf nodes and key packages locally on galley -- [ ] remove MissingSenderClient error +-- [ ] PreSharedKey proposal +-- [ ] remove all key package ref mapping +-- [ ] initialise index maps +-- [ ] newtype for leaf node indices +-- [ ] compute new indices for add proposals data IncomingMessage = IncomingMessage { epoch :: Epoch, @@ -338,13 +342,13 @@ postMLSCommitBundleToLocalConv qusr c conn bundle lConvOrSubId = do senderIdentity <- getSenderIdentity qusr c (Just bundle.sender) action <- getCommitData lConvOrSub bundle.epoch bundle.commit.rmValue - -- check that the welcome message matches the action - for_ bundle.welcome $ \welcome -> - when - ( Set.fromList (map gsNewMember (welSecrets (rmValue welcome))) - /= Set.fromList (map (snd . snd) (cmAssocs (paAdd action))) - ) - $ throwS @'MLSWelcomeMismatch + -- TODO: check that the welcome message matches the action + -- for_ bundle.welcome $ \welcome -> + -- when + -- ( Set.fromList (map gsNewMember (welSecrets (rmValue welcome))) + -- /= Set.fromList (map (snd . snd) (cmAssocs (paAdd action))) + -- ) + -- $ throwS @'MLSWelcomeMismatch events <- processCommitWithAction senderIdentity @@ -461,7 +465,6 @@ postMLSMessageToLocalConv :: ( HasProposalEffects r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'MissingLegalholdConsent) r, - Member (ErrorS 'MLSClientSenderUserMismatch) r, Member (ErrorS 'MLSCommitMissingReferences) r, Member (ErrorS 'MLSProposalNotFound) r, Member (ErrorS 'MLSSelfRemovalNotAllowed) r, @@ -579,11 +582,11 @@ instance Semigroup ProposalAction where instance Monoid ProposalAction where mempty = ProposalAction mempty mempty mempty -paAddClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction -paAddClient quc = mempty {paAdd = Map.singleton (fmap fst quc) (uncurry Map.singleton (snd (qUnqualified quc)))} +paAddClient :: ClientIdentity -> Word32 -> ProposalAction +paAddClient cid idx = mempty {paAdd = cmSingleton cid idx} -paRemoveClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction -paRemoveClient quc = mempty {paRemove = Map.singleton (fmap fst quc) (uncurry Map.singleton (snd (qUnqualified quc)))} +paRemoveClient :: ClientIdentity -> Word32 -> ProposalAction +paRemoveClient cid idx = mempty {paRemove = cmSingleton cid idx} paExternalInitPresent :: ProposalAction paExternalInitPresent = mempty {paExternalInit = Any True} @@ -613,7 +616,6 @@ processCommit :: ( HasProposalEffects r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'MissingLegalholdConsent) r, - Member (ErrorS 'MLSClientSenderUserMismatch) r, Member (ErrorS 'MLSCommitMissingReferences) r, Member (ErrorS 'MLSProposalNotFound) r, Member (ErrorS 'MLSSelfRemovalNotAllowed) r, @@ -639,8 +641,6 @@ processExternalCommit :: Member ConversationStore r, Member (Error MLSProtocolError) r, Member (ErrorS 'ConvNotFound) r, - Member (ErrorS 'MLSClientSenderUserMismatch) r, - Member (ErrorS 'MLSKeyPackageRefNotFound) r, Member (ErrorS 'MLSStaleMessage) r, Member (ErrorS 'MLSSubConvClientNotInParent) r, Member ExternalAccess r, @@ -660,82 +660,73 @@ processExternalCommit :: ProposalAction -> Maybe UpdatePath -> Sem r () -processExternalCommit senderIdentity lConvOrSub epoch action updatePath = - withCommitLock (cnvmlsGroupId . mlsMetaConvOrSub . tUnqualified $ lConvOrSub) epoch $ do - let convOrSub = tUnqualified lConvOrSub - leafNode <- - 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" - - -- validate and update mapping in brig - validateLeafNode senderIdentity leafNode >>= \case - Left errMsg -> - throw $ - mlsProtocolError ("Tried to add invalid LeafNode: " <> errMsg) - Right _ -> pure () - - -- only members can join a subconversation - forOf_ _SubConv convOrSub $ \(mlsConv, _) -> - unless (isClientMember senderIdentity (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) (cidQualifiedUser senderIdentity) - unless (cidQualifiedUser senderIdentity == cidQualifiedUser remCid) - . throw - . mlsProtocolError - $ "The external commit attempts to remove a client from a user other than themselves" - pure (Just r) +processExternalCommit senderIdentity lConvOrSub epoch action updatePath = do + let convOrSub = tUnqualified lConvOrSub + leafNode <- + 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" + + -- validate and update mapping in brig + validateLeafNode senderIdentity leafNode >>= \case + Left errMsg -> + throw $ + mlsProtocolError ("Tried to add invalid LeafNode: " <> errMsg) + Right _ -> pure () + + -- only members can join a subconversation + forOf_ _SubConv convOrSub $ \(mlsConv, _) -> + unless (isClientMember senderIdentity (mcMembers mlsConv)) $ + throwS @'MLSSubConvClientNotInParent + + let groupId = cnvmlsGroupId (mlsMetaConvOrSub convOrSub) + + withCommitLock groupId epoch $ do + -- validate remove proposal: an external commit can contain + -- + -- > At most one Remove proposal, with which the joiner removes an old + -- > version of themselves + remIndex <- case cmAssocs (paRemove action) of + [] -> pure Nothing + [(_, idx :: Word32)] -> do + cid <- + note (mlsProtocolError "Invalid index in remove proposal") $ + indexToClient (indicesConvOrSub convOrSub) idx + unless (cid == senderIdentity) $ + throw $ + mlsProtocolError "Only the self client can be removed by an external commit" + pure (Just idx) + _ -> throw (mlsProtocolError "Multiple remove proposals in external commits not allowed") -- increment epoch number lConvOrSub' <- for lConvOrSub incrementEpoch -- fetch backend remove proposals of the previous epoch - kpRefs <- + indicesInRemoveProposals <- -- skip remove proposals of already removed by the external commit - filter (maybe (const True) (/=) remRef) - <$> getPendingBackendRemoveProposals (cnvmlsGroupId . mlsMetaConvOrSub . tUnqualified $ lConvOrSub') epoch + filter (maybe (const True) (/=) remIndex) + <$> getPendingBackendRemoveProposals groupId epoch + -- requeue backend remove proposals for the current epoch let cm = membersConvOrSub (tUnqualified lConvOrSub') - createAndSendRemoveProposals lConvOrSub' kpRefs (cidQualifiedUser senderIdentity) cm - where - derefUser :: ClientMap -> Qualified UserId -> Sem r (ClientIdentity, KeyPackageRef) - derefUser cm user = case Map.assocs cm of - [(u, clients)] -> do - unless (user == u) $ - throwS @'MLSClientSenderUserMismatch - ref <- ensureSingleton clients - ci <- derefKeyPackage ref - unless (cidQualifiedUser ci == user) $ - throwS @'MLSClientSenderUserMismatch - pure (ci, ref) - _ -> throwRemProposal - ensureSingleton :: Map k a -> Sem r a - ensureSingleton m = case Map.elems m of - [e] -> pure e - _ -> throwRemProposal - throwRemProposal = - throw . mlsProtocolError $ - "The external commit must have at most one remove proposal" + createAndSendRemoveProposals + lConvOrSub' + indicesInRemoveProposals + (cidQualifiedUser senderIdentity) + cm processCommitWithAction :: forall r. ( HasProposalEffects r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'MissingLegalholdConsent) r, - Member (ErrorS 'MLSClientSenderUserMismatch) r, Member (ErrorS 'MLSCommitMissingReferences) r, Member (ErrorS 'MLSSelfRemovalNotAllowed) r, Member (ErrorS 'MLSStaleMessage) r, @@ -828,26 +819,16 @@ applyProposal :: GroupId -> Proposal -> Sem r ProposalAction -applyProposal _convOrSubConvId 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 - Nothing -> do - -- TODO: validate key package - cid <- - either - (\_ -> throw (mlsProtocolError "Invalid key package in an Add proposal")) - pure - $ keyPackageIdentity kp.rmValue - addMLSClients groupId (cidQualifiedUser cid) (Set.singleton (ciClient cid, ref)) - pure cid - Just cid -> - -- ad-hoc add proposal in commit, the key package has been claimed before - pure cid - pure (paAddClient . (<$$>) (,ref) . cidQualifiedClient $ clientIdentity) -applyProposal _convOrSubConvId _groupId (RemoveProposal ref) = do - qclient <- cidQualifiedClient <$> derefKeyPackage ref - pure (paRemoveClient ((,ref) <$$> qclient)) +applyProposal _convOrSubConvId _groupId (AddProposal kp) = do + let idx = error "TODO: compute new index" + -- TODO: validate key package + cid <- getKeyPackageIdentity kp.rmValue + -- TODO: we probably should not update the conversation state here + -- addMLSClients groupId (cidQualifiedUser cid) (Set.singleton (ciClient cid, idx)) + pure (paAddClient cid idx) +applyProposal _convOrSubConvId _groupId (RemoveProposal idx) = do + let cid = error "TODO: lookup in index map" + pure (paRemoveClient cid idx) applyProposal _convOrSubConvId _groupId (ExternalInitProposal _) = -- only record the fact there was an external init proposal, but do not -- process it in any way. @@ -947,11 +928,7 @@ checkExternalProposalUser qusr prop = do loc ( \lusr -> case prop of AddProposal kp -> do - ClientIdentity {ciUser, ciClient} <- - either - (const $ throwS @'MLSUnsupportedProposal) - pure - (keyPackageIdentity kp.rmValue) + ClientIdentity {ciUser, ciClient} <- getKeyPackageIdentity kp.rmValue -- requesting user must match key package owner when (tUnqualified lusr /= ciUser) $ throwS @'MLSUnsupportedProposal -- client referenced in key package must be one of the user's clients @@ -1186,6 +1163,14 @@ removeMembers qusr con lconvOrSub users = case tUnqualified lconvOrSub of $ users SubConv _ _ -> pure [] +getKeyPackageIdentity :: + Member (ErrorS 'MLSUnsupportedProposal) r => + KeyPackage -> + Sem r ClientIdentity +getKeyPackageIdentity = + either (\_ -> throwS @'MLSUnsupportedProposal) pure + . keyPackageIdentity + handleNoChanges :: Monoid a => Sem (Error NoChanges ': r) a -> Sem r a handleNoChanges = fmap fold . runError diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index 42ead7c84a9..90b8b54a2c1 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -43,7 +43,6 @@ import Polysemy.TinyLog import qualified System.Logger as Log import Wire.API.Conversation.Protocol import Wire.API.MLS.Credential -import Wire.API.MLS.KeyPackage import Wire.API.MLS.Message import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation @@ -61,7 +60,7 @@ createAndSendRemoveProposals :: Foldable t ) => Local ConvOrSubConv -> - t KeyPackageRef -> + t Word32 -> Qualified UserId -> -- | The client map that has all the recipients of the message. This is an -- argument, and not constructed within the function, because of a special @@ -71,15 +70,15 @@ createAndSendRemoveProposals :: -- conversation/subconversation client maps. ClientMap -> Sem r () -createAndSendRemoveProposals lConvOrSubConv cs qusr cm = do +createAndSendRemoveProposals lConvOrSubConv indices qusr cm = do let meta = mlsMetaConvOrSub (tUnqualified lConvOrSubConv) mKeyPair <- getMLSRemovalKey case mKeyPair of Nothing -> do warn $ Log.msg ("No backend removal key is configured (See 'mlsPrivateKeyPaths' in galley's config). Not able to remove client from MLS conversation." :: Text) Just (secKey, pubKey) -> do - for_ cs $ \kpref -> do - let proposal = mkRemoveProposal kpref + for_ indices $ \idx -> do + let proposal = mkRawMLS (RemoveProposal idx) msg = mkSignedMessage secKey @@ -111,13 +110,13 @@ removeClientsWithClientMapRecursively :: Foldable f ) => Local MLSConversation -> - (ConvOrSubConv -> f KeyPackageRef) -> + (ConvOrSubConv -> f Word32) -> Qualified UserId -> Sem r () -removeClientsWithClientMapRecursively lMlsConv getKPs qusr = do +removeClientsWithClientMapRecursively lMlsConv getIndices qusr = do let mainConv = fmap Conv lMlsConv cm = mcMembers (tUnqualified lMlsConv) - createAndSendRemoveProposals mainConv (getKPs (tUnqualified mainConv)) qusr cm + createAndSendRemoveProposals mainConv (getIndices (tUnqualified mainConv)) qusr cm -- remove this client from all subconversations subs <- listSubConversations' (mcId (tUnqualified lMlsConv)) @@ -126,7 +125,7 @@ removeClientsWithClientMapRecursively lMlsConv getKPs qusr = do createAndSendRemoveProposals subConv - (getKPs (tUnqualified subConv)) + (getIndices (tUnqualified subConv)) qusr cm @@ -149,8 +148,8 @@ removeClient :: removeClient lc qusr cid = do mMlsConv <- mkMLSConversation (tUnqualified lc) for_ mMlsConv $ \mlsConv -> do - let getKPs = cmLookupRef (mkClientIdentity qusr cid) . membersConvOrSub - removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getKPs qusr + let getIndices = cmLookupIndex (mkClientIdentity qusr cid) . membersConvOrSub + removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getIndices qusr -- | Send remove proposals for all clients of the user to the local conversation. removeUser :: diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs index d22bad99d5e..59b35b260a8 100644 --- a/services/galley/src/Galley/API/MLS/SubConversation.hs +++ b/services/galley/src/Galley/API/MLS/SubConversation.hs @@ -142,7 +142,8 @@ getLocalSubConversation qusr lconv sconv = do cnvmlsEpochTimestamp = Nothing, cnvmlsCipherSuite = suite }, - scMembers = mkClientMap [] + scMembers = mkClientMap [], + scIndexMap = mempty -- TODO } pure sub Just sub -> pure sub @@ -423,9 +424,9 @@ leaveLocalSubConversation cid lcnv sub = do subConv <- noteS @'ConvNotFound =<< Eff.getSubConversation (tUnqualified lcnv) sub - kp <- + idx <- note (mlsProtocolError "Client is not a member of the subconversation") $ - cmLookupRef cid (scMembers subConv) + cmLookupIndex cid (scMembers subConv) -- remove the leaver from the member list let (gid, epoch) = (cnvmlsGroupId &&& cnvmlsEpoch) (scMLSData subConv) Eff.removeMLSClients gid (cidQualifiedUser cid) . Set.singleton . ciClient $ cid @@ -440,7 +441,7 @@ leaveLocalSubConversation cid lcnv sub = do else createAndSendRemoveProposals (qualifyAs lcnv (SubConv mlsConv subConv)) - (Identity kp) + (Identity idx) (cidQualifiedUser cid) cm diff --git a/services/galley/src/Galley/API/MLS/Types.hs b/services/galley/src/Galley/API/MLS/Types.hs index 69f0f795a00..e4d1d3254d2 100644 --- a/services/galley/src/Galley/API/MLS/Types.hs +++ b/services/galley/src/Galley/API/MLS/Types.hs @@ -20,6 +20,8 @@ module Galley.API.MLS.Types where import Data.Domain import Data.Id +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap import qualified Data.Map as Map import Data.Qualified import Galley.Types.Conversations.Members @@ -27,20 +29,26 @@ import Imports import Wire.API.Conversation import Wire.API.Conversation.Protocol import Wire.API.MLS.Credential -import Wire.API.MLS.KeyPackage import Wire.API.MLS.SubConversation -type ClientMap = Map (Qualified UserId) (Map ClientId KeyPackageRef) +newtype IndexMap = IndexMap {unIndexMap :: IntMap ClientIdentity} + deriving (Eq, Show) + deriving newtype (Semigroup, Monoid) + +indexToClient :: IndexMap -> Word32 -> Maybe ClientIdentity +indexToClient m i = IntMap.lookup (fromIntegral i) (unIndexMap m) + +type ClientMap = Map (Qualified UserId) (Map ClientId Word32) -mkClientMap :: [(Domain, UserId, ClientId, KeyPackageRef)] -> ClientMap +mkClientMap :: [(Domain, UserId, ClientId, Int32)] -> ClientMap mkClientMap = foldr addEntry mempty where - addEntry :: (Domain, UserId, ClientId, KeyPackageRef) -> ClientMap -> ClientMap - addEntry (dom, usr, c, kpr) = - Map.insertWith (<>) (Qualified usr dom) (Map.singleton c kpr) + addEntry :: (Domain, UserId, ClientId, Int32) -> ClientMap -> ClientMap + addEntry (dom, usr, c, kpi) = + Map.insertWith (<>) (Qualified usr dom) (Map.singleton c (fromIntegral kpi)) -cmLookupRef :: ClientIdentity -> ClientMap -> Maybe KeyPackageRef -cmLookupRef cid cm = do +cmLookupIndex :: ClientIdentity -> ClientMap -> Maybe Word32 +cmLookupIndex cid cm = do clients <- Map.lookup (cidQualifiedUser cid) cm Map.lookup (ciClient cid) clients @@ -54,13 +62,19 @@ cmRemoveClient cid cm = case Map.lookup (cidQualifiedUser cid) cm of else Map.insert (cidQualifiedUser cid) clients' cm isClientMember :: ClientIdentity -> ClientMap -> Bool -isClientMember ci = isJust . cmLookupRef ci +isClientMember ci = isJust . cmLookupIndex ci -cmAssocs :: ClientMap -> [(Qualified UserId, (ClientId, KeyPackageRef))] +cmAssocs :: ClientMap -> [(ClientIdentity, Word32)] cmAssocs cm = do (quid, clients) <- Map.assocs cm - (clientId, ref) <- Map.assocs clients - pure (quid, (clientId, ref)) + (clientId, idx) <- Map.assocs clients + pure (mkClientIdentity quid clientId, idx) + +cmSingleton :: ClientIdentity -> Word32 -> ClientMap +cmSingleton cid idx = + Map.singleton + (cidQualifiedUser cid) + (Map.singleton (ciClient cid) idx) -- | Inform a handler for 'POST /conversations/list-ids' if the MLS global team -- conversation and the MLS self-conversation should be included in the @@ -74,7 +88,8 @@ data MLSConversation = MLSConversation mcMLSData :: ConversationMLSData, mcLocalMembers :: [LocalMember], mcRemoteMembers :: [RemoteMember], - mcMembers :: ClientMap + mcMembers :: ClientMap, + mcIndexMap :: IndexMap } deriving (Show) @@ -82,13 +97,14 @@ data SubConversation = SubConversation { scParentConvId :: ConvId, scSubConvId :: SubConvId, scMLSData :: ConversationMLSData, - scMembers :: ClientMap + scMembers :: ClientMap, + scIndexMap :: IndexMap } deriving (Eq, Show) toPublicSubConv :: Qualified SubConversation -> PublicSubConversation toPublicSubConv (Qualified (SubConversation {..}) domain) = - let members = fmap (\(quid, (cid, _kp)) -> mkClientIdentity quid cid) (cmAssocs scMembers) + let members = map fst (cmAssocs scMembers) in PublicSubConversation { pscParentConvId = Qualified scParentConvId domain, pscSubConvId = scSubConvId, @@ -109,6 +125,10 @@ membersConvOrSub :: ConvOrSubConv -> ClientMap membersConvOrSub (Conv c) = mcMembers c membersConvOrSub (SubConv _ s) = scMembers s +indicesConvOrSub :: ConvOrSubConv -> IndexMap +indicesConvOrSub (Conv c) = mcIndexMap c +indicesConvOrSub (SubConv _ s) = scIndexMap s + convOfConvOrSub :: ConvOrSubChoice c s -> c convOfConvOrSub (Conv c) = c convOfConvOrSub (SubConv c _) = c diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index 55e7557843f..4585dd8e96b 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -37,7 +37,6 @@ import Wire.API.Error import Wire.API.Error.Galley import Wire.API.MLS.Epoch import Wire.API.MLS.Group -import Wire.API.MLS.KeyPackage import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation @@ -64,7 +63,7 @@ getPendingBackendRemoveProposals :: ) => GroupId -> Epoch -> - Sem r [KeyPackageRef] + Sem r [Word32] getPendingBackendRemoveProposals gid epoch = do proposals <- getAllPendingProposals gid epoch catMaybes @@ -72,7 +71,7 @@ getPendingBackendRemoveProposals gid epoch = do proposals ( \case (Just ProposalOriginBackend, proposal) -> case rmValue proposal of - RemoveProposal kp -> pure . Just $ kp + RemoveProposal i -> pure (Just i) _ -> pure Nothing (Just ProposalOriginClient, _) -> pure Nothing (Nothing, _) -> do diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 7665edb26e2..7d0eee82608 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -48,7 +48,6 @@ import qualified UnliftIO import Wire.API.Conversation.Member hiding (Member) import Wire.API.Conversation.Role import Wire.API.MLS.Group -import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service -- | Add members to a local conversation. @@ -342,12 +341,12 @@ removeLocalMembersFromRemoteConv (tUntagged -> Qualified conv convDomain) victim setConsistency LocalQuorum for_ victims $ \u -> addPrepQuery Cql.deleteUserRemoteConv (u, convDomain, conv) -addMLSClients :: GroupId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () +addMLSClients :: GroupId -> Qualified UserId -> Set.Set (ClientId, Word32) -> Client () addMLSClients groupId (Qualified usr domain) cs = retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum - for_ cs $ \(c, kpr) -> - addPrepQuery Cql.addMLSClient (groupId, domain, usr, c, kpr) + for_ cs $ \(c, idx) -> + addPrepQuery Cql.addMLSClient (groupId, domain, usr, c, fromIntegral idx) removeMLSClients :: GroupId -> Qualified UserId -> Set.Set ClientId -> Client () removeMLSClients groupId (Qualified usr domain) cs = retry x5 . batch $ do diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index c4bb2fd8dbb..cc8500cc634 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -34,7 +34,6 @@ import Wire.API.Conversation.Code import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import Wire.API.MLS.CipherSuite -import Wire.API.MLS.KeyPackage import Wire.API.MLS.PublicGroupState import Wire.API.MLS.SubConversation import Wire.API.Provider @@ -456,8 +455,8 @@ rmMemberClient c = -- MLS Clients -------------------------------------------------------------- -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 (?, ?, ?, ?, ?)" +addMLSClient :: PrepQuery W (GroupId, Domain, UserId, ClientId, Int32) () +addMLSClient = "insert into mls_group_member_client (group_id, user_domain, user, client, leaf_node_index) values (?, ?, ?, ?, ?)" removeMLSClient :: PrepQuery W (GroupId, Domain, UserId, ClientId) () removeMLSClient = "delete from mls_group_member_client where group_id = ? and user_domain = ? and user = ? and client = ?" @@ -465,8 +464,8 @@ removeMLSClient = "delete from mls_group_member_client where group_id = ? and us removeAllMLSClients :: PrepQuery W (Identity GroupId) () removeAllMLSClients = "DELETE FROM mls_group_member_client WHERE group_id = ?" -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 = ?" +lookupMLSClients :: PrepQuery R (Identity GroupId) (Domain, UserId, ClientId, Int32) +lookupMLSClients = "select user_domain, user, client, leaf_node_index 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/Cassandra/SubConversation.hs b/services/galley/src/Galley/Cassandra/SubConversation.hs index ad143121146..3dbe6c842cb 100644 --- a/services/galley/src/Galley/Cassandra/SubConversation.hs +++ b/services/galley/src/Galley/Cassandra/SubConversation.hs @@ -56,7 +56,8 @@ selectSubConversation convId subConvId = do cnvmlsEpochTimestamp = epochTimestamp epoch epochWritetime, cnvmlsCipherSuite = suite }, - scMembers = cm + scMembers = cm, + scIndexMap = mempty -- TODO } insertSubConversation :: ConvId -> SubConvId -> CipherSuiteTag -> Epoch -> GroupId -> Maybe OpaquePublicGroupState -> Client () diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs index bdc61c90160..10b7e168d29 100644 --- a/services/galley/src/Galley/Effects/MemberStore.hs +++ b/services/galley/src/Galley/Effects/MemberStore.hs @@ -60,7 +60,6 @@ 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 data MemberStore m a where @@ -77,7 +76,7 @@ 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 :: GroupId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () + AddMLSClients :: GroupId -> Qualified UserId -> Set (ClientId, Word32) -> MemberStore m () RemoveMLSClients :: GroupId -> Qualified UserId -> Set ClientId -> MemberStore m () RemoveAllMLSClients :: GroupId -> MemberStore m () LookupMLSClients :: GroupId -> MemberStore m ClientMap