Backport #4009 (#4043)

* Refactor ciphersuite handling for 1-1 convs (#4009)

* Introduce ActiveMLSConversationData

This changes the conversation and subconversation metadata so that
epoch, epoch timestamp and ciphersuites are all simultaneously optional.
This makes it possible not to set a ciphersuite for conversations until
they receive a commit.

* Fix assertions in integration tests

* Add more versioned conversation endpoints

* Make SubConversation record versioned

* Adapt galley to versioning changes

* Adapt and expand conversation golden tests

* Fix arbitrary instance of ConversationMLSData

* Test old versions of conversation metadata

* Restore epoch field in Conversation serialisation

* Add CHANGELOG entry

* Lint

* Test MLS 1-1 with other ciphersuites

* Fix assertion in galley integration test

* fixup! Fix assertion in galley integration test

* Improve MLS one2one conversation test

changelog.d/1-api-changes/mls-ciphersuite

@@ -0,0 +1 @@
+The `cipher_suite` field is not present anymore in objects corresponding to newly created conversations

integration/test/MLS/Util.hs

@@ -209,11 +209,9 @@ createNewGroup cid = do
 createSelfGroup :: (HasCallStack) => ClientIdentity -> App (String, Value)
 createSelfGroup cid = do
   conv <- getSelfConversation cid >>= getJSON 200
-  conv %. "epoch" `shouldMatchInt` 0
   groupId <- conv %. "group_id" & asString
-  convId <- conv %. "qualified_id"
   createGroup cid conv
-  pure (groupId, convId)
+  pure (groupId, conv)
 
 createGroup :: (MakesValue conv) => ClientIdentity -> conv -> App ()
 createGroup cid conv = do

integration/test/Test/MLS.hs

@@ -12,6 +12,7 @@ import qualified Data.Text.Encoding as T
 import MLS.Util
 import Notifications
 import SetupHelpers
+import Test.Version
 import Testlib.Prelude
 
 testSendMessageNoReturnToSender :: HasCallStack => App ()
@@ -331,7 +332,14 @@ testAddUserSimple suite ctype = do
   [alice1, bob2] <- traverse (createMLSClient def {credType = ctype}) [alice, bob]
 
   traverse_ uploadNewKeyPackage [bob2]
-  (_, qcnv) <- createNewGroup alice1
+  qcnv <- withWebSocket alice $ \ws -> do
+    (_, qcnv) <- createNewGroup alice1
+    -- check that the conversation inside the ConvCreated event contains
+    -- epoch and ciphersuite, regardless of the API version
+    n <- awaitMatch isConvCreateNotif ws
+    n %. "payload.0.data.epoch" `shouldMatchInt` 0
+    n %. "payload.0.data.cipher_suite" `shouldMatchInt` 1
+    pure qcnv
 
   resp <- createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
   events <- resp %. "events" & asList
@@ -412,12 +420,17 @@ testCreateSubConvProteus = do
   bindResponse (getSubConversation alice conv "conference") $ \resp ->
     resp.status `shouldMatchInt` 404
 
-testSelfConversation :: App ()
-testSelfConversation = do
+testSelfConversation :: Version5 -> App ()
+testSelfConversation v = withVersion5 v $ do
   alice <- randomUser OwnDomain def
   creator : others <- traverse (createMLSClient def) (replicate 3 alice)
   traverse_ uploadNewKeyPackage others
-  void $ createSelfGroup creator
+  (_, conv) <- createSelfGroup creator
+  conv %. "epoch" `shouldMatchInt` 0
+  case v of
+    Version5 -> conv %. "cipher_suite" `shouldMatchInt` 1
+    NoVersion5 -> assertFieldMissing conv "cipher_suite"
+
   void $ createAddCommit creator [alice] >>= sendAndConsumeCommitBundle
 
   newClient <- createMLSClient def alice

integration/test/Test/MLS/One2One.hs

@@ -22,21 +22,31 @@ import API.Galley
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.Set as Set
+import qualified Data.Text as T
+import qualified Data.Text.Read as T
 import MLS.Util
 import Notifications
 import SetupHelpers
+import Test.Version
 import Testlib.Prelude
 
-testGetMLSOne2One :: HasCallStack => Domain -> App ()
-testGetMLSOne2One otherDomain = do
+testGetMLSOne2One :: HasCallStack => Version5 -> Domain -> App ()
+testGetMLSOne2One v otherDomain = withVersion5 v $ do
   [alice, bob] <- createAndConnectUsers [OwnDomain, otherDomain]
 
+  let assertConvData conv = do
+        conv %. "epoch" `shouldMatchInt` 0
+        case v of
+          Version5 -> conv %. "cipher_suite" `shouldMatchInt` 1
+          NoVersion5 -> assertFieldMissing conv "cipher_suite"
+
   conv <- getMLSOne2OneConversation alice bob >>= getJSON 200
   conv %. "type" `shouldMatchInt` 2
   shouldBeEmpty (conv %. "members.others")
 
   conv %. "members.self.conversation_role" `shouldMatch` "wire_member"
   conv %. "members.self.qualified_id" `shouldMatch` (alice %. "qualified_id")
+  assertConvData conv
 
   convId <- conv %. "qualified_id"
 
@@ -47,7 +57,7 @@ testGetMLSOne2One otherDomain = do
 
   conv2 %. "type" `shouldMatchInt` 2
   conv2 %. "qualified_id" `shouldMatch` convId
-  conv2 %. "epoch" `shouldMatch` (conv %. "epoch")
+  assertConvData conv2
 
 testMLSOne2OneOtherMember :: HasCallStack => One2OneScenario -> App ()
 testMLSOne2OneOtherMember scenario = do
@@ -219,8 +229,9 @@ one2OneScenarioConvDomain One2OneScenarioLocal = OwnDomain
 one2OneScenarioConvDomain One2OneScenarioLocalConv = OwnDomain
 one2OneScenarioConvDomain One2OneScenarioRemoteConv = OtherDomain
 
-testMLSOne2One :: HasCallStack => One2OneScenario -> App ()
-testMLSOne2One scenario = do
+testMLSOne2One :: HasCallStack => Ciphersuite -> One2OneScenario -> App ()
+testMLSOne2One suite scenario = do
+  setMLSCiphersuite suite
   alice <- randomUser OwnDomain def
   let otherDomain = one2OneScenarioUserDomain scenario
       convDomain = one2OneScenarioConvDomain scenario
@@ -247,3 +258,9 @@ testMLSOne2One scenario = do
     let isMessage n = nPayload n %. "type" `isEqual` "conversation.mls-message-add"
     n <- awaitMatch isMessage ws
     nPayload n %. "data" `shouldMatch` B8.unpack (Base64.encode mp.message)
+
+  void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle
+
+  conv' <- getMLSOne2OneConversation alice bob >>= getJSON 200
+  (suiteCode, _) <- assertOne $ T.hexadecimal (T.pack suite.code)
+  conv' %. "cipher_suite" `shouldMatchInt` suiteCode

integration/test/Test/Version.hs

@@ -16,6 +16,18 @@ instance HasTests x => HasTests (Versioned' -> x) where
       <> mkTests m (n <> "[version=v3]") s f (x (Versioned' (ExplicitVersion 3)))
       <> mkTests m (n <> "[version=v6]") s f (x (Versioned' (ExplicitVersion 6)))
 
+-- | Used to test endpoints that have changed after version 5
+data Version5 = Version5 | NoVersion5
+
+instance HasTests x => HasTests (Version5 -> x) where
+  mkTests m n s f x =
+    mkTests m (n <> "[version=versioned]") s f (x NoVersion5)
+      <> mkTests m (n <> "[version=v5]") s f (x Version5)
+
+withVersion5 :: Version5 -> App a -> App a
+withVersion5 Version5 = withAPIVersion 5
+withVersion5 NoVersion5 = id
+
 testVersion :: Versioned' -> App ()
 testVersion (Versioned' v) = withModifiedBackend
   def {brigCfg = setField "optSettings.setDisabledAPIVersions" ([] :: [String])}

integration/test/Testlib/JSON.hs

@@ -178,6 +178,13 @@ fieldEquals a fieldSelector b = do
     Just f ->
       f `isEqual` b
 
+assertFieldMissing :: (HasCallStack, MakesValue a) => a -> String -> App ()
+assertFieldMissing x k = do
+  mValue <- lookupField x k
+  case mValue of
+    Nothing -> pure ()
+    Just _ -> assertFailureWithJSON x $ "Field \"" <> k <> "\" should be missing from object:"
+
 assertField :: (HasCallStack, MakesValue a) => a -> String -> Maybe Value -> App Value
 assertField x k Nothing = assertFailureWithJSON x $ "Field \"" <> k <> "\" is missing from object:"
 assertField _ _ (Just x) = pure x

libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs

@@ -86,5 +86,16 @@ testObject_ConversationCreated2 =
       nonCreatorMembers = Set.fromList [],
       messageTimer = Nothing,
       receiptMode = Nothing,
-      protocol = ProtocolMLS (ConversationMLSData (GroupId "group") (Epoch 3) (Just (UTCTime (fromGregorian 2020 8 29) 0)) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519)
+      protocol =
+        ProtocolMLS
+          ( ConversationMLSData
+              (GroupId "group")
+              ( Just
+                  ( ActiveMLSConversationData
+                      (Epoch 3)
+                      (UTCTime (fromGregorian 2020 8 29) 0)
+                      MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
+                  )
+              )
+          )
     }

libs/wire-api/src/Wire/API/Conversation.hs

@@ -104,10 +104,11 @@ import Data.Range (Range, fromRange, rangedSchema)
 import Data.SOP
 import Data.Schema
 import Data.Set qualified as Set
+import Data.Singletons
+import Data.Text qualified as Text
 import Data.UUID qualified as UUID
 import Data.UUID.V5 qualified as UUIDV5
 import Imports
-import Servant.API
 import System.Random (randomRIO)
 import Wire.API.Conversation.Member
 import Wire.API.Conversation.Protocol
@@ -154,9 +155,9 @@ defConversationMetadata mCreator =
       cnvmReceiptMode = Nothing
     }
 
-accessRolesVersionedSchema :: Version -> ObjectSchema SwaggerDoc (Set AccessRole)
-accessRolesVersionedSchema v =
-  if v > V2 then accessRolesSchema else accessRolesSchemaV2
+accessRolesVersionedSchema :: Maybe Version -> ObjectSchema SwaggerDoc (Set AccessRole)
+accessRolesVersionedSchema (Just v) | v < V3 = accessRolesSchemaV2
+accessRolesVersionedSchema _ = accessRolesSchema
 
 accessRolesSchema :: ObjectSchema SwaggerDoc (Set AccessRole)
 accessRolesSchema = field "access_role" (set schema)
@@ -265,27 +266,27 @@ cnvReceiptMode :: Conversation -> Maybe ReceiptMode
 cnvReceiptMode = cnvmReceiptMode . cnvMetadata
 
 instance ToSchema Conversation where
-  schema = conversationSchema V3
+  schema = conversationSchema Nothing
 
-instance ToSchema (Versioned 'V2 Conversation) where
-  schema = Versioned <$> unVersioned .= conversationSchema V2
+instance SingI v => ToSchema (Versioned v Conversation) where
+  schema = Versioned <$> unVersioned .= conversationSchema (Just (demote @v))
 
-conversationObjectSchema :: Version -> ObjectSchema SwaggerDoc Conversation
+conversationObjectSchema :: Maybe Version -> ObjectSchema SwaggerDoc Conversation
 conversationObjectSchema v =
   Conversation
     <$> cnvQualifiedId .= field "qualified_id" schema
     <* (qUnqualified . cnvQualifiedId)
       .= optional (field "id" (deprecatedSchema "qualified_id" schema))
     <*> cnvMetadata .= conversationMetadataObjectSchema (accessRolesVersionedSchema v)
     <*> cnvMembers .= field "members" schema
-    <*> cnvProtocol .= protocolSchema
+    <*> cnvProtocol .= protocolSchema v
 
 conversationSchema ::
-  Version ->
+  Maybe Version ->
   ValueSchema NamedSwaggerDoc Conversation
 conversationSchema v =
   objectWithDocModifier
-    "Conversation"
+    ("Conversation" <> foldMap (Text.toUpper . versionText) v)
     (description ?~ "A conversation object as returned from the server")
     (conversationObjectSchema v)
 
@@ -302,20 +303,26 @@ data CreateGroupConversation = CreateGroupConversation
   deriving (ToJSON, FromJSON, S.ToSchema) via Schema CreateGroupConversation
 
 instance ToSchema CreateGroupConversation where
-  schema =
-    objectWithDocModifier
-      "CreateGroupConversation"
-      (description ?~ "A created group-conversation object extended with a list of failed-to-add users")
-      $ CreateGroupConversation
-        <$> cgcConversation .= conversationObjectSchema V4
-        <*> (toFlatList . cgcFailedToAdd)
-          .= field "failed_to_add" (fromFlatList <$> array schema)
-    where
-      toFlatList :: Map Domain (Set a) -> [Qualified a]
-      toFlatList m =
-        (\(d, s) -> flip Qualified d <$> Set.toList s) =<< Map.assocs m
-      fromFlatList :: Ord a => [Qualified a] -> Map Domain (Set a)
-      fromFlatList = fmap Set.fromList . indexQualified
+  schema = createGroupConversationSchema Nothing
+
+instance SingI v => ToSchema (Versioned v CreateGroupConversation) where
+  schema = Versioned <$> unVersioned .= createGroupConversationSchema (Just (demote @v))
+
+createGroupConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateGroupConversation
+createGroupConversationSchema v =
+  objectWithDocModifier
+    "CreateGroupConversation"
+    (description ?~ "A created group-conversation object extended with a list of failed-to-add users")
+    $ CreateGroupConversation
+      <$> cgcConversation .= conversationObjectSchema v
+      <*> (toFlatList . cgcFailedToAdd)
+        .= field "failed_to_add" (fromFlatList <$> array schema)
+  where
+    toFlatList :: Map Domain (Set a) -> [Qualified a]
+    toFlatList m =
+      (\(d, s) -> flip Qualified d <$> Set.toList s) =<< Map.assocs m
+    fromFlatList :: Ord a => [Qualified a] -> Map Domain (Set a)
+    fromFlatList = fmap Set.fromList . indexQualified
 
 -- | Limited view of a 'Conversation'. Is used to inform users with an invite
 -- link about the conversation.
@@ -364,7 +371,7 @@ instance ToSchema (Versioned 'V2 (ConversationList Conversation)) where
   schema =
     Versioned
       <$> unVersioned
-        .= conversationListSchema (conversationSchema V2)
+        .= conversationListSchema (conversationSchema (Just V2))
 
 conversationListSchema ::
   forall a.
@@ -426,24 +433,24 @@ data ConversationsResponse = ConversationsResponse
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationsResponse
 
 conversationsResponseSchema ::
-  Version ->
+  Maybe Version ->
   ValueSchema NamedSwaggerDoc ConversationsResponse
 conversationsResponseSchema v =
   let notFoundDoc = description ?~ "These conversations either don't exist or are deleted."
       failedDoc = description ?~ "The server failed to fetch these conversations, most likely due to network issues while contacting a remote server"
    in objectWithDocModifier
-        "ConversationsResponse"
+        ("ConversationsResponse" <> foldMap (Text.toUpper . versionText) v)
         (description ?~ "Response object for getting metadata of a list of conversations")
         $ ConversationsResponse
           <$> crFound .= field "found" (array (conversationSchema v))
           <*> crNotFound .= fieldWithDocModifier "not_found" notFoundDoc (array schema)
           <*> crFailed .= fieldWithDocModifier "failed" failedDoc (array schema)
 
 instance ToSchema ConversationsResponse where
-  schema = conversationsResponseSchema V3
+  schema = conversationsResponseSchema Nothing
 
-instance ToSchema (Versioned 'V2 ConversationsResponse) where
-  schema = Versioned <$> unVersioned .= conversationsResponseSchema V2
+instance SingI v => ToSchema (Versioned v ConversationsResponse) where
+  schema = Versioned <$> unVersioned .= conversationsResponseSchema (Just (demote @v))
 
 --------------------------------------------------------------------------------
 -- Conversation properties
@@ -658,18 +665,19 @@ data NewConv = NewConv
 
 instance ToSchema NewConv where
   schema =
-    newConvSchema $
+    newConvSchema Nothing $
       maybe_ (optField "access_role" (set schema))
 
 instance ToSchema (Versioned 'V2 NewConv) where
-  schema = Versioned <$> unVersioned .= newConvSchema accessRolesSchemaOptV2
+  schema = Versioned <$> unVersioned .= newConvSchema (Just V2) accessRolesSchemaOptV2
 
 newConvSchema ::
+  Maybe Version ->
   ObjectSchema SwaggerDoc (Maybe (Set AccessRole)) ->
   ValueSchema NamedSwaggerDoc NewConv
-newConvSchema sch =
+newConvSchema v sch =
   objectWithDocModifier
-    "NewConv"
+    ("NewConv" <> foldMap (Text.toUpper . versionText) v)
     (description ?~ "JSON object to create a new conversation. When using 'qualified_users' (preferred), you can omit 'users'")
     $ NewConv
       <$> newConvUsers
@@ -830,22 +838,18 @@ data ConversationAccessData = ConversationAccessData
   deriving (Arbitrary) via (GenericUniform ConversationAccessData)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationAccessData
 
-conversationAccessDataSchema :: Version -> ValueSchema NamedSwaggerDoc ConversationAccessData
+conversationAccessDataSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc ConversationAccessData
 conversationAccessDataSchema v =
-  object ("ConversationAccessData" <> suffix) $
+  object ("ConversationAccessData" <> foldMap (Text.toUpper . versionText) v) $
     ConversationAccessData
       <$> cupAccess .= field "access" (set schema)
       <*> cupAccessRoles .= accessRolesVersionedSchema v
-  where
-    suffix
-      | v == maxBound = ""
-      | otherwise = toUrlPiece v
 
 instance ToSchema ConversationAccessData where
-  schema = conversationAccessDataSchema V3
+  schema = conversationAccessDataSchema Nothing
 
 instance ToSchema (Versioned 'V2 ConversationAccessData) where
-  schema = Versioned <$> unVersioned .= conversationAccessDataSchema V2
+  schema = Versioned <$> unVersioned .= conversationAccessDataSchema (Just V2)
 
 data ConversationReceiptModeUpdate = ConversationReceiptModeUpdate
   { cruReceiptMode :: ReceiptMode