diff --git a/changelog.d/4-docs/mls-test-tags b/changelog.d/4-docs/mls-test-tags new file mode 100644 index 00000000000..56e9b4b3b0a --- /dev/null +++ b/changelog.d/4-docs/mls-test-tags @@ -0,0 +1 @@ +Deleted proteus-specific test documentation tags and added some new tags to MLS tests diff --git a/integration/test/Test/AccessUpdate.hs b/integration/test/Test/AccessUpdate.hs index 0152c6e63e6..1dbabe8fdcf 100644 --- a/integration/test/Test/AccessUpdate.hs +++ b/integration/test/Test/AccessUpdate.hs @@ -22,6 +22,7 @@ import API.Galley import Control.Monad.Codensity import Control.Monad.Reader import GHC.Stack +import MLS.Util import Notifications import SetupHelpers import Testlib.Prelude @@ -38,29 +39,55 @@ testBaz :: HasCallStack => App () testBaz = pure () -} +data ConversationProtocol + = ConversationProtocolProteus + | ConversationProtocolMLS + +instance TestCases ConversationProtocol where + mkTestCases = + pure + [ MkTestCase "[proto=proteus]" ConversationProtocolProteus, + MkTestCase "[proto=mls]" ConversationProtocolMLS + ] + -- | @SF.Federation @SF.Separation @TSFI.RESTfulAPI @S2 -- -- The test asserts that, among others, remote users are removed from a -- conversation when an access update occurs that disallows guests from -- accessing. -testAccessUpdateGuestRemoved :: HasCallStack => App () -testAccessUpdateGuestRemoved = do +testAccessUpdateGuestRemoved :: (HasCallStack) => ConversationProtocol -> App () +testAccessUpdateGuestRemoved proto = do (alice, tid, [bob]) <- createTeam OwnDomain 2 charlie <- randomUser OwnDomain def dee <- randomUser OtherDomain def mapM_ (connectTwoUsers alice) [charlie, dee] - [aliceClient, bobClient, charlieClient, deeClient] <- - mapM - (\user -> objId $ bindResponse (addClient user def) $ getJSON 201) - [alice, bob, charlie, dee] - conv <- - postConversation - alice - defProteus - { qualifiedUsers = [bob, charlie, dee], - team = Just tid - } - >>= getJSON 201 + + (conv, [aliceClient, bobClient, charlieClient, deeClient]) <- case proto of + ConversationProtocolProteus -> do + clients <- + mapM + (\user -> objId $ bindResponse (addClient user def) $ getJSON 201) + [alice, bob, charlie, dee] + conv <- + postConversation + alice + defProteus + { qualifiedUsers = [bob, charlie, dee], + team = Just tid + } + >>= getJSON 201 + pure (conv, clients) + ConversationProtocolMLS -> do + alice1 <- createMLSClient def alice + clients <- traverse (createMLSClient def) [bob, charlie, dee] + traverse_ uploadNewKeyPackage clients + + conv <- postConversation alice1 defMLS {team = Just tid} >>= getJSON 201 + createGroup alice1 conv + + void $ createAddCommit alice1 [bob, charlie, dee] >>= sendAndConsumeCommitBundle + convId <- conv %. "qualified_id" + pure (convId, map (.client) (alice1 : clients)) let update = ["access" .= ([] :: [String]), "access_role" .= ["team_member"]] void $ updateAccess alice conv update >>= getJSON 200 diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs index 34bff33573e..188d0d3d4ab 100644 --- a/integration/test/Test/MLS.hs +++ b/integration/test/Test/MLS.hs @@ -504,7 +504,11 @@ testFirstCommitAllowsPartialAdds = do resp.status `shouldMatchInt` 409 resp.json %. "label" `shouldMatch` "mls-client-mismatch" -testAddUserPartial :: HasCallStack => App () +-- @SF.Separation @TSFI.RESTfulAPI @S2 +-- +-- This test verifies that the server rejects a commit containing add proposals +-- that only add a proper subset of the set of clients of a user. +testAddUserPartial :: (HasCallStack) => App () testAddUserPartial = do [alice, bob, charlie] <- createAndConnectUsers (replicate 3 OwnDomain) @@ -531,6 +535,8 @@ testAddUserPartial = do err <- postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 409 err %. "label" `shouldMatch` "mls-client-mismatch" +-- @END + -- | admin removes user from a conversation but doesn't list all clients testRemoveClientsIncomplete :: HasCallStack => App () testRemoveClientsIncomplete = do @@ -716,7 +722,12 @@ testPropExistingConv = do res <- createAddProposals alice1 [bob] >>= traverse sendAndConsumeMessage >>= assertOne shouldBeEmpty (res %. "events") -testCommitNotReferencingAllProposals :: HasCallStack => App () +-- @SF.Separation @TSFI.RESTfulAPI @S2 +-- +-- This test verifies that the server rejects any commit that does not +-- reference all pending proposals in an MLS group. + +testCommitNotReferencingAllProposals :: (HasCallStack) => App () testCommitNotReferencingAllProposals = do users@[_alice, bob, charlie] <- createAndConnectUsers (replicate 3 OwnDomain) @@ -740,7 +751,9 @@ testCommitNotReferencingAllProposals = do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-commit-missing-references" -testUnsupportedCiphersuite :: HasCallStack => App () +-- @END + +testUnsupportedCiphersuite :: (HasCallStack) => App () testUnsupportedCiphersuite = do setMLSCiphersuite (Ciphersuite "0x0003") alice <- randomUser OwnDomain def diff --git a/integration/test/Test/MLS/Message.hs b/integration/test/Test/MLS/Message.hs index 3a7c2efc213..d615072fe9c 100644 --- a/integration/test/Test/MLS/Message.hs +++ b/integration/test/Test/MLS/Message.hs @@ -26,9 +26,14 @@ import Notifications import SetupHelpers import Testlib.Prelude --- | Test happy case of federated MLS message sending in both directions. -testApplicationMessage :: HasCallStack => App () +-- @SF.Separation @TSFI.RESTfulAPI @S2 +-- This test verifies whether a message actually gets sent all the way to +-- cannon. + +testApplicationMessage :: (HasCallStack) => App () testApplicationMessage = do + -- Test happy case of federated MLS message sending in both directions. + -- local alice and alex, remote bob [alice, alex, bob, betty] <- createUsers @@ -55,7 +60,9 @@ testApplicationMessage = do void $ createApplicationMessage bob1 "hey" >>= sendAndConsumeMessage traverse_ (awaitMatch isNewMLSMessageNotif) wss -testAppMessageSomeReachable :: HasCallStack => App () +-- @END + +testAppMessageSomeReachable :: (HasCallStack) => App () testAppMessageSomeReachable = do alice1 <- startDynamicBackends [mempty] $ \[thirdDomain] -> do ownDomain <- make OwnDomain & asString diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 02c26a86b5d..8587c557cee 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -206,8 +206,8 @@ tests s = test s "remote conversation receipt mode update" putRemoteReceiptModeOk, test s "leave connect conversation" leaveConnectConversation, test s "post conversations/:cnv/otr/message: message delivery and missing clients" postCryptoMessageVerifyMsgSentAndRejectIfMissingClient, - test s "post conversations/:cnv/otr/message: mismatch and prekey fetching" postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson, - test s "post conversations/:cnv/otr/message: mismatch with protobuf" postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto, + test s "post conversations/:cnv/otr/message: mismatch and prekey fetching" postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson, + test s "post conversations/:cnv/otr/message: mismatch with protobuf" postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto, test s "post conversations/:cnv/otr/message: unknown sender client" postCryptoMessageNotAuthorizeUnknownClient, test s "post conversations/:cnv/otr/message: ignore_missing and report_missing" postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam, test s "post message qualified - local owning backend - missing clients" postMessageQualifiedLocalOwningBackendMissingClients, @@ -406,9 +406,6 @@ postConvWithUnreachableRemoteUsers rbs = do groupConvs WS.assertNoEvent (3 # Second) [wsAlice, wsAlex] --- @SF.Separation @TSFI.RESTfulAPI @S2 --- This test verifies whether a message actually gets sent all the way to --- cannon. postCryptoMessageVerifyMsgSentAndRejectIfMissingClient :: TestM () postCryptoMessageVerifyMsgSentAndRejectIfMissingClient = do localDomain <- viewFederationDomain @@ -495,12 +492,8 @@ postCryptoMessageVerifyMsgSentAndRejectIfMissingClient = do liftIO $ assertBool "unexpected equal clients" (bc /= bc2) assertNoMsg wsB2 (wsAssertOtr qconv qalice ac bc cipher) --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 --- This test verifies basic mismatch behavior of the the JSON endpoint. -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson :: TestM () -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson = do +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson :: TestM () +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson = do (alice, ac) <- randomUserWithClient (head someLastPrekeys) (bob, bc) <- randomUserWithClient (someLastPrekeys !! 1) (eve, ec) <- randomUserWithClient (someLastPrekeys !! 2) @@ -523,12 +516,8 @@ postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson = do Map.keys (userClientMap (getUserClientPrekeyMap p)) @=? [eve] Map.keys <$> Map.lookup eve (userClientMap (getUserClientPrekeyMap p)) @=? Just [ec] --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 --- This test verifies basic mismatch behaviour of the protobuf endpoint. -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto :: TestM () -postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto = do +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto :: TestM () +postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto = do (alice, ac) <- randomUserWithClient (head someLastPrekeys) (bob, bc) <- randomUserWithClient (someLastPrekeys !! 1) (eve, ec) <- randomUserWithClient (someLastPrekeys !! 2) @@ -553,8 +542,6 @@ postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysProto = do Map.keys (userClientMap (getUserClientPrekeyMap p)) @=? [eve] Map.keys <$> Map.lookup eve (userClientMap (getUserClientPrekeyMap p)) @=? Just [ec] --- @END - -- | This test verifies behaviour when an unknown client posts the message. Only -- tests the Protobuf endpoint. postCryptoMessageNotAuthorizeUnknownClient :: TestM () @@ -570,10 +557,6 @@ postCryptoMessageNotAuthorizeUnknownClient = do postProtoOtrMessage alice (ClientId 0x172618352518396) conv m !!! const 403 === statusCode --- @SF.Separation @TSFI.RESTfulAPI @S2 --- This test verifies the following scenario. --- A client sends a message to all clients of a group and one more who is not part of the group. --- The server must not send this message to client ids not part of the group. postMessageClientNotInGroupDoesNotReceiveMsg :: TestM () postMessageClientNotInGroupDoesNotReceiveMsg = do localDomain <- viewFederationDomain @@ -596,11 +579,6 @@ postMessageClientNotInGroupDoesNotReceiveMsg = do checkEveGetsMsg checkChadDoesNotGetMsg --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 --- This test verifies that when a client sends a message not to all clients of a group then the server should reject the message and sent a notification to the sender (412 Missing clients). --- The test is somewhat redundant because this is already tested as part of other tests already. This is a stand alone test that solely tests the behavior described above. postMessageRejectIfMissingClients :: TestM () postMessageRejectIfMissingClients = do (sender, senderClient) : allReceivers <- randomUserWithClient `traverse` someLastPrekeys @@ -626,11 +604,6 @@ postMessageRejectIfMissingClients = do mkMsg :: ByteString -> (UserId, ClientId) -> (UserId, ClientId, Text) mkMsg text (userId, clientId) = (userId, clientId, toBase64Text text) --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 --- This test verifies behaviour under various values of ignore_missing and --- report_missing. Only tests the JSON endpoint. postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam :: TestM () postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam = do (alice, ac) <- randomUserWithClient (head someLastPrekeys) @@ -686,12 +659,6 @@ postCryptoMessageVerifyCorrectResponseIfIgnoreAndReportMissingQueryParam = do where listToByteString = BS.intercalate "," . map toByteString' --- @END - --- @SF.Separation @TSFI.RESTfulAPI @S2 --- Sets up a conversation on Backend A known as "owning backend". One of the --- users from Backend A will send the message but have a missing client. It is --- expected that the message will not be sent. postMessageQualifiedLocalOwningBackendMissingClients :: TestM () postMessageQualifiedLocalOwningBackendMissingClients = do -- Cannon for local users @@ -749,8 +716,6 @@ postMessageQualifiedLocalOwningBackendMissingClients = do assertMismatchQualified mempty expectedMissing mempty mempty mempty WS.assertNoEvent (1 # Second) [wsBob, wsChad] --- @END - -- | Sets up a conversation on Backend A known as "owning backend". One of the -- users from Backend A will send the message, it is expected that message will -- be sent successfully. @@ -841,11 +806,6 @@ postMessageQualifiedLocalOwningBackendRedundantAndDeletedClients = do -- Wait less for no message WS.assertNoEvent (1 # Second) [wsNonMember] --- @SF.Separation @TSFI.RESTfulAPI @S2 --- Sets up a conversation on Backend A known as "owning backend". One of the --- users from Backend A will send the message but have a missing client. It is --- expected that the message will be sent except when it is specifically --- requested to report on missing clients of a user. postMessageQualifiedLocalOwningBackendIgnoreMissingClients :: TestM () postMessageQualifiedLocalOwningBackendIgnoreMissingClients = do -- WS receive timeout @@ -968,8 +928,6 @@ postMessageQualifiedLocalOwningBackendIgnoreMissingClients = do assertMismatchQualified mempty expectedMissing mempty mempty mempty WS.assertNoEvent (1 # Second) [wsBob, wsChad] --- @END - postMessageQualifiedLocalOwningBackendFailedToSendClients :: TestM () postMessageQualifiedLocalOwningBackendFailedToSendClients = do -- WS receive timeout diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index dcb01c32c56..a8a5e74d4d4 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -252,6 +252,9 @@ postMLSConvOk = do qcid <- assertConv rsp RegularConv (Just alice) qalice [] (Just nameMaxSize) Nothing checkConvCreateEvent (qUnqualified qcid) wsA +-- @SF.Separation @TSFI.RESTfulAPI @S2 +-- +-- This test verifies that a user must be a member of an MLS conversation in order to send messages to it. testSenderNotInConversation :: TestM () testSenderNotInConversation = do -- create users @@ -279,6 +282,8 @@ testSenderNotInConversation = do liftIO $ Wai.label err @?= "no-conversation" +-- @END + testAddUserWithBundle :: TestM () testAddUserWithBundle = do [alice, bob] <- createAndConnectUsers [Nothing, Nothing] @@ -665,6 +670,10 @@ testLocalToRemoteNonMember = do const (Just "no-conversation-member") === fmap Wai.label . responseJsonError +-- @SF.Separation @TSFI.RESTfulAPI @S2 +-- +-- This test verifies that only the members of an MLS conversation are allowed +-- to join via external commit. testExternalCommitNotMember :: TestM () testExternalCommitNotMember = do [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) @@ -683,6 +692,8 @@ testExternalCommitNotMember = do localPostCommitBundle (mpSender mp) bundle !!! const 404 === statusCode +-- @END + testExternalCommitSameClient :: TestM () testExternalCommitSameClient = do [alice, bob] <- createAndConnectUsers (replicate 2 Nothing)