[WPB-3664] Bug fix: Notify remote backends of their users removed from conversation when reachable again (#3537)

* Formatting

* Test utilities for changing a conv name

* Add a test confirming the bug report

* An action to enqueue notifications concurrently

* Enqueue member removal notification for remotes

* Add a changelog

* Test case formatting

* Migrate test roleUpdateWithRemotesUnavailable

* Migrate test putReceiptModeWithRemotesOk

* Migrate test putReceiptModeWithRemotesUnavailable

* Migrate test testRoleUpdateWithRemotesOk

* Migrate test roleUpdateRemoteMember

* Migrate test putQualifiedConvRenameWithRemotesUnavailable

This one is already covered by testSynchroniseUserRemovalNotification

* Migrate test putQualifiedConvRenameWithRemotesOk

* Migrate test deleteLocalMemberConvLocalQualifiedOk

* Migrate test deleteRemoteMemberConvLocalQualifiedOk

* Migrate test deleteUnavailableRemoteMemberConvLocalQualifiedOk

* Add the copyright header to a test module

* Move a test utility (allPreds)

* Test utility: create a team with members

* Migrate test testAccessUpdateGuestRemoved

* Migrate test messageTimerChangeWithRemotes

* Migrate test messageTimerUnavailableRemotes

* Migrate test testAccessUpdateGuestRemovedRemotesUnavailable

* Migrate test accessUpdateWithRemotes

* Migrate test testAddRemoteMember

* Migrate test testDeleteTeamConversationWithRemoteMembers

* Migrate test testDeleteTeamConversationWithUnavailableRemoteMembers

* Move a test utility (assertLeaveNotification)

* Migrate test "POST /federation/leave-conversation : Success"

* Migrate test "POST /federation/on-user-deleted-conversations : Remove deleted remote user from local conversations"

* Migrate test updateConversationByRemoteAdmin

* Tests: support giving a role when adding

* Use cannon API for notifications when possible

* Use startDynamicBackends when possible

* Fix assertion

* Migrate test testAddRemoteUsersToLocalConv

* Test add member endpoint at version 1

* Add return value to enqueueNotification

* Use cannon assertions in offline backends test

* Check that remote notifications are received

* Test removal of users from unreachable backends

* Use correct domains for default backends

Taking the domains in the `backendA` and `backendB` resources only works
locally.

* fixup! Use cannon assertions in offline backends test

---------

Co-authored-by: Paolo Capriotti <[email protected]>
Co-authored-by: Akshay Mankar <[email protected]>

Author: 3 people

changelog.d/3-bug-fixes/remote-member-removal-notification

@@ -0,0 +1 @@
+This fixes a bug where a remote member is removed from a conversation while their backend is unreachable, and the backend does not receive the removal notification once it is reachable again.

integration/default.nix

@@ -19,6 +19,7 @@
 , cql-io
 , cryptonite
 , data-default
+, data-timeout
 , directory
 , errors
 , exceptions
@@ -86,6 +87,7 @@ mkDerivation {
     cql-io
     cryptonite
     data-default
+    data-timeout
     directory
     errors
     exceptions

integration/integration.cabal

@@ -100,6 +100,7 @@ library
     Notifications
     RunAllTests
     SetupHelpers
+    Test.AccessUpdate
     Test.AssetDownload
     Test.B2B
     Test.Brig
@@ -108,8 +109,10 @@ library
     Test.Demo
     Test.Federation
     Test.Federator
+    Test.MessageTimer
     Test.Notifications
     Test.Presence
+    Test.Roles
     Test.User
     Testlib.App
     Testlib.Assertions
@@ -146,6 +149,7 @@ library
     , cql-io
     , cryptonite
     , data-default
+    , data-timeout
     , directory
     , errors
     , exceptions

integration/test/API/Galley.hs

@@ -5,6 +5,7 @@ module API.Galley where
 import Control.Lens hiding ((.=))
 import Control.Monad.Reader
 import Data.Aeson qualified as Aeson
+import Data.Aeson.Types qualified as Aeson
 import Data.ByteString.Lazy qualified as LBS
 import Data.ProtoLens qualified as Proto
 import Data.ProtoLens.Labels ()
@@ -80,6 +81,21 @@ postConversation user cc = do
   ccv <- make cc
   submit "POST" $ req & addJSON ccv
 
+deleteTeamConversation ::
+  ( HasCallStack,
+    MakesValue user,
+    MakesValue conv
+  ) =>
+  String ->
+  conv ->
+  user ->
+  App Response
+deleteTeamConversation tid qcnv user = do
+  cnv <- snd <$> objQid qcnv
+  let path = joinHttpPath ["teams", tid, "conversations", cnv]
+  req <- baseRequest user Galley Versioned path
+  submit "DELETE" req
+
 putConversationProtocol ::
   ( HasCallStack,
     MakesValue user,
@@ -217,12 +233,39 @@ getGroupInfo user conv = do
   req <- baseRequest user Galley Versioned path
   submit "GET" req
 
-addMembers :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> [Value] -> App Response
-addMembers usr qcnv newMembers = do
+data AddMembers = AddMembers
+  { users :: [Value],
+    role :: Maybe String,
+    version :: Maybe Int
+  }
+
+instance Default AddMembers where
+  def = AddMembers {users = [], role = Nothing, version = Nothing}
+
+addMembers ::
+  (HasCallStack, MakesValue user, MakesValue conv) =>
+  user ->
+  conv ->
+  AddMembers ->
+  App Response
+addMembers usr qcnv opts = do
   (convDomain, convId) <- objQid qcnv
-  qUsers <- mapM objQidObject newMembers
-  req <- baseRequest usr Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members"])
-  submit "POST" (req & addJSONObject ["qualified_users" .= qUsers])
+  qUsers <- mapM objQidObject opts.users
+  let path = case opts.version of
+        Just v | v <= 1 -> ["conversations", convId, "members", "v2"]
+        _ -> ["conversations", convDomain, convId, "members"]
+  req <-
+    baseRequest
+      usr
+      Galley
+      (maybe Versioned ExplicitVersion opts.version)
+      (joinHttpPath path)
+  submit "POST" $
+    req
+      & addJSONObject
+        ( ["qualified_users" .= qUsers]
+            <> ["conversation_role" .= r | r <- toList opts.role]
+        )
 
 removeMember :: (HasCallStack, MakesValue remover, MakesValue conv, MakesValue removed) => remover -> conv -> removed -> App Response
 removeMember remover qcnv removed = do
@@ -263,3 +306,89 @@ getConversationCode user conv mbZHost = do
         & addQueryParams [("cnv", convId)]
         & maybe id zHost mbZHost
     )
+
+changeConversationName ::
+  (HasCallStack, MakesValue user, MakesValue conv, MakesValue name) =>
+  user ->
+  conv ->
+  name ->
+  App Response
+changeConversationName user qcnv name = do
+  (convDomain, convId) <- objQid qcnv
+  let path = joinHttpPath ["conversations", convDomain, convId, "name"]
+  nameReq <- make name
+  req <- baseRequest user Galley Versioned path
+  submit "PUT" (req & addJSONObject ["name" .= nameReq])
+
+updateRole ::
+  ( HasCallStack,
+    MakesValue callerUser,
+    MakesValue targetUser,
+    MakesValue roleUpdate,
+    MakesValue qcnv
+  ) =>
+  callerUser ->
+  targetUser ->
+  roleUpdate ->
+  qcnv ->
+  App Response
+updateRole caller target role qcnv = do
+  (cnvDomain, cnvId) <- objQid qcnv
+  (tarDomain, tarId) <- objQid target
+  roleReq <- make role
+  req <-
+    baseRequest
+      caller
+      Galley
+      Versioned
+      ( joinHttpPath ["conversations", cnvDomain, cnvId, "members", tarDomain, tarId]
+      )
+  submit "PUT" (req & addJSONObject ["conversation_role" .= roleReq])
+
+updateReceiptMode ::
+  ( HasCallStack,
+    MakesValue user,
+    MakesValue conv,
+    MakesValue mode
+  ) =>
+  user ->
+  conv ->
+  mode ->
+  App Response
+updateReceiptMode user qcnv mode = do
+  (cnvDomain, cnvId) <- objQid qcnv
+  modeReq <- make mode
+  let path = joinHttpPath ["conversations", cnvDomain, cnvId, "receipt-mode"]
+  req <- baseRequest user Galley Versioned path
+  submit "PUT" (req & addJSONObject ["receipt_mode" .= modeReq])
+
+updateAccess ::
+  ( HasCallStack,
+    MakesValue user,
+    MakesValue conv
+  ) =>
+  user ->
+  conv ->
+  [Aeson.Pair] ->
+  App Response
+updateAccess user qcnv update = do
+  (cnvDomain, cnvId) <- objQid qcnv
+  let path = joinHttpPath ["conversations", cnvDomain, cnvId, "access"]
+  req <- baseRequest user Galley Versioned path
+  submit "PUT" (req & addJSONObject update)
+
+updateMessageTimer ::
+  ( HasCallStack,
+    MakesValue user,
+    MakesValue conv
+  ) =>
+  user ->
+  conv ->
+  Word64 ->
+  App Response
+updateMessageTimer user qcnv update = do
+  (cnvDomain, cnvId) <- objQid qcnv
+  updateReq <- make update
+  let path = joinHttpPath ["conversations", cnvDomain, cnvId, "message-timer"]
+  req <- baseRequest user Galley Versioned path
+  submit "PUT" (addJSONObject ["message_timer" .= updateReq] req)

integration/test/Notifications.hs

@@ -65,8 +65,63 @@ isMemberJoinNotif n = fieldEquals n "payload.0.type" "conversation.member-join"
 isConvLeaveNotif :: MakesValue a => a -> App Bool
 isConvLeaveNotif n = fieldEquals n "payload.0.type" "conversation.member-leave"
 
-isNotifConv :: (MakesValue conv, MakesValue a) => conv -> a -> App Bool
+isNotifConv :: (MakesValue conv, MakesValue a, HasCallStack) => conv -> a -> App Bool
 isNotifConv conv n = fieldEquals n "payload.0.qualified_conversation" (objQidObject conv)
 
-isNotifForUser :: (MakesValue user, MakesValue a) => user -> a -> App Bool
+isNotifForUser :: (MakesValue user, MakesValue a, HasCallStack) => user -> a -> App Bool
 isNotifForUser user n = fieldEquals n "payload.0.data.qualified_user_ids.0" (objQidObject user)
+
+isNotifFromUser :: (MakesValue user, MakesValue a, HasCallStack) => user -> a -> App Bool
+isNotifFromUser user n = fieldEquals n "payload.0.qualified_from" (objQidObject user)
+
+isConvNameChangeNotif :: (HasCallStack, MakesValue a) => a -> App Bool
+isConvNameChangeNotif n = fieldEquals n "payload.0.type" "conversation.rename"
+
+isMemberUpdateNotif :: (HasCallStack, MakesValue n) => n -> App Bool
+isMemberUpdateNotif n = fieldEquals n "payload.0.type" "conversation.member-update"
+
+isReceiptModeUpdateNotif :: (HasCallStack, MakesValue n) => n -> App Bool
+isReceiptModeUpdateNotif n =
+  fieldEquals n "payload.0.type" "conversation.receipt-mode-update"
+
+isConvMsgTimerUpdateNotif :: (HasCallStack, MakesValue n) => n -> App Bool
+isConvMsgTimerUpdateNotif n =
+  fieldEquals n "payload.0.type" "conversation.message-timer-update"
+
+isConvAccessUpdateNotif :: (HasCallStack, MakesValue n) => n -> App Bool
+isConvAccessUpdateNotif n =
+  fieldEquals n "payload.0.type" "conversation.access-update"
+
+isConvCreateNotif :: MakesValue a => a -> App Bool
+isConvCreateNotif n = fieldEquals n "payload.0.type" "conversation.create"
+
+isConvDeleteNotif :: MakesValue a => a -> App Bool
+isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete"
+
+assertLeaveNotification ::
+  ( HasCallStack,
+    MakesValue fromUser,
+    MakesValue conv,
+    MakesValue user,
+    MakesValue kickedUser
+  ) =>
+  fromUser ->
+  conv ->
+  user ->
+  String ->
+  kickedUser ->
+  App ()
+assertLeaveNotification fromUser conv user client leaver =
+  void $
+    awaitNotification
+      user
+      client
+      noValue
+      2
+      ( allPreds
+          [ isConvLeaveNotif,
+            isNotifConv conv,
+            isNotifForUser leaver,
+            isNotifFromUser fromUser
+          ]
+      )

integration/test/SetupHelpers.hs

@@ -4,6 +4,7 @@ module SetupHelpers where
 
 import API.Brig qualified as Brig
 import API.BrigInternal qualified as Internal
+import API.Common
 import API.Galley
 import Control.Concurrent (threadDelay)
 import Control.Monad.Reader
@@ -32,15 +33,43 @@ deleteUser user = bindResponse (Brig.deleteUser user) $ \resp -> do
   resp.status `shouldMatchInt` 200
 
 -- | returns (user, team id)
-createTeam :: (HasCallStack, MakesValue domain) => domain -> App (Value, String)
-createTeam domain = do
+createTeam :: (HasCallStack, MakesValue domain) => domain -> Int -> App (Value, String, [Value])
+createTeam domain memberCount = do
   res <- Internal.createUser domain def {Internal.team = True}
-  user <- res.json
-  tid <- user %. "team" & asString
-  -- TODO
-  -- SQS.assertTeamActivate "create team" tid
-  -- refreshIndex
-  pure (user, tid)
+  owner <- res.json
+  tid <- owner %. "team" & asString
+  members <- for [2 .. memberCount] $ \_ -> createTeamMember owner tid
+  pure (owner, tid, members)
+
+createTeamMember ::
+  (HasCallStack, MakesValue inviter) =>
+  inviter ->
+  String ->
+  App Value
+createTeamMember inviter tid = do
+  newUserEmail <- randomEmail
+  let invitationJSON = ["role" .= "member", "email" .= newUserEmail]
+  invitationReq <-
+    baseRequest inviter Brig Versioned $
+      joinHttpPath ["teams", tid, "invitations"]
+  invitation <- getJSON 201 =<< submit "POST" (addJSONObject invitationJSON invitationReq)
+  invitationId <- objId invitation
+  invitationCodeReq <-
+    rawBaseRequest inviter Brig Unversioned "/i/teams/invitation-code"
+      <&> addQueryParams [("team", tid), ("invitation_id", invitationId)]
+  invitationCode <- bindResponse (submit "GET" invitationCodeReq) $ \res -> do
+    res.status `shouldMatchInt` 200
+    res.json %. "code" & asString
+  let registerJSON =
+        [ "name" .= newUserEmail,
+          "email" .= newUserEmail,
+          "password" .= defPassword,
+          "team_code" .= invitationCode
+        ]
+  registerReq <-
+    rawBaseRequest inviter Brig Versioned "/register"
+      <&> addJSONObject registerJSON
+  getJSON 201 =<< submit "POST" registerReq
 
 connectUsers ::
   ( HasCallStack,