WPB-1928: Add members to MLS one2one conversations

changelog.d/2-features/mls-one-to-one

@@ -0,0 +1 @@
+Added support for MSL 1-1 conversations

integration/test/SetupHelpers.hs

@@ -110,3 +110,20 @@ resetFedConns owndom = do
       rawlist <- resp.json %. "remotes" & asList
       (asString . (%. "domain")) `mapM` rawlist
     deleteFedConn' owndom `mapM_` rdoms
+
+-- | Create a user on the given domain, such that the 1-1 conversation with
+-- 'other' resides on 'convDomain'. This connects the two users as a side-effect.
+createMLSOne2OnePartner :: MakesValue user => Domain -> user -> Domain -> App Value
+createMLSOne2OnePartner domain other convDomain = loop
+  where
+    loop = do
+      u <- randomUser domain def
+      connectUsers2 u other
+      conv <- getMLSOne2OneConversation other u >>= getJSON 200
+
+      desiredConvDomain <- make convDomain & asString
+      actualConvDomain <- conv %. "qualified_id.domain" & asString
+
+      if desiredConvDomain == actualConvDomain
+        then pure u
+        else loop

integration/test/Test/MLS/One2One.hs

@@ -1,6 +1,9 @@
 module Test.MLS.One2One where
 
 import API.Galley
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.ByteString.Char8 as B8
+import MLS.Util
 import SetupHelpers
 import Testlib.Prelude
 
@@ -9,12 +12,8 @@ testGetMLSOne2One otherDomain = do
   [alice, bob] <- createAndConnectUsers [OwnDomain, otherDomain]
 
   conv <- getMLSOne2OneConversation alice bob >>= getJSON 200
-
   conv %. "type" `shouldMatchInt` 2
-  others <- conv %. "members.others" & asList
-  other <- assertOne others
-  other %. "conversation_role" `shouldMatch` "wire_member"
-  other %. "qualified_id" `shouldMatch` (bob %. "qualified_id")
+  shouldBeEmpty (conv %. "members.others")
 
   conv %. "members.self.conversation_role" `shouldMatch` "wire_member"
   conv %. "members.self.qualified_id" `shouldMatch` (alice %. "qualified_id")
@@ -42,3 +41,48 @@ testGetMLSOne2OneSameTeam = do
   (alice, _) <- createTeam OwnDomain
   bob <- addUserToTeam alice
   void $ getMLSOne2OneConversation alice bob >>= getJSON 200
+
+data One2OneScenario
+  = -- | Both users are local
+    One2OneScenarioLocal
+  | -- | One user is remote, conversation is local
+    One2OneScenarioLocalConv
+  | -- | One user is remote, conversation is remote
+    One2OneScenarioRemoteConv
+
+instance HasTests x => HasTests (One2OneScenario -> x) where
+  mkTests m n s f x =
+    mkTests m (n <> "[domain=own]") s f (x One2OneScenarioLocal)
+      <> mkTests m (n <> "[domain=other;conv=own]") s f (x One2OneScenarioLocalConv)
+      <> mkTests m (n <> "[domain=other;conv=other]") s f (x One2OneScenarioRemoteConv)
+
+one2OneScenarioDomain :: One2OneScenario -> Domain
+one2OneScenarioDomain One2OneScenarioLocal = OwnDomain
+one2OneScenarioDomain _ = OtherDomain
+
+one2OneScenarioConvDomain :: One2OneScenario -> Domain
+one2OneScenarioConvDomain One2OneScenarioLocal = OwnDomain
+one2OneScenarioConvDomain One2OneScenarioLocalConv = OwnDomain
+one2OneScenarioConvDomain One2OneScenarioRemoteConv = OtherDomain
+
+testMLSOne2One :: HasCallStack => One2OneScenario -> App ()
+testMLSOne2One scenario = do
+  alice <- randomUser OwnDomain def
+  let otherDomain = one2OneScenarioDomain scenario
+      convDomain = one2OneScenarioConvDomain scenario
+  bob <- createMLSOne2OnePartner otherDomain alice convDomain
+  [alice1, bob1] <- traverse createMLSClient [alice, bob]
+  traverse_ uploadNewKeyPackage [bob1]
+
+  conv <- getMLSOne2OneConversation alice bob >>= getJSON 200
+  resetGroup alice1 conv
+
+  -- TODO: check that bob receives a welcome message
+  void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+
+  withWebSocket bob1 $ \ws -> do
+    mp <- createApplicationMessage alice1 "hello, world"
+    void $ sendAndConsumeMessage mp
+    let isMessage n = nPayload n %. "type" `isEqual` "conversation.mls-message-add"
+    n <- awaitMatch 3 isMessage ws
+    nPayload n %. "data" `shouldMatch` B8.unpack (Base64.encode (mp.message))

integration/test/Testlib/Assertions.hs

@@ -108,6 +108,9 @@ shouldMatchSet a b = do
   lb <- fmap sort (asList b)
   la `shouldMatch` lb
 
+shouldBeEmpty :: (MakesValue a, HasCallStack) => a -> App ()
+shouldBeEmpty a = a `shouldMatch` (mempty :: [Value])
+
 shouldContainString ::
   HasCallStack =>
   -- | The actual value

libs/api-client/src/Network/Wire/Client/API/Conversation.hs

@@ -48,6 +48,7 @@ import Wire.API.Conversation.Protocol as M
 import Wire.API.Conversation.Role (roleNameWireAdmin)
 import Wire.API.Event.Conversation as M (MemberUpdateData)
 import Wire.API.Message as M
+import qualified Wire.API.User as M
 
 postOtrMessage :: MonadSession m => ConvId -> NewOtrMessage -> m ClientMismatch
 postOtrMessage cnv msg = sessionRequest req rsc readBody
@@ -141,6 +142,6 @@ createConv users name = sessionRequest req rsc readBody
       method POST
         . path "conversations"
         . acceptJson
-        . json (NewConv users [] (name >>= checked) mempty Nothing Nothing Nothing Nothing roleNameWireAdmin M.ProtocolCreateProteusTag)
+        . json (NewConv users [] (name >>= checked) mempty Nothing Nothing Nothing Nothing roleNameWireAdmin M.BaseProtocolProteusTag)
         $ empty
     rsc = status201 :| []

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

@@ -62,8 +62,6 @@ module Wire.API.Conversation
     maybeRole,
 
     -- * create
-    ProtocolCreateTag (..),
-    protocolCreateToProtocolTag,
     NewConv (..),
     ConvTeamInfo (..),
 
@@ -117,6 +115,7 @@ import Wire.API.Routes.MultiTablePaging
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Version
 import Wire.API.Routes.Versioned
+import Wire.API.User
 import Wire.Arbitrary
 
 --------------------------------------------------------------------------------
