diff --git a/changelog.d/5-internal/mixed-protocol b/changelog.d/5-internal/mixed-protocol new file mode 100644 index 00000000000..235a1f2ac41 --- /dev/null +++ b/changelog.d/5-internal/mixed-protocol @@ -0,0 +1 @@ +Add intermediate "mixed" protocol for migrating from Proteus to MLS diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs index 7a83931f0e5..7bec6c7d9b2 100644 --- a/integration/test/Test/MLS.hs +++ b/integration/test/Test/MLS.hs @@ -10,19 +10,29 @@ import SetupHelpers import Testlib.Prelude testMixedProtocolUpgrade :: HasCallStack => App () -testMixedProtocolUpgrade = do - [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain] +testMixedProtocolUpgrade = ptestMixedProtocolUpgrade ownDomain + +testMixedProtocolUpgradeFed :: HasCallStack => App () +testMixedProtocolUpgradeFed = ptestMixedProtocolUpgrade otherDomain + +ptestMixedProtocolUpgrade :: (HasCallStack, MakesValue domain) => domain -> App () +ptestMixedProtocolUpgrade secondDomain = do + [alice, bob, charlie] <- do + d <- ownDomain + d2 <- secondDomain & asString + createAndConnectUsers [d, d2, d2] qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201 - withWebSocket alice $ \wsAlice -> do + withWebSockets [alice, charlie] $ \websockets -> do bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "conversation" `shouldMatch` (qcnv %. "id") resp.json %. "data.protocol" `shouldMatch` "mixed" - n <- awaitMatch 3 (\value -> nPayload value %. "type" `isEqual` "conversation.protocol-update") wsAlice - nPayload n %. "data.protocol" `shouldMatch` "mixed" + for_ websockets $ \ws -> do + n <- awaitMatch 3 (\value -> nPayload value %. "type" `isEqual` "conversation.protocol-update") ws + nPayload n %. "data.protocol" `shouldMatch` "mixed" bindResponse (getConversation alice qcnv) $ \resp -> do resp.status `shouldMatchInt` 200 diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 5d98193fd37..c7a1c0e0ad8 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -46,6 +46,7 @@ import Data.Time.Clock import Imports import Wire.API.Conversation import Wire.API.Conversation.Action.Tag +import Wire.API.Conversation.Protocol (ProtocolTag) import Wire.API.Conversation.Role import Wire.API.Event.Conversation import Wire.API.MLS.SubConversation @@ -63,6 +64,7 @@ type family ConversationAction (tag :: ConversationActionTag) :: Type where ConversationAction 'ConversationReceiptModeUpdateTag = ConversationReceiptModeUpdate ConversationAction 'ConversationAccessDataTag = ConversationAccessData ConversationAction 'ConversationRemoveMembersTag = NonEmptyList.NonEmpty (Qualified UserId) + ConversationAction 'ConversationUpdateProtocolTag = ProtocolTag data SomeConversationAction where SomeConversationAction :: Sing tag -> ConversationAction tag -> SomeConversationAction @@ -105,6 +107,7 @@ conversationActionSchema SConversationRenameTag = schema conversationActionSchema SConversationMessageTimerUpdateTag = schema conversationActionSchema SConversationReceiptModeUpdateTag = schema conversationActionSchema SConversationAccessDataTag = schema +conversationActionSchema SConversationUpdateProtocolTag = schema instance FromJSON SomeConversationAction where parseJSON = A.withObject "SomeConversationAction" $ \ob -> do @@ -136,6 +139,7 @@ $( singletons conversationActionPermission ConversationMessageTimerUpdateTag = ModifyConversationMessageTimer conversationActionPermission ConversationReceiptModeUpdateTag = ModifyConversationReceiptMode conversationActionPermission ConversationAccessDataTag = ModifyConversationAccess + conversationActionPermission ConversationUpdateProtocolTag = LeaveConversation |] ) @@ -166,4 +170,5 @@ conversationActionToEvent tag now quid qcnv subconv action = SConversationMessageTimerUpdateTag -> EdConvMessageTimerUpdate action SConversationReceiptModeUpdateTag -> EdConvReceiptModeUpdate action SConversationAccessDataTag -> EdConvAccessUpdate action + SConversationUpdateProtocolTag -> EdProtocolUpdate action in Event qcnv subconv quid now edata diff --git a/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs index 3445e3794ff..00e46cdfdf5 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs @@ -38,6 +38,7 @@ data ConversationActionTag | ConversationMessageTimerUpdateTag | ConversationReceiptModeUpdateTag | ConversationAccessDataTag + | ConversationUpdateProtocolTag deriving (Show, Eq, Generic, Bounded, Enum) instance Arbitrary ConversationActionTag where @@ -55,7 +56,8 @@ instance ToSchema ConversationActionTag where element "ConversationRenameTag" ConversationRenameTag, element "ConversationMessageTimerUpdateTag" ConversationMessageTimerUpdateTag, element "ConversationReceiptModeUpdateTag" ConversationReceiptModeUpdateTag, - element "ConversationAccessDataTag" ConversationAccessDataTag + element "ConversationAccessDataTag" ConversationAccessDataTag, + element "ConversationUpdateProtocolTag" ConversationUpdateProtocolTag ] instance ToJSON ConversationActionTag where diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 2b0340d0549..843de0020c4 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -81,6 +81,7 @@ import qualified Test.QuickCheck as QC import URI.ByteString () import Wire.API.Conversation import Wire.API.Conversation.Code (ConversationCode (..), ConversationCodeInfo) +import Wire.API.Conversation.Protocol (ProtocolUpdate (unProtocolUpdate)) import qualified Wire.API.Conversation.Protocol as P import Wire.API.Conversation.Role import Wire.API.Conversation.Typing @@ -179,7 +180,7 @@ data EventData | EdOtrMessage OtrMessage | EdMLSMessage ByteString | EdMLSWelcome ByteString - | EdProtocolUpdate P.ProtocolUpdate + | EdProtocolUpdate P.ProtocolTag deriving stock (Eq, Show, Generic) genEventData :: EventType -> QC.Gen EventData @@ -400,7 +401,7 @@ taggedEventDataSchema = Typing -> tag _EdTyping (unnamed schema) ConvCodeDelete -> tag _EdConvCodeDelete null_ ConvDelete -> tag _EdConvDelete null_ - ProtocolUpdate -> tag _EdProtocolUpdate (unnamed schema) + ProtocolUpdate -> tag _EdProtocolUpdate (unnamed (unProtocolUpdate <$> P.ProtocolUpdate .= schema)) instance ToSchema Event where schema = object "Event" eventObjectSchema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index 173956dc097..cdd91ba959b 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs @@ -1253,7 +1253,8 @@ type ConversationAPI = :> Description "**Note**: Only proteus->mixed upgrade is supported." :> CanThrow 'ConvNotFound :> CanThrow 'ConvInvalidProtocolTransition - :> CanThrow 'ConvMemberNotFound + :> CanThrow ('ActionDenied 'LeaveConversation) + :> CanThrow 'InvalidOperation :> ZLocalUser :> ZConn :> "conversations" diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationEvent.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationEvent.hs index 7f711fd1f4c..6132fec18a6 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationEvent.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationEvent.hs @@ -44,5 +44,5 @@ testObject_Event_conversation_manual_2 = evtSubConv = Nothing, evtFrom = Qualified {qUnqualified = Id (fromJust (UUID.fromString "a471447c-aa30-4592-81b0-dec6c1c02bca")), qDomain = Domain {_domainText = "example.com"}}, evtTime = UTCTime {utctDay = ModifiedJulianDay 58119, utctDayTime = 0}, - evtData = EdProtocolUpdate (P.ProtocolUpdate P.ProtocolMixedTag) + evtData = EdProtocolUpdate P.ProtocolMixedTag } diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 48e0e3c6a2f..e2cb8b7d7de 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -98,6 +98,7 @@ import Wire.API.Event.Conversation import Wire.API.Federation.API (Component (Galley), fedClient) import Wire.API.Federation.API.Galley import Wire.API.Federation.Error +import Wire.API.MLS.CipherSuite import Wire.API.Team.LegalHold import Wire.API.Team.Member import qualified Wire.API.User as User @@ -209,6 +210,11 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con ( Member ConversationStore r, Member (Error NoChanges) r ) + HasConversationActionEffects 'ConversationUpdateProtocolTag r = + ( Member ConversationStore r, + Member (ErrorS 'ConvInvalidProtocolTransition) r, + Member (Error NoChanges) r + ) type family HasConversationActionGalleyErrors (tag :: ConversationActionTag) :: EffectRow where HasConversationActionGalleyErrors 'ConversationJoinTag = @@ -266,6 +272,12 @@ type family HasConversationActionGalleyErrors (tag :: ConversationActionTag) :: ErrorS 'InvalidTargetAccess, ErrorS 'ConvNotFound ] + HasConversationActionGalleyErrors 'ConversationUpdateProtocolTag = + '[ ErrorS ('ActionDenied 'LeaveConversation), + ErrorS 'InvalidOperation, + ErrorS 'ConvNotFound, + ErrorS 'ConvInvalidProtocolTransition + ] noChanges :: Member (Error NoChanges) r => Sem r a noChanges = throw NoChanges @@ -384,6 +396,18 @@ performAction tag origUser lconv action = do SConversationAccessDataTag -> do (bm, act) <- performConversationAccessData origUser lconv action pure (bm, act) + SConversationUpdateProtocolTag -> do + case (protocolTag (convProtocol (tUnqualified lconv)), action) of + (ProtocolProteusTag, ProtocolMixedTag) -> do + E.updateToMixedProtocol lcnv MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + pure (mempty, action) + (ProtocolProteusTag, ProtocolProteusTag) -> + noChanges + (ProtocolMixedTag, ProtocolMixedTag) -> + noChanges + (ProtocolMLSTag, ProtocolMLSTag) -> + noChanges + (_, _) -> throwS @'ConvInvalidProtocolTransition performConversationJoin :: ( HasConversationActionEffects 'ConversationJoinTag r diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 83fca15d352..c916c0376f4 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -522,6 +522,11 @@ updateConversation origDomain updateRequest = do @(HasConversationActionGalleyErrors 'ConversationAccessDataTag) . fmap lcuUpdate $ updateLocalConversation @'ConversationAccessDataTag lcnv (tUntagged rusr) Nothing action + SConversationUpdateProtocolTag -> + mapToGalleyError + @(HasConversationActionGalleyErrors 'ConversationUpdateProtocolTag) + . fmap lcuUpdate + $ updateLocalConversation @'ConversationUpdateProtocolTag lcnv (tUntagged rusr) Nothing action where mkResponse = fmap toResponse . runError @GalleyError . runError @NoChanges diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index b1002a06386..d8eb5970e0d 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -133,7 +133,6 @@ import Wire.API.Connection (Relation (Accepted)) import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Action import Wire.API.Conversation.Code -import Wire.API.Conversation.Protocol (ProtocolTag (..), protocolTag) import qualified Wire.API.Conversation.Protocol as P import Wire.API.Conversation.Role import Wire.API.Conversation.Typing @@ -144,7 +143,6 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Error -import Wire.API.MLS.CipherSuite import Wire.API.Message import Wire.API.Password (mkSafePassword) import Wire.API.Provider.Service (ServiceRef) @@ -355,7 +353,9 @@ updateConversationReceiptMode lusr zcon qcnv update = (Just zcon) update ) - (\rcnv -> updateRemoteConversation @'ConversationReceiptModeUpdateTag rcnv lusr zcon update) + ( \rcnv -> + updateRemoteConversation @'ConversationReceiptModeUpdateTag rcnv lusr zcon update + ) qcnv updateRemoteConversation :: @@ -367,7 +367,7 @@ updateRemoteConversation :: Member (Input (Local ())) r, Member MemberStore r, Member TinyLog r, - RethrowErrors (HasConversationActionGalleyErrors tag) (Error NoChanges : r), + RethrowErrors (HasConversationActionGalleyErrors tag) r, SingI tag ) => Remote ConvId -> @@ -385,7 +385,7 @@ updateRemoteConversation rcnv lusr conn action = getUpdateResult $ do response <- E.runFederated rcnv (fedClient @'Galley @"update-conversation" updateRequest) convUpdate <- case response of ConversationUpdateResponseNoChanges -> throw NoChanges - ConversationUpdateResponseError err' -> rethrowErrors @(HasConversationActionGalleyErrors tag) err' + ConversationUpdateResponseError err' -> raise $ rethrowErrors @(HasConversationActionGalleyErrors tag) err' ConversationUpdateResponseUpdate convUpdate -> pure convUpdate updateLocalStateOfRemoteConv (tDomain rcnv) convUpdate @@ -697,11 +697,18 @@ updateConversationProtocolWithLocalUser :: forall r. ( Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'ConvInvalidProtocolTransition) r, - Member (ErrorS 'ConvMemberNotFound) r, + Member (ErrorS ('ActionDenied 'LeaveConversation)) r, + Member (ErrorS 'InvalidOperation) r, Member (Error FederationError) r, Member (Input UTCTime) r, + Member (Input (Local ())) r, + Member BrigAccess r, + Member MemberStore r, + Member TinyLog r, Member GundeckAccess r, Member ExternalAccess r, + Member FederatorAccess r, + Member SubConversationStore r, Member ConversationStore r ) => Local UserId -> @@ -709,47 +716,21 @@ updateConversationProtocolWithLocalUser :: Qualified ConvId -> P.ProtocolUpdate -> Sem r (UpdateResult Event) -updateConversationProtocolWithLocalUser lusr conn qcnv update = +updateConversationProtocolWithLocalUser lusr conn qcnv (P.ProtocolUpdate newProtocol) = foldQualified lusr - (\lcnv -> updateLocalConversationProtocol (tUntagged lusr) (Just conn) lcnv update) - (\_rcnv -> throw FederationNotImplemented) + ( \lcnv -> do + fmap (maybe Unchanged (Updated . lcuEvent) . hush) + . runError @NoChanges + . updateLocalConversation @'ConversationUpdateProtocolTag lcnv (tUntagged lusr) (Just conn) + $ newProtocol + ) + ( \rcnv -> + updateRemoteConversation @'ConversationUpdateProtocolTag rcnv lusr conn $ + newProtocol + ) qcnv -updateLocalConversationProtocol :: - forall r. - ( Member (ErrorS 'ConvNotFound) r, - Member (ErrorS 'ConvInvalidProtocolTransition) r, - Member (ErrorS 'ConvMemberNotFound) r, - Member (Input UTCTime) r, - Member GundeckAccess r, - Member ExternalAccess r, - Member ConversationStore r - ) => - Qualified UserId -> - Maybe ConnId -> - Local ConvId -> - P.ProtocolUpdate -> - Sem r (UpdateResult Event) -updateLocalConversationProtocol qusr mconn lcnv protocolUpdate@(P.ProtocolUpdate newProtocol) = do - conv <- E.getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound - void $ ensureOtherMember lcnv qusr conv - case (protocolTag (convProtocol conv), newProtocol) of - (ProtocolProteusTag, ProtocolMixedTag) -> do - E.updateToMixedProtocol lcnv MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - let (bots, users) = localBotsAndUsers $ Data.convLocalMembers conv - now <- input - let e = Event (tUntagged lcnv) Nothing qusr now (EdProtocolUpdate protocolUpdate) - pushConversationEvent mconn e (qualifyAs lcnv (map lmId users)) bots - pure (Updated e) - (ProtocolProteusTag, ProtocolProteusTag) -> - pure Unchanged - (ProtocolMixedTag, ProtocolMixedTag) -> - pure Unchanged - (ProtocolMLSTag, ProtocolMLSTag) -> - pure Unchanged - (_, _) -> throwS @'ConvInvalidProtocolTransition - joinConversationByReusableCode :: forall db r. ( Member BrigAccess r, @@ -1750,6 +1731,7 @@ updateLocalStateOfRemoteConv requestingDomain cu = do SConversationMessageTimerUpdateTag -> pure (Just sca, []) SConversationReceiptModeUpdateTag -> pure (Just sca, []) SConversationAccessDataTag -> pure (Just sca, []) + SConversationUpdateProtocolTag -> pure (Just sca, []) unless allUsersArePresent $ P.warn $ diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index d0e6fe37a9c..6229b2c36a3 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -1247,3 +1247,5 @@ getConvAction tquery (SomeConversationAction tag action) = (SConversationAccessDataTag, _) -> Nothing (SConversationRemoveMembersTag, SConversationRemoveMembersTag) -> Just action (SConversationRemoveMembersTag, _) -> Nothing + (SConversationUpdateProtocolTag, SConversationUpdateProtocolTag) -> Just action + (SConversationUpdateProtocolTag, _) -> Nothing