Add conversation.protocol-update event

integration/integration.cabal

@@ -89,6 +89,7 @@ library
     Test.B2B
     Test.Brig
     Test.Demo
+    Test.MLS
     Testlib.App
     Testlib.Assertions
     Testlib.Cannon

integration/test/Test/MLS.hs

@@ -0,0 +1,30 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module Test.MLS where
+
+import qualified API.Galley as Public
+import SetupHelpers
+import Testlib.Prelude
+
+testMixedProtocolUpgrade :: HasCallStack => App ()
+testMixedProtocolUpgrade = do
+  [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
+
+  qcnv <- bindResponseR (Public.postConversation alice noValue Public.defProteus {Public.qualifiedUsers = [bob]}) $ \resp -> do
+    resp.status `shouldMatchInt` 201
+
+  withWebSocket alice $ \wsAlice -> do
+    bindResponse (Public.putConversationProtocol bob qcnv noValue "mixed") $ \resp -> do
+      resp.status `shouldMatchInt` 200
+      resp %. "conversation" `shouldMatch` (qcnv %. "id")
+      resp %. "data.protocol" `shouldMatch` "mixed"
+
+    n <- awaitMatch 3 (\value -> nPayload value %. "type" `isEqual` "conversation.protocol-update") wsAlice
+    nPayload n %. "data.protocol" `shouldMatch` "mixed"
+
+  bindResponse (Public.getConversation alice qcnv) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp %. "protocol" `shouldMatch` "mixed"
+
+  bindResponse (Public.putConversationProtocol alice qcnv noValue "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 204

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

@@ -158,6 +158,8 @@ protocolDataSchema ProtocolMLSTag = tag _ProtocolMLS mlsDataSchema
 protocolDataSchema ProtocolMixedTag = tag _ProtocolMixed mlsDataSchema
 
 newtype ProtocolUpdate = ProtocolUpdate {unProtocolUpdate :: ProtocolTag}
+  deriving (Show, Eq, Generic)
+  deriving (Arbitrary) via GenericUniform ProtocolUpdate
 
 instance ToSchema ProtocolUpdate where
   schema = object "ProtocolUpdate" (ProtocolUpdate <$> unProtocolUpdate .= protocolTagSchema)

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 qualified Wire.API.Conversation.Protocol as P
 import Wire.API.Conversation.Role
 import Wire.API.Conversation.Typing
 import Wire.API.MLS.SubConversation
@@ -133,6 +134,7 @@ data EventType
   | MLSMessageAdd
   | MLSWelcome
   | Typing
+  | ProtocolUpdate
   deriving stock (Eq, Show, Generic, Enum, Bounded, Ord)
   deriving (Arbitrary) via (GenericUniform EventType)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema EventType
@@ -156,7 +158,8 @@ instance ToSchema EventType where
           element "conversation.typing" Typing,
           element "conversation.otr-message-add" OtrMessageAdd,
           element "conversation.mls-message-add" MLSMessageAdd,
-          element "conversation.mls-welcome" MLSWelcome
+          element "conversation.mls-welcome" MLSWelcome,
+          element "conversation.protocol-update" ProtocolUpdate
         ]
 
 data EventData
@@ -176,6 +179,7 @@ data EventData
   | EdOtrMessage OtrMessage
   | EdMLSMessage ByteString
   | EdMLSWelcome ByteString
+  | EdProtocolUpdate P.ProtocolUpdate
   deriving stock (Eq, Show, Generic)
 
 genEventData :: EventType -> QC.Gen EventData
@@ -196,6 +200,7 @@ genEventData = \case
   MLSMessageAdd -> EdMLSMessage <$> arbitrary
   MLSWelcome -> EdMLSWelcome <$> arbitrary
   ConvDelete -> pure EdConvDelete
+  ProtocolUpdate -> EdProtocolUpdate <$> arbitrary
 
 eventDataType :: EventData -> EventType
 eventDataType (EdMembersJoin _) = MemberJoin
@@ -214,6 +219,7 @@ eventDataType (EdOtrMessage _) = OtrMessageAdd
 eventDataType (EdMLSMessage _) = MLSMessageAdd
 eventDataType (EdMLSWelcome _) = MLSWelcome
 eventDataType EdConvDelete = ConvDelete
+eventDataType (EdProtocolUpdate _) = ProtocolUpdate
 
 --------------------------------------------------------------------------------
 -- Event data helpers
@@ -394,6 +400,7 @@ taggedEventDataSchema =
       Typing -> tag _EdTyping (unnamed schema)
       ConvCodeDelete -> tag _EdConvCodeDelete null_
       ConvDelete -> tag _EdConvDelete null_
+      ProtocolUpdate -> tag _EdProtocolUpdate (unnamed schema)
 
 instance ToSchema Event where
   schema = object "Event" eventObjectSchema

libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs

@@ -1260,9 +1260,5 @@ type ConversationAPI =
                :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId
                :> "protocol"
                :> ReqBody '[JSON] ProtocolUpdate
-               :> MultiVerb
-                    'PUT
-                    '[JSON]
-                    '[RespondEmpty 200 "Update successful"]
-                    ()
+               :> MultiVerb 'PUT '[Servant.JSON] ConvUpdateResponses (UpdateResult Event)
            )

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

@@ -73,7 +73,8 @@ tests =
           ],
       testGroup "ConversationEvent" $
         testObjects
-          [ (testObject_Event_conversation_manual_1, "testObject_Event_conversation_manual_1.json")
+          [ (testObject_Event_conversation_manual_1, "testObject_Event_conversation_manual_1.json"),
+            (testObject_Event_conversation_manual_2, "testObject_Event_conversation_manual_2.json")
           ],
       testGroup "GetPaginatedConversationIds" $
         testObjects

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

@@ -23,6 +23,7 @@ import Data.Qualified (Qualified (..))
 import Data.Time
 import qualified Data.UUID as UUID
 import Imports
+import qualified Wire.API.Conversation.Protocol as P
 import Wire.API.Event.Conversation
 import Wire.API.MLS.SubConversation
 
@@ -35,3 +36,13 @@ testObject_Event_conversation_manual_1 =
       evtTime = UTCTime {utctDay = ModifiedJulianDay 58119, utctDayTime = 0},
       evtData = EdConvCodeDelete
     }
+
+testObject_Event_conversation_manual_2 :: Event
+testObject_Event_conversation_manual_2 =
+  Event
+    { evtConv = Qualified {qUnqualified = Id (fromJust (UUID.fromString "2126ea99-ca79-43ea-ad99-a59616468e8e")), qDomain = Domain {_domainText = "example.com"}},
+      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)
+    }

libs/wire-api/test/golden/testObject_Event_conversation_manual_2.json

@@ -0,0 +1,17 @@
+{
+    "conversation": "2126ea99-ca79-43ea-ad99-a59616468e8e",
+    "data": {
+        "protocol": "mixed"
+    },
+    "from": "a471447c-aa30-4592-81b0-dec6c1c02bca",
+    "qualified_conversation": {
+        "domain": "example.com",
+        "id": "2126ea99-ca79-43ea-ad99-a59616468e8e"
+    },
+    "qualified_from": {
+        "domain": "example.com",
+        "id": "a471447c-aa30-4592-81b0-dec6c1c02bca"
+    },
+    "time": "2018-01-01T00:00:00.000Z",
+    "type": "conversation.protocol-update"
+}

services/galley/src/Galley/API/Update.hs

@@ -124,7 +124,8 @@ import System.Logger (Msg)
 import Wire.API.Conversation hiding (Member)
 import Wire.API.Conversation.Action
 import Wire.API.Conversation.Code
-import Wire.API.Conversation.Protocol (ProtocolTag (..), ProtocolUpdate (ProtocolUpdate), protocolTag)
+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
 import Wire.API.Error
@@ -688,17 +689,20 @@ updateConversationProtocolWithLocalUser ::
     Member (ErrorS 'ConvInvalidProtocolTransition) r,
     Member (ErrorS 'ConvMemberNotFound) r,
     Member (Error FederationError) r,
+    Member (Input UTCTime) r,
+    Member GundeckAccess r,
+    Member ExternalAccess r,
     Member ConversationStore r
   ) =>
   Local UserId ->
   ConnId ->
   Qualified ConvId ->
-  ProtocolUpdate ->
-  Sem r ()
-updateConversationProtocolWithLocalUser lusr _conn qcnv update =
+  P.ProtocolUpdate ->
+  Sem r (UpdateResult Event)
+updateConversationProtocolWithLocalUser lusr conn qcnv update =
   foldQualified
     lusr
-    (\lcnv -> updateLocalConversationProtocol (tUntagged lusr) lcnv update)
+    (\lcnv -> updateLocalConversationProtocol (tUntagged lusr) (Just conn) lcnv update)
     (\_rcnv -> throw FederationNotImplemented)
     qcnv
 
@@ -707,24 +711,33 @@ updateLocalConversationProtocol ::
   ( 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 ->
-  ProtocolUpdate ->
-  Sem r ()
-updateLocalConversationProtocol qusr lcnv (ProtocolUpdate newProtocol) = do
+  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) ->
+    (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 ()
+      pure Unchanged
     (ProtocolMixedTag, ProtocolMixedTag) ->
-      pure ()
+      pure Unchanged
     (ProtocolMLSTag, ProtocolMLSTag) ->
-      pure ()
+      pure Unchanged
     (_, _) -> throwS @'ConvInvalidProtocolTransition
 
 joinConversationByReusableCode ::

services/galley/test/integration/API/MLS.hs

@@ -261,8 +261,7 @@ tests s =
         ],
       testGroup
         "MixedProtocol"
-        [ test s "Upgrade a conv from proteus to mixed" testMixedUpgrade,
-          test s "Add clients to a mixed conversation and send proteus message" testMixedAddClients
+        [ test s "Add clients to a mixed conversation and send proteus message" testMixedAddClients
         ]
     ]
 
@@ -3468,35 +3467,6 @@ testCreatorRemovesUserFromParent = do
               (sort [alice1, charlie1, charlie2])
               (sort $ pscMembers sub2)
 
-testMixedUpgrade :: TestM ()
-testMixedUpgrade = do
-  [alice, bob] <- createAndConnectUsers (replicate 2 Nothing)
-
-  runMLSTest $ do
-    [alice1] <- traverse createMLSClient [alice]
-
-    qcnv <-
-      cnvQualifiedId
-        <$> liftTest
-          ( postConvQualified (qUnqualified alice) Nothing defNewProteusConv {newConvQualifiedUsers = [bob]}
-              >>= responseJsonError
-          )
-
-    putConversationProtocol (qUnqualified alice) (ciClient alice1) qcnv ProtocolMixedTag
-      !!! const 200 === statusCode
-
-    conv <-
-      responseJsonError
-        =<< getConvQualified (qUnqualified alice) qcnv
-          <!! const 200 === statusCode
-
-    mlsData <- assertMixedProtocol conv
-
-    liftIO $ assertEqual "" (cnvmlsEpoch mlsData) (Epoch 0)
-
-    putConversationProtocol (qUnqualified alice) (ciClient alice1) qcnv ProtocolMixedTag
-      !!! const 200 === statusCode
-
 testMixedAddClients :: TestM ()
 testMixedAddClients = do
   [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing)