Move test documentation tags from proteus to MLS

changelog.d/4-docs/mls-test-tags

@@ -0,0 +1 @@
+Deleted proteus-specific test documentation tags and added some new tags to MLS tests

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

integration/test/Test/MLS.hs

@@ -529,6 +529,10 @@ testFirstCommitAllowsPartialAdds = do
     resp.status `shouldMatchInt` 409
     resp.json %. "label" `shouldMatch` "mls-client-mismatch"
 
+-- @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)
@@ -556,6 +560,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
@@ -741,6 +747,10 @@ testPropExistingConv = do
   res <- createAddProposals alice1 [bob] >>= traverse sendAndConsumeMessage >>= assertOne
   shouldBeEmpty (res %. "events")
 
+-- @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)
@@ -765,6 +775,8 @@ testCommitNotReferencingAllProposals = do
     resp.status `shouldMatchInt` 400
     resp.json %. "label" `shouldMatch` "mls-commit-missing-references"
 
+-- @END
+
 testUnsupportedCiphersuite :: (HasCallStack) => App ()
 testUnsupportedCiphersuite = do
   setMLSCiphersuite (Ciphersuite "0x0003")

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.
+-- @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,6 +60,8 @@ testApplicationMessage = do
     void $ createApplicationMessage bob1 "hey" >>= sendAndConsumeMessage
     traverse_ (awaitMatch isNewMLSMessageNotif) wss
 
+-- @END
+
 testAppMessageSomeReachable :: (HasCallStack) => App ()
 testAppMessageSomeReachable = do
   alice1 <- startDynamicBackends [mempty] $ \[thirdDomain] -> do

services/galley/test/integration/API.hs

@@ -409,9 +409,6 @@ postConvWithUnreachableRemoteUsers rbs = do
         groupConvs
     WS.assertNoEvent (3 # Second) [wsAlice, wsAlex] -- TODO: sometimes, (at least?) one of these users gets a "connection accepted" event.
 
--- @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
@@ -498,10 +495,6 @@ 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.
 postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson :: TestM ()
 postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson = do
   (alice, ac) <- randomUserWithClient (head someLastPrekeys)
@@ -526,10 +519,6 @@ postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysJson = 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.
 postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto :: TestM ()
 postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto = do
   (alice, ac) <- randomUserWithClient (head someLastPrekeys)
@@ -556,8 +545,6 @@ postCryptoMessageVerifyRejectMissingClientAndRespondMissingPrekeysProto = 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 ()
@@ -573,10 +560,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
@@ -599,11 +582,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
@@ -629,11 +607,6 @@ postMessageRejectIfMissingClients = do
     mkMsg :: ByteString -> (UserId, ClientId) -> (UserId, ClientId, Text)
     mkMsg text (uid, clientId) = (uid, 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)
@@ -689,12 +662,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
@@ -752,8 +719,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.
@@ -844,11 +809,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
@@ -971,8 +931,6 @@ postMessageQualifiedLocalOwningBackendIgnoreMissingClients = do
       assertMismatchQualified mempty expectedMissing mempty mempty mempty
     WS.assertNoEvent (1 # Second) [wsBob, wsChad]
 
--- @END
-
 postMessageQualifiedLocalOwningBackendFailedToSendClients :: TestM ()
 postMessageQualifiedLocalOwningBackendFailedToSendClients = do
   -- WS receive timeout

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)