Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Refactor ciphersuite handling for 1-1 convs #4009

Merged
merged 14 commits into from
Apr 29, 2024
Merged
1 change: 1 addition & 0 deletions changelog.d/1-api-changes/mls-ciphersuite
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
The `cipher_suite` field is not present anymore in objects corresponding to newly created conversations
4 changes: 1 addition & 3 deletions integration/test/MLS/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -202,11 +202,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
Expand Down
21 changes: 17 additions & 4 deletions integration/test/Test/MLS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
19 changes: 14 additions & 5 deletions integration/test/Test/MLS/One2One.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,18 +25,26 @@ import qualified Data.Set as Set
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"

Expand All @@ -47,7 +55,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
Expand Down Expand Up @@ -220,8 +228,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
Expand Down
13 changes: 13 additions & 0 deletions integration/test/Test/Version.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,19 @@ instance TestCases Versioned' where
MkTestCase "[version=v6]" (Versioned' (ExplicitVersion 6))
]

-- | Used to test endpoints that have changed after version 5
data Version5 = Version5 | NoVersion5

instance TestCases Version5 where
testCases =
[ MkTestCase "[version=versioned]" NoVersion5,
MkTestCase "[version=v5]" 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])}
Expand Down
7 changes: 7 additions & 0 deletions integration/test/Testlib/JSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
)
)
)
}
89 changes: 46 additions & 43 deletions libs/wire-api/src/Wire/API/Conversation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -104,11 +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
Expand Down Expand Up @@ -155,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)
Expand Down Expand Up @@ -266,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)

Expand All @@ -303,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.
Expand Down Expand Up @@ -365,7 +371,7 @@ instance ToSchema (Versioned 'V2 (ConversationList Conversation)) where
schema =
Versioned
<$> unVersioned
.= conversationListSchema (conversationSchema V2)
.= conversationListSchema (conversationSchema (Just V2))

conversationListSchema ::
forall a.
Expand Down Expand Up @@ -427,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
Expand Down Expand Up @@ -659,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
Expand Down Expand Up @@ -831,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
Expand Down
Loading
Loading