From b9ac22516498db8352f2ef44928615ad4d03a95e Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Mon, 26 Jun 2023 12:32:18 +0000 Subject: [PATCH 1/4] Avoid MLS messages in sender client's event stream --- changelog.d/5-internal/dont-return-to-sender | 1 + services/galley/src/Galley/API/MLS/Message.hs | 4 +-- .../galley/src/Galley/API/MLS/Propagate.hs | 9 ++++--- services/galley/src/Galley/API/MLS/Removal.hs | 2 +- services/galley/test/integration/API/MLS.hs | 25 +++++++++++-------- 5 files changed, 24 insertions(+), 17 deletions(-) create mode 100644 changelog.d/5-internal/dont-return-to-sender diff --git a/changelog.d/5-internal/dont-return-to-sender b/changelog.d/5-internal/dont-return-to-sender new file mode 100644 index 00000000000..3e3df3c04db --- /dev/null +++ b/changelog.d/5-internal/dont-return-to-sender @@ -0,0 +1 @@ +Avoid including MLS application messages in the sender client's event stream. diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index c0e6aef628d..6421f62cdc7 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -232,7 +232,7 @@ postMLSCommitBundleToLocalConv qusr c conn bundle lConvOrSubId = do storeGroupInfo (tUnqualified lConvOrSub).id bundle.groupInfo - propagateMessage qusr lConvOrSub conn bundle.rawMessage (tUnqualified lConvOrSub).members + propagateMessage qusr (Just c) lConvOrSub conn bundle.rawMessage (tUnqualified lConvOrSub).members >>= mapM_ throwUnreachableUsers for_ bundle.welcome $ \welcome -> @@ -375,7 +375,7 @@ postMLSMessageToLocalConv qusr c con msg convOrSubId = do when ((tUnqualified lConvOrSub).migrationState == MLSMigrationMixed) $ throwS @'MLSUnsupportedMessage - unreachables <- propagateMessage qusr lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members + unreachables <- propagateMessage qusr (Just c) lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members pure ([], unreachables) postMLSMessageToRemoteConv :: diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs index 9a8ba3d908a..b491723ade6 100644 --- a/services/galley/src/Galley/API/MLS/Propagate.hs +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -43,6 +43,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.Credential import Wire.API.MLS.Message import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation @@ -58,12 +59,13 @@ propagateMessage :: Member TinyLog r ) => Qualified UserId -> + Maybe ClientId -> Local ConvOrSubConv -> Maybe ConnId -> RawMLS Message -> ClientMap -> Sem r (Maybe UnreachableUsers) -propagateMessage qusr lConvOrSub con msg cm = do +propagateMessage qusr mci lConvOrSub con msg cm = do now <- input @UTCTime let mlsConv = (.conv) <$> lConvOrSub lmems = mcLocalMembers . tUnqualified $ mlsConv @@ -102,13 +104,14 @@ propagateMessage qusr lConvOrSub con msg cm = do rmmMessage = Base64ByteString msg.raw } where + cmWithoutSender = maybe cm (flip cmRemoveClient cm . mkClientIdentity qusr) mci localMemberMLSClients :: Local x -> LocalMember -> [(UserId, ClientId)] localMemberMLSClients loc lm = let localUserQId = tUntagged (qualifyAs loc localUserId) localUserId = lmId lm in map (\(c, _) -> (localUserId, c)) - (Map.assocs (Map.findWithDefault mempty localUserQId cm)) + (Map.assocs (Map.findWithDefault mempty localUserQId cmWithoutSender)) remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)] remoteMemberMLSClients rm = @@ -116,7 +119,7 @@ propagateMessage qusr lConvOrSub con msg cm = do remoteUserId = qUnqualified remoteUserQId in map (\(c, _) -> (remoteUserId, c)) - (Map.assocs (Map.findWithDefault mempty remoteUserQId cm)) + (Map.assocs (Map.findWithDefault mempty remoteUserQId cmWithoutSender)) remotesToQIds = fmap (tUntagged . rmId) diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index 9477082c31a..557b4bc9120 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -101,7 +101,7 @@ createAndSendRemoveProposals lConvOrSubConv indices qusr cm = do (publicMessageRef (cnvmlsCipherSuite meta) pmsg) ProposalOriginBackend proposal - propagateMessage qusr lConvOrSubConv Nothing msg cm + propagateMessage qusr Nothing lConvOrSubConv Nothing msg cm removeClientsWithClientMapRecursively :: ( Members diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 776f8368b26..4f25b5e314a 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -967,9 +967,10 @@ testAppMessage = do mlsBracket clients $ \wss -> do (events, _) <- sendAndConsumeMessage message liftIO $ events @?= [] - liftIO $ - WS.assertMatchN_ (5 # WS.Second) wss $ + liftIO $ do + WS.assertMatchN_ (5 # WS.Second) (tail wss) $ wsAssertMLSMessage (fmap Conv qcnv) alice (mpMessage message) + WS.assertNoEvent (2 # WS.Second) [head wss] testAppMessage2 :: TestM () testAppMessage2 = do @@ -992,15 +993,16 @@ testAppMessage2 = do message <- createApplicationMessage bob1 "some text" - mlsBracket (alice1 : clients) $ \wss -> do + mlsBracket (alice1 : clients) $ \[wsAlice1, wsBob1, wsBob2, wsCharlie1] -> do (events, _) <- sendAndConsumeMessage message liftIO $ events @?= [] - -- check that the corresponding event is received - - liftIO $ - WS.assertMatchN_ (5 # WS.Second) wss $ + -- check that the corresponding event is received by everyone except bob1 + -- (the sender) and no message is received by bob1 + liftIO $ do + WS.assertMatchN_ (5 # WS.Second) [wsAlice1, wsBob2, wsCharlie1] $ wsAssertMLSMessage (fmap Conv conversation) bob (mpMessage message) + WS.assertNoEvent (2 # WS.Second) [wsBob1] testAppMessageSomeReachable :: TestM () testAppMessageSomeReachable = do @@ -1829,7 +1831,7 @@ testBackendRemoveProposalLocalConvLocalClient = do WS.assertMatch_ (5 # WS.Second) wsB $ wsAssertClientRemoved (ciClient bob1) - msg <- WS.assertMatch (5 # WS.Second) wsA $ \notification -> do + (msg : _) <- WS.assertMatchN (5 # WS.Second) [wsA, wsC] $ \notification -> do wsAssertBackendRemoveProposal bob (Conv <$> qcnv) idxBob1 notification for_ [alice1, bob2, charlie1] $ @@ -1838,8 +1840,9 @@ testBackendRemoveProposalLocalConvLocalClient = do mp <- createPendingProposalCommit charlie1 events <- sendAndConsumeCommitBundle mp liftIO $ events @?= [] - WS.assertMatchN_ (5 # WS.Second) [wsA, wsC] $ \n -> do + WS.assertMatchN_ (5 # WS.Second) [wsA] $ \n -> do wsAssertMLSMessage (Conv <$> qcnv) charlie (mpMessage mp) n + WS.assertNoEvent (2 # WS.Second) [wsC] testBackendRemoveProposalLocalConvRemoteClient :: TestM () testBackendRemoveProposalLocalConvRemoteClient = do @@ -2700,7 +2703,7 @@ testLeaveSubConv isSubConvCreator = do -- a member commits the pending proposal do leaveCommit <- createPendingProposalCommit (head others) - mlsBracket (firstLeaver : others) $ \(wsLeaver : wss) -> do + mlsBracket (firstLeaver : tail others) $ \(wsLeaver : wss) -> do events <- fst <$$> withTempMockFederator' ("on-mls-message-sent" ~> RemoteMLSMessageOk) @@ -2713,7 +2716,7 @@ testLeaveSubConv isSubConvCreator = do -- send an application message do message <- createApplicationMessage (head others) "some text" - mlsBracket (firstLeaver : others) $ \(wsLeaver : wss) -> do + mlsBracket (firstLeaver : tail others) $ \(wsLeaver : wss) -> do (events, _) <- sendAndConsumeMessage message liftIO $ events @?= [] WS.assertMatchN_ (5 # WS.Second) wss $ \n -> do From cb110a947afd895d79e570935b132c5e048e5558 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Tue, 27 Jun 2023 07:03:16 +0000 Subject: [PATCH 2/4] Add comment about the changed event propagation --- services/galley/src/Galley/API/MLS/Propagate.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs index b491723ade6..cd43d1759d0 100644 --- a/services/galley/src/Galley/API/MLS/Propagate.hs +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -51,6 +51,8 @@ import Wire.API.Message import Wire.API.Unreachable -- | Propagate a message. +-- The message will not be propagated to the sender client if provided. This is +-- a requirement from Core Crypto and the clients. propagateMessage :: ( Member ExternalAccess r, Member FederatorAccess r, @@ -65,7 +67,7 @@ propagateMessage :: RawMLS Message -> ClientMap -> Sem r (Maybe UnreachableUsers) -propagateMessage qusr mci lConvOrSub con msg cm = do +propagateMessage qusr mSenderClient lConvOrSub con msg cm = do now <- input @UTCTime let mlsConv = (.conv) <$> lConvOrSub lmems = mcLocalMembers . tUnqualified $ mlsConv @@ -104,7 +106,7 @@ propagateMessage qusr mci lConvOrSub con msg cm = do rmmMessage = Base64ByteString msg.raw } where - cmWithoutSender = maybe cm (flip cmRemoveClient cm . mkClientIdentity qusr) mci + cmWithoutSender = maybe cm (flip cmRemoveClient cm . mkClientIdentity qusr) mSenderClient localMemberMLSClients :: Local x -> LocalMember -> [(UserId, ClientId)] localMemberMLSClients loc lm = let localUserQId = tUntagged (qualifyAs loc localUserId) From 92c147f50ca57cb68880ffb64094093a3f5ba3cf Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Tue, 27 Jun 2023 07:19:49 +0000 Subject: [PATCH 3/4] Add test to check messages don't return to sender --- integration/test/Test/MLS.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs index 108452f0684..ccd416c79ec 100644 --- a/integration/test/Test/MLS.hs +++ b/integration/test/Test/MLS.hs @@ -11,6 +11,27 @@ import MLS.Util import SetupHelpers import Testlib.Prelude +testSendMessageNoReturnToSender :: HasCallStack => App () +testSendMessageNoReturnToSender = do + [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] + [alice1, alice2, bob1, bob2] <- traverse createMLSClient [alice, alice, bob, bob] + traverse_ uploadNewKeyPackage [alice2, bob1, bob2] + void $ createNewGroup alice1 + void $ createAddCommit alice1 [alice, bob] >>= sendAndConsumeCommitBundle + + -- alice1 sends a message to the conversation, all clients but alice1 receive + -- the message + withWebSockets [alice1, alice2, bob1, bob2] $ \(wsSender : wss) -> do + mp <- createApplicationMessage alice1 "hello, bob" + void . bindResponse (postMLSMessage mp.sender mp.message) $ \resp -> do + resp.status `shouldMatchInt` 201 + for_ wss $ \ws -> do + n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-message-add") ws + nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode mp.message) + expectFailure (const $ pure ()) $ do + n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-message-add") wsSender + nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode mp.message) + testMixedProtocolUpgrade :: HasCallStack => Domain -> App () testMixedProtocolUpgrade secondDomain = do (alice, tid) <- createTeam OwnDomain From a94287fba4bf4d3b1359f181df5be13399c79d0e Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Tue, 27 Jun 2023 07:43:57 +0000 Subject: [PATCH 4/4] Make exact match in test --- integration/test/Test/MLS.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs index ccd416c79ec..58a03989457 100644 --- a/integration/test/Test/MLS.hs +++ b/integration/test/Test/MLS.hs @@ -28,9 +28,16 @@ testSendMessageNoReturnToSender = do for_ wss $ \ws -> do n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-message-add") ws nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode mp.message) - expectFailure (const $ pure ()) $ do - n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-message-add") wsSender - nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode mp.message) + expectFailure (const $ pure ()) $ + awaitMatch + 3 + ( \n -> + liftM2 + (&&) + (nPayload n %. "type" `isEqual` "conversation.mls-message-add") + (nPayload n %. "data" `isEqual` T.decodeUtf8 (Base64.encode mp.message)) + ) + wsSender testMixedProtocolUpgrade :: HasCallStack => Domain -> App () testMixedProtocolUpgrade secondDomain = do