@@ -125,7 +124,7 @@ import Wire.Arbitrary
 data ConversationMetadata = ConversationMetadata
   { cnvmType :: ConvType,
     -- FUTUREWORK: Make this a qualified user ID.
-    cnvmCreator :: UserId,
+    cnvmCreator :: Maybe UserId,
     cnvmAccess :: [Access],
     cnvmAccessRoles :: Set AccessRole,
     cnvmName :: Maybe Text,
@@ -139,11 +138,11 @@ data ConversationMetadata = ConversationMetadata
   deriving (Arbitrary) via (GenericUniform ConversationMetadata)
   deriving (FromJSON, ToJSON) via Schema ConversationMetadata
 
-defConversationMetadata :: UserId -> ConversationMetadata
-defConversationMetadata creator =
+defConversationMetadata :: Maybe UserId -> ConversationMetadata
+defConversationMetadata mCreator =
   ConversationMetadata
     { cnvmType = RegularConv,
-      cnvmCreator = creator,
+      cnvmCreator = mCreator,
       cnvmAccess = [PrivateAccess],
       cnvmAccessRoles = mempty,
       cnvmName = Nothing,
@@ -192,10 +191,10 @@ conversationMetadataObjectSchema sch =
   ConversationMetadata
     <$> cnvmType .= field "type" schema
     <*> cnvmCreator
-      .= fieldWithDocModifier
+      .= optFieldWithDocModifier
         "creator"
         (description ?~ "The creator's user ID")
-        schema
+        (maybeWithDefault A.Null schema)
     <*> cnvmAccess .= field "access" (array schema)
     <*> cnvmAccessRoles .= sch
     <*> cnvmName .= optField "name" (maybeWithDefault A.Null schema)
@@ -241,7 +240,7 @@ data Conversation = Conversation
 cnvType :: Conversation -> ConvType
 cnvType = cnvmType . cnvMetadata
 
-cnvCreator :: Conversation -> UserId
+cnvCreator :: Conversation -> Maybe UserId
 cnvCreator = cnvmCreator . cnvMetadata
 
 cnvAccess :: Conversation -> [Access]
@@ -633,26 +632,6 @@ instance ToSchema ReceiptMode where
 --------------------------------------------------------------------------------
 -- create
 
--- | This is distinct from 'ProtocolTag', which also include ProtocolMixedTag
-data ProtocolCreateTag = ProtocolCreateProteusTag | ProtocolCreateMLSTag
-  deriving stock (Eq, Show, Enum, Bounded, Generic)
-  deriving (Arbitrary) via GenericUniform ProtocolCreateTag
-
-instance ToSchema ProtocolCreateTag where
-  schema =
-    enum @Text "ProtocolCreateTag" $
-      mconcat
-        [ element "proteus" ProtocolCreateProteusTag,
-          element "mls" ProtocolCreateMLSTag
-        ]
-
-protocolCreateToProtocolTag :: ProtocolCreateTag -> ProtocolTag
-protocolCreateToProtocolTag ProtocolCreateProteusTag = ProtocolProteusTag
-protocolCreateToProtocolTag ProtocolCreateMLSTag = ProtocolMLSTag
-
-protocolCreateTagSchema :: ObjectSchema SwaggerDoc ProtocolCreateTag
-protocolCreateTagSchema = fmap (fromMaybe ProtocolCreateProteusTag) (optField "protocol" schema)
-
 data NewConv = NewConv
   { newConvUsers :: [UserId],
     -- | A list of qualified users, which can include some local qualified users
@@ -667,7 +646,7 @@ data NewConv = NewConv
     -- | Every member except for the creator will have this role
     newConvUsersRole :: RoleName,
     -- | The protocol of the conversation. It can be Proteus or MLS (1.0).
-    newConvProtocol :: ProtocolCreateTag
+    newConvProtocol :: BaseProtocolTag
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewConv)
@@ -726,7 +705,10 @@ newConvSchema sch =
         .= ( fieldWithDocModifier "conversation_role" (description ?~ usersRoleDesc) schema
                <|> pure roleNameWireAdmin
            )
-      <*> newConvProtocol .= protocolCreateTagSchema
+      <*> newConvProtocol
+        .= fmap
+          (fromMaybe BaseProtocolProteusTag)
+          (optField "protocol" schema)
   where
     usersDesc =
       "List of user IDs (excluding the requestor) to be \

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

@@ -119,6 +119,7 @@ module Wire.API.User
 
     -- * Protocol preferences
     BaseProtocolTag (..),
+    baseProtocolToProtocol,
     SupportedProtocolUpdate (..),
     defSupportedProtocols,
     protocolSetBits,
@@ -169,6 +170,7 @@ import Servant (FromHttpApiData (..), ToHttpApiData (..), type (.++))
 import qualified Test.QuickCheck as QC
 import URI.ByteString (serializeURIRef)
 import qualified Web.Cookie as Web
+import Wire.API.Conversation.Protocol
 import Wire.API.Error
 import Wire.API.Error.Brig
 import qualified Wire.API.Error.Brig as E
@@ -1635,6 +1637,10 @@ baseProtocolMask :: BaseProtocolTag -> Word32
 baseProtocolMask BaseProtocolProteusTag = 1
 baseProtocolMask BaseProtocolMLSTag = 2
 
+baseProtocolToProtocol :: BaseProtocolTag -> ProtocolTag
+baseProtocolToProtocol BaseProtocolProteusTag = ProtocolProteusTag
+baseProtocolToProtocol BaseProtocolMLSTag = ProtocolMLSTag
+
 instance ToSchema BaseProtocolTag where
   schema =
     enum @Text "BaseProtocol" $

libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs

@@ -42,7 +42,7 @@ testObject_ConversationList_20Conversation_user_1 =
               cnvMetadata =
                 ConversationMetadata
                   { cnvmType = RegularConv,
-                    cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001")),
+                    cnvmCreator = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001"))),
                     cnvmAccess = [],
                     cnvmAccessRoles = Set.empty,
                     cnvmName = Just "",

libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Conversation_user.hs

@@ -41,7 +41,7 @@ testObject_Conversation_user_1 =
       cnvMetadata =
         ConversationMetadata
           { cnvmType = One2OneConv,
-            cnvmCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")),
+            cnvmCreator = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001"))),
             cnvmAccess = [],
             cnvmAccessRoles = Set.empty,
             cnvmName = Just " 0",
@@ -75,7 +75,7 @@ testObject_Conversation_user_2 =
       cnvMetadata =
         ConversationMetadata
           { cnvmType = SelfConv,
-            cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")),
+            cnvmCreator = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001"))),
             cnvmAccess =
               [ InviteAccess,
                 InviteAccess,

libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs

@@ -148,7 +148,7 @@ testObject_Event_user_8 =
               cnvMetadata =
                 ConversationMetadata
                   { cnvmType = RegularConv,
-                    cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")),
+                    cnvmCreator = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001"))),
                     cnvmAccess =
                       [InviteAccess, PrivateAccess, LinkAccess, InviteAccess, InviteAccess, InviteAccess, LinkAccess],
                     cnvmAccessRoles = Set.fromList [TeamMemberAccessRole, GuestAccessRole, ServiceAccessRole],

libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewConv_user.hs

@@ -27,6 +27,7 @@ import qualified Data.UUID as UUID (fromString)
 import Imports
 import Wire.API.Conversation
 import Wire.API.Conversation.Role
+import Wire.API.User
 
 testDomain :: Domain
 testDomain = Domain "testdomain.example.com"
@@ -51,7 +52,7 @@ testObject_NewConv_user_1 =
       newConvMessageTimer = Just (Ms {ms = 3320987366258987}),
       newConvReceiptMode = Just (ReceiptMode {unReceiptMode = 1}),
       newConvUsersRole = fromJust (parseRoleName "8tp2gs7b6"),
-      newConvProtocol = ProtocolCreateProteusTag
+      newConvProtocol = BaseProtocolProteusTag
     }
 
 testObject_NewConv_user_3 :: NewConv
@@ -70,5 +71,5 @@ testObject_NewConv_user_3 =
           ( parseRoleName
               "y3otpiwu615lvvccxsq0315jj75jquw01flhtuf49t6mzfurvwe3_sh51f4s257e2x47zo85rif_xyiyfldpan3g4r6zr35rbwnzm0k"
           ),
-      newConvProtocol = ProtocolCreateMLSTag
+      newConvProtocol = BaseProtocolMLSTag
     }

libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationsResponse.hs

@@ -58,7 +58,7 @@ conv1 =
       cnvMetadata =
         ConversationMetadata
           { cnvmType = One2OneConv,
-            cnvmCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")),
+            cnvmCreator = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001"))),
             cnvmAccess = [],
             cnvmAccessRoles = Set.empty,
             cnvmName = Just " 0",
@@ -92,7 +92,7 @@ conv2 =
       cnvMetadata =
         ConversationMetadata
           { cnvmType = SelfConv,
-            cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")),
+            cnvmCreator = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001"))),
             cnvmAccess =
               [ InviteAccess,
                 InviteAccess,

services/brig/test/integration/API/OAuth.hs

@@ -52,7 +52,7 @@ import Text.RawString.QQ
 import URI.ByteString
 import Util
 import Web.FormUrlEncoded
-import Wire.API.Conversation (Access (..), Conversation (cnvQualifiedId), ProtocolCreateTag (..))
+import Wire.API.Conversation
 import qualified Wire.API.Conversation as Conv
 import Wire.API.Conversation.Code (CreateConversationCodeRequest (CreateConversationCodeRequest))
 import qualified Wire.API.Conversation.Role as Role
@@ -701,7 +701,7 @@ createTeamConv ::
   Http ResponseLBS
 createTeamConv svc mkHeader token tid name = do
   let tinfo = Conv.ConvTeamInfo tid
-  let conv = Conv.NewConv [] [] (checked name) (Set.fromList [CodeAccess]) Nothing (Just tinfo) Nothing Nothing Role.roleNameWireAdmin ProtocolCreateProteusTag
+  let conv = Conv.NewConv [] [] (checked name) (Set.fromList [CodeAccess]) Nothing (Just tinfo) Nothing Nothing Role.roleNameWireAdmin BaseProtocolProteusTag
   post $
     svc
       . path "conversations"

services/brig/test/integration/API/Provider.hs

@@ -1413,7 +1413,7 @@ createConvWithAccessRoles ars g u us =
       . contentJson
       . body (RequestBodyLBS (encode conv))
   where
-    conv = NewConv us [] Nothing Set.empty ars Nothing Nothing Nothing roleNameWireAdmin ProtocolCreateProteusTag
+    conv = NewConv us [] Nothing Set.empty ars Nothing Nothing Nothing roleNameWireAdmin BaseProtocolProteusTag
 
 postMessage ::
   Galley ->

services/brig/test/integration/API/Team/Util.hs

@@ -234,7 +234,7 @@ createTeamConvWithRole role g tid u us mtimer = do
           mtimer
           Nothing
           role
-          ProtocolCreateProteusTag
+          BaseProtocolProteusTag
   r <-
     post
       ( g

services/brig/test/integration/Federation/End2end.hs

@@ -281,7 +281,7 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do
           Nothing
           Nothing
           roleNameWireAdmin
-          ProtocolCreateProteusTag
+          BaseProtocolProteusTag
   convId <-
     fmap cnvQualifiedId . responseJsonError
       =<< post