Add conversation.protocol-update event (#3277)

wireapp · May 9, 2023 · 33e5487 · 33e5487
1 parent 3a1f7e8
commit 33e5487
Show file tree

Hide file tree

Showing 11 changed files with 105 additions and 52 deletions.
diff --git a/integration/integration.cabal b/integration/integration.cabal
@@ -89,6 +89,7 @@ library
     Test.B2B
     Test.Brig
     Test.Demo
+    Test.MLS
     Testlib.App
     Testlib.Assertions
     Testlib.Cannon

diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs
@@ -77,16 +77,16 @@ putConversationProtocol ::
   ( HasCallStack,
     MakesValue user,
     MakesValue qcnv,
-    MakesValue conn,
+    MakesValue client,
     MakesValue protocol
   ) =>
   user ->
   qcnv ->
-  Maybe conn ->
+  Maybe client ->
   protocol ->
   App Response
-putConversationProtocol user qcnv mconn protocol = do
-  mconn' <- for mconn asString
+putConversationProtocol user qcnv mclient protocol = do
+  mclientId <- for mclient objId
   (domain, cnv) <- objQid qcnv
   p <- asString protocol
   uid <- objId user
@@ -95,7 +95,8 @@ putConversationProtocol user qcnv mconn protocol = do
     "PUT"
     ( req
         & zUser uid
-        & zConnection (fromMaybe "conn" mconn')
+        & zConnection "conn"
+        & maybe id zClient mclientId
         & addJSONObject ["protocol" .= p]
     )
 

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
@@ -0,0 +1,35 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module Test.MLS where
+
+import qualified API.Brig as Public
+import qualified API.Galley as Public
+import SetupHelpers
+import Testlib.Prelude
+
+testMixedProtocolUpgrade :: HasCallStack => App ()
+testMixedProtocolUpgrade = do
+  [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
+
+  bobClient <- bindResponse (Public.addClient bob def {Public.ctype = "legalhold", Public.internal = True}) $ \resp -> do
+    resp.status `shouldMatchInt` 201
+    resp.json
+
+  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 (Just bobClient) "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 bob qcnv (Just bobClient) "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 204
diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/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)

diff --git 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 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

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
@@ -1267,9 +1267,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)
            )
diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/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

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
@@ -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)
+    }
diff --git a/libs/wire-api/test/golden/testObject_Event_conversation_manual_2.json b/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"
+}
diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs
@@ -125,7 +125,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
@@ -690,15 +691,18 @@ updateConversationProtocolWithLocalUser ::
     Member (ErrorS 'ConvInvalidProtocolTransition) r,
     Member (ErrorS 'ConvMemberNotFound) r,
     Member (Error FederationError) r,
+    Member (Input UTCTime) r,
     Member MemberStore r,
+    Member GundeckAccess r,
+    Member ExternalAccess r,
     Member ConversationStore r
   ) =>
   Local UserId ->
   ClientId ->
   ConnId ->
   Qualified ConvId ->
-  ProtocolUpdate ->
-  Sem r ()
+  P.ProtocolUpdate ->
+  Sem r (UpdateResult Event)
 updateConversationProtocolWithLocalUser lusr client conn qcnv update =
   foldQualified
     lusr
@@ -711,28 +715,36 @@ updateLocalConversationProtocol ::
   ( Member (ErrorS 'ConvNotFound) r,
     Member (ErrorS 'ConvInvalidProtocolTransition) r,
     Member (ErrorS 'ConvMemberNotFound) r,
+    Member (Input UTCTime) r,
     Member MemberStore r,
+    Member GundeckAccess r,
+    Member ExternalAccess r,
     Member ConversationStore r
   ) =>
   Qualified UserId ->
   ClientId ->
   Maybe ConnId ->
   Local ConvId ->
-  ProtocolUpdate ->
-  Sem r ()
-updateLocalConversationProtocol qusr client _mconn lcnv (ProtocolUpdate newProtocol) = do
+  P.ProtocolUpdate ->
+  Sem r (UpdateResult Event)
+updateLocalConversationProtocol qusr client 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
       E.addMLSClients (convToGroupId lcnv) qusr (Set.singleton (client, nullKeyPackageRef))
+      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 ::

diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
@@ -266,8 +266,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
         ]
     ]
 
@@ -3593,35 +3592,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)