[WPB-4547] Attach the reason for a member to leave a conversation to the leave event

.envrc

@@ -50,4 +50,6 @@ export INTEGRATION_DYNAMIC_BACKENDS_POOLSIZE=3
 # Keep these in sync with deploy/dockerephmeral/init.sh
 export AWS_REGION="eu-west-1"
 export AWS_ACCESS_KEY_ID="dummykey"
-export AWS_SECRET_ACCESS_KEY="dummysecret"
+export AWS_SECRET_ACCESS_KEY="dummysecret"
+
+ulimit -n 10420

changelog.d/2-features/WPB-4547

@@ -0,0 +1 @@
+Add reason field to conversation.member-leave

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

@@ -162,9 +162,9 @@ conversationActionToEvent tag now quid qcnv subconv action =
           let ConversationJoin newMembers role = action
            in EdMembersJoin $ SimpleMembers (map (`SimpleMember` role) (toList newMembers))
         SConversationLeaveTag ->
-          EdMembersLeave (QualifiedUserIdList [quid])
+          EdMembersLeave EdReasonLeft (QualifiedUserIdList [quid])
         SConversationRemoveMembersTag ->
-          EdMembersLeave (QualifiedUserIdList (toList action))
+          EdMembersLeave EdReasonRemoved (QualifiedUserIdList (toList action))
         SConversationMemberUpdateTag ->
           let ConversationMemberUpdate target (OtherMemberUpdate role) = action
               update = MemberUpdateData target Nothing Nothing Nothing Nothing Nothing Nothing role

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

@@ -25,6 +25,7 @@ module Wire.API.Event.Conversation
     evtType,
     EventType (..),
     EventData (..),
+    EdMemberLeftReason (..),
     AddCodeResult (..),
 
     -- * Event lenses
@@ -89,7 +90,7 @@ import Wire.API.Conversation.Typing
 import Wire.API.MLS.SubConversation
 import Wire.API.Routes.MultiVerb
 import Wire.API.Routes.Version
-import Wire.API.User (QualifiedUserIdList (..))
+import Wire.API.User (QualifiedUserIdList (..), qualifiedUserIdListObjectSchema)
 import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
 
 --------------------------------------------------------------------------------
@@ -164,9 +165,33 @@ instance ToSchema EventType where
           element "conversation.protocol-update" ProtocolUpdate
         ]
 
+--  | The reason for a member to leave
+--    There are three reasons
+--    - the member has left on their own
+--    - the member was removed from the team
+--    - the member was removed by another member
+data EdMemberLeftReason
+  = -- | The member has left on their own
+    EdReasonLeft
+  | -- | The member was removed from the team (that includes being deleted)
+    EdReasonRemovedFromTeam
+  | -- | The member was removed by another member
+    EdReasonRemoved
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via GenericUniform EdMemberLeftReason
+
+instance ToSchema EdMemberLeftReason where
+  schema =
+    enum @Text "EdMemberLeftReason" $
+      mconcat
+        [ element "left" EdReasonLeft,
+          element "removed-from-team" EdReasonRemovedFromTeam,
+          element "removed" EdReasonRemoved
+        ]
+
 data EventData
   = EdMembersJoin SimpleMembers
-  | EdMembersLeave QualifiedUserIdList
+  | EdMembersLeave EdMemberLeftReason QualifiedUserIdList
   | EdConnect Connect
   | EdConvReceiptModeUpdate ConversationReceiptModeUpdate
   | EdConvRename ConversationRename
@@ -187,7 +212,7 @@ data EventData
 genEventData :: EventType -> QC.Gen EventData
 genEventData = \case
   MemberJoin -> EdMembersJoin <$> arbitrary
-  MemberLeave -> EdMembersLeave <$> arbitrary
+  MemberLeave -> EdMembersLeave <$> arbitrary <*> arbitrary
   MemberStateUpdate -> EdMemberUpdate <$> arbitrary
   ConvRename -> EdConvRename <$> arbitrary
   ConvAccessUpdate -> EdConvAccessUpdate <$> arbitrary
@@ -206,7 +231,7 @@ genEventData = \case
 
 eventDataType :: EventData -> EventType
 eventDataType (EdMembersJoin _) = MemberJoin
-eventDataType (EdMembersLeave _) = MemberLeave
+eventDataType (EdMembersLeave _ _) = MemberLeave
 eventDataType (EdMemberUpdate _) = MemberStateUpdate
 eventDataType (EdConvRename _) = ConvRename
 eventDataType (EdConvAccessUpdate _) = ConvAccessUpdate
@@ -383,7 +408,7 @@ taggedEventDataSchema =
   where
     edata = dispatch $ \case
       MemberJoin -> tag _EdMembersJoin (unnamed schema)
-      MemberLeave -> tag _EdMembersLeave (unnamed schema)
+      MemberLeave -> tag _EdMembersLeave (unnamed memberLeaveSchema)
       MemberStateUpdate -> tag _EdMemberUpdate (unnamed schema)
       ConvRename -> tag _EdConvRename (unnamed schema)
       -- FUTUREWORK: when V2 is dropped, it is fine to change this schema to
@@ -406,6 +431,11 @@ taggedEventDataSchema =
       ConvDelete -> tag _EdConvDelete null_
       ProtocolUpdate -> tag _EdProtocolUpdate (unnamed (unProtocolUpdate <$> P.ProtocolUpdate .= schema))
 
+memberLeaveSchema :: ValueSchema NamedSwaggerDoc (EdMemberLeftReason, QualifiedUserIdList)
+memberLeaveSchema =
+  object "QualifiedUserIdList with EdMemberLeftReason" $
+    (,) <$> fst .= field "reason" schema <*> snd .= qualifiedUserIdListObjectSchema
+
 instance ToSchema Event where
   schema = object "Event" eventObjectSchema
 

libs/wire-api/src/Wire/API/User.hs

@@ -25,6 +25,7 @@ module Wire.API.User
     UserIdList (..),
     UserIds (..),
     QualifiedUserIdList (..),
+    qualifiedUserIdListObjectSchema,
     LimitedQualifiedUserIdList (..),
     ScimUserInfo (..),
     ScimUserInfos (..),
@@ -548,12 +549,15 @@ newtype QualifiedUserIdList = QualifiedUserIdList {qualifiedUserIdList :: [Quali
 
 instance ToSchema QualifiedUserIdList where
   schema =
-    object "QualifiedUserIdList" $
-      QualifiedUserIdList
-        <$> qualifiedUserIdList
-          .= field "qualified_user_ids" (array schema)
-        <* (fmap qUnqualified . qualifiedUserIdList)
-          .= field "user_ids" (deprecatedSchema "qualified_user_ids" (array schema))
+    object "QualifiedUserIdList" qualifiedUserIdListObjectSchema
+
+qualifiedUserIdListObjectSchema :: ObjectSchema SwaggerDoc QualifiedUserIdList
+qualifiedUserIdListObjectSchema =
+  QualifiedUserIdList
+    <$> qualifiedUserIdList
+      .= field "qualified_user_ids" (array schema)
+    <* (fmap qUnqualified . qualifiedUserIdList)
+      .= field "user_ids" (deprecatedSchema "qualified_user_ids" (array schema))
 
 --------------------------------------------------------------------------------
 -- LimitedQualifiedUserIdList

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

@@ -147,6 +147,7 @@ testObject_Event_conversation_9 =
       evtTime = UTCTime {utctDay = ModifiedJulianDay 58119, utctDayTime = 0},
       evtData =
         EdMembersLeave
+          EdReasonLeft
           ( QualifiedUserIdList
               { qualifiedUserIdList =
                   [ Qualified {qUnqualified = Id (fromJust (UUID.fromString "2126ea99-ca79-43ea-ad99-a59616468e8e")), qDomain = Domain {_domainText = "ow8i3fhr.v"}},

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

@@ -236,6 +236,7 @@ testObject_Event_user_11 =
     (Qualified (Id (fromJust (UUID.fromString "000043a6-0000-1627-0000-490300002017"))) (Domain "faraway.example.com"))
     (read "1864-04-12 01:28:25.705 UTC")
     ( EdMembersLeave
+        EdReasonLeft
         ( QualifiedUserIdList
             { qualifiedUserIdList =
                 [ Qualified (Id (fromJust (UUID.fromString "00003fab-0000-40b8-0000-3b0c000014ef"))) (Domain "faraway.example.com"),

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

@@ -38,6 +38,7 @@ testObject_RemoveBotResponse_user_1 =
           (Qualified (Id (fromJust (UUID.fromString "00004166-0000-1e32-0000-52cb0000428d"))) (Domain "faraway.example.com"))
           (read "1864-05-07 01:13:35.741 UTC")
           ( EdMembersLeave
+              EdReasonRemoved
               ( QualifiedUserIdList
                   { qualifiedUserIdList =
                       [ Qualified (Id (fromJust (UUID.fromString "000038c1-0000-4a9c-0000-511300004c8b"))) (Domain "faraway.example.com"),

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

@@ -63,6 +63,7 @@
                 "id": "2126ea99-ca79-43ea-ad99-a59616468e8e"
             }
         ],
+        "reason": "left",
         "user_ids": [
             "2126ea99-ca79-43ea-ad99-a59616468e8e",
             "2126ea99-ca79-43ea-ad99-a59616468e8e",

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

@@ -11,6 +11,7 @@
                 "id": "00001c48-0000-29ae-0000-62fc00001479"
             }
         ],
+        "reason": "left",
         "user_ids": [
             "00003fab-0000-40b8-0000-3b0c000014ef",
             "00001c48-0000-29ae-0000-62fc00001479"

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

@@ -12,6 +12,7 @@
                     "id": "00003111-0000-2620-0000-1c8800000ea0"
                 }
             ],
+            "reason": "removed",
             "user_ids": [
                 "000038c1-0000-4a9c-0000-511300004c8b",
                 "00003111-0000-2620-0000-1c8800000ea0"

nix/wire-server.nix

@@ -394,6 +394,7 @@ let
     pkgs.kubectl
     pkgs.kubelogin-oidc
     pkgs.nixpkgs-fmt
+    pkgs.openssl
     pkgs.ormolu
     pkgs.shellcheck
     pkgs.treefmt

services/brig/test/integration/API/Provider.hs

@@ -789,7 +789,7 @@ testBotTeamOnlyConv config db brig galley cannon = withTestService config db bri
           let msg = QualifiedUserIdList gone
           assertEqual "conv" cnv (evtConv e)
           assertEqual "user" leaveFrom (evtFrom e)
-          assertEqual "event data" (EdMembersLeave msg) (evtData e)
+          assertEqual "event data" (EdMembersLeave EdReasonRemoved msg) (evtData e)
         _ ->
           assertFailure $ "expected event of type: ConvAccessUpdate or MemberLeave, got: " <> show e
     setAccessRole uid qcid role =
@@ -2036,7 +2036,7 @@ wsAssertMemberLeave ws conv usr old = void $
         evtConv e @?= conv
         evtType e @?= MemberLeave
         evtFrom e @?= usr
-        evtData e @?= EdMembersLeave (QualifiedUserIdList old)
+        evtData e @?= EdMembersLeave EdReasonRemoved (QualifiedUserIdList old)
 
 wsAssertConvDelete :: (HasCallStack, MonadIO m) => WS.WebSocket -> Qualified ConvId -> Qualified UserId -> m ()
 wsAssertConvDelete ws conv from = void $
@@ -2083,7 +2083,7 @@ svcAssertMemberLeave buf usr gone cnv = liftIO $ do
       assertEqual "event type" MemberLeave (evtType e)
       assertEqual "conv" cnv (evtConv e)
       assertEqual "user" usr (evtFrom e)
-      assertEqual "event data" (EdMembersLeave msg) (evtData e)
+      assertEqual "event data" (EdMembersLeave EdReasonRemoved msg) (evtData e)
     _ -> assertFailure "Event timeout (TestBotMessage: member-leave)"
 
 svcAssertConvDelete :: (HasCallStack, MonadIO m) => Chan TestBotEvent -> Qualified UserId -> Qualified ConvId -> m ()

services/brig/test/integration/API/User/Util.hs

@@ -60,6 +60,7 @@ import Test.Tasty.HUnit
 import Util
 import Wire.API.Asset
 import Wire.API.Connection
+import Wire.API.Event.Conversation (EdMemberLeftReason)
 import Wire.API.Event.Conversation qualified as Conv
 import Wire.API.Federation.API.Brig qualified as F
 import Wire.API.Federation.Component
@@ -512,16 +513,16 @@ matchDeleteUserNotification quid n = do
   eUnqualifiedId @?= Just (qUnqualified quid)
   eQualifiedId @?= Just quid
 
-matchConvLeaveNotification :: Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> Notification -> IO ()
-matchConvLeaveNotification conv remover removeds n = do
+matchConvLeaveNotification :: Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> EdMemberLeftReason -> Notification -> IO ()
+matchConvLeaveNotification conv remover removeds reason n = do
   let e = List1.head (WS.unpackPayload n)
   ntfTransient n @?= False
   Conv.evtConv e @?= conv
   Conv.evtType e @?= Conv.MemberLeave
   Conv.evtFrom e @?= remover
-  sorted (Conv.evtData e) @?= sorted (Conv.EdMembersLeave (Conv.QualifiedUserIdList removeds))
+  sorted (Conv.evtData e) @?= sorted (Conv.EdMembersLeave reason (Conv.QualifiedUserIdList removeds))
   where
-    sorted (Conv.EdMembersLeave (Conv.QualifiedUserIdList m)) = Conv.EdMembersLeave (Conv.QualifiedUserIdList (sort m))
+    sorted (Conv.EdMembersLeave r (Conv.QualifiedUserIdList m)) = Conv.EdMembersLeave r (Conv.QualifiedUserIdList (sort m))
     sorted x = x
 
 generateVerificationCode :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> Public.SendVerificationCode -> m ()

services/brig/test/integration/Federation/End2end.hs

@@ -548,8 +548,8 @@ testDeleteUser brig1 brig2 galley1 galley2 cannon1 = do
   WS.bracketR cannon1 (qUnqualified alice) $ \wsAlice -> do
     deleteUser (qUnqualified bobDel) (Just defPassword) brig2 !!! const 200 === statusCode
     WS.assertMatch_ (5 # Second) wsAlice $ matchDeleteUserNotification bobDel
-    WS.assertMatch_ (5 # Second) wsAlice $ matchConvLeaveNotification conv1 bobDel [bobDel]
-    WS.assertMatch_ (5 # Second) wsAlice $ matchConvLeaveNotification conv2 bobDel [bobDel]
+    WS.assertMatch_ (5 # Second) wsAlice $ matchConvLeaveNotification conv1 bobDel [bobDel] EdReasonLeft
+    WS.assertMatch_ (5 # Second) wsAlice $ matchConvLeaveNotification conv2 bobDel [bobDel] EdReasonLeft
 
 testRemoteAsset :: Brig -> Brig -> CargoHold -> CargoHold -> Http ()
 testRemoteAsset brig1 brig2 ch1 ch2 = do

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

@@ -386,7 +386,7 @@ rmUser lusr conn = do
                       Nothing
                       (tUntagged lusr)
                       now
-                      (EdMembersLeave (QualifiedUserIdList [qUser]))
+                      (EdMembersLeave EdReasonRemovedFromTeam (QualifiedUserIdList [qUser]))
               for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c)
               pure $
                 Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c)

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

@@ -15,6 +15,7 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PartialTypeSignatures #-}
 
 module Galley.API.Teams
   ( createBindingTeam,
@@ -1027,7 +1028,7 @@ uncheckedDeleteTeamMember lusr zcon tid remove mems = do
       -- remove the user from conversations but never send out any events. We assume that clients
       -- handle nicely these missing events, regardless of whether they are in the same team or not
       let tmids = Set.fromList $ map (view userId) (mems ^. teamMembers)
-      let edata = Conv.EdMembersLeave (Conv.QualifiedUserIdList [tUntagged (qualifyAs lusr remove)])
+      let edata = Conv.EdMembersLeave Conv.EdReasonRemovedFromTeam (Conv.QualifiedUserIdList [tUntagged (qualifyAs lusr remove)])
       cc <- E.getTeamConversations tid
       for_ cc $ \c ->
         E.getConversation (c ^. conversationId) >>= \conv ->

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

@@ -1170,6 +1170,11 @@ removeMemberQualified lusr con qcnv victim =
       qcnv
       victim
 
+-- | if the public member leave api was called, we can assume that
+--   it was called by a user
+pattern EdMembersLeaveRemoved :: QualifiedUserIdList -> EventData
+pattern EdMembersLeaveRemoved l = EdMembersLeave EdReasonRemoved l
+
 removeMemberFromRemoteConv ::
   ( Member FederatorAccess r,
     Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
@@ -1184,8 +1189,8 @@ removeMemberFromRemoteConv cnv lusr victim
   | tUntagged lusr == victim = do
       let lc = LeaveConversationRequest (tUnqualified cnv) (qUnqualified victim)
       let rpc = fedClient @'Galley @"leave-conversation" lc
-      (either handleError handleSuccess . void . (.response) =<<) $
-        E.runFederated cnv rpc
+      E.runFederated cnv rpc
+        >>= either handleError handleSuccess . void . (.response)
   | otherwise = throwS @('ActionDenied 'RemoveConversationMember)
   where
     handleError ::
@@ -1204,7 +1209,7 @@ removeMemberFromRemoteConv cnv lusr victim
       t <- input
       pure . Just $
         Event (tUntagged cnv) Nothing (tUntagged lusr) t $
-          EdMembersLeave (QualifiedUserIdList [victim])
+          EdMembersLeaveRemoved (QualifiedUserIdList [victim])
 
 -- | Remove a member from a local conversation.
 removeMemberFromLocalConv ::
@@ -1679,7 +1684,7 @@ rmBot lusr zcon b = do
     else do
       t <- input
       do
-        let evd = EdMembersLeave (QualifiedUserIdList [tUntagged (qualifyAs lusr (botUserId (b ^. rmBotId)))])
+        let evd = EdMembersLeaveRemoved (QualifiedUserIdList [tUntagged (qualifyAs lusr (botUserId (b ^. rmBotId)))])
         let e = Event (tUntagged lcnv) Nothing (tUntagged lusr) t evd
         for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent e) (recipient <$> users)) $ \p ->
           E.push1 $ p & pushConn .~ zcon

services/galley/test/integration/API.hs

@@ -1605,9 +1605,9 @@ postConvertTeamConv = do
     -- non-team members get kicked out
     liftIO $ do
       WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $
-        wsAssertMemberLeave qconv qalice (pure qeve)
+        wsAssertMemberLeave qconv qalice (pure qeve) EdReasonRemoved
       WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $
-        wsAssertMemberLeave qconv qalice (pure qmallory)
+        wsAssertMemberLeave qconv qalice (pure qmallory) EdReasonRemoved
     -- joining (for mallory) is no longer possible
     postJoinCodeConv mallory j !!! const 403 === statusCode
     -- team members (dave) can still join

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

@@ -2392,7 +2392,7 @@ testCreatorRemovesUserFromParent = do
         liftIO $ assertOne events >>= assertLeaveEvent qcnv alice [bob]
 
         WS.assertMatchN_ (5 # Second) wss $ \n -> do
-          wsAssertMemberLeave qcnv alice [bob] n
+          wsAssertMemberLeave qcnv alice [bob] EdReasonRemoved n
 
         State.put stateSub
         -- Get client state for alice and fetch bob client identities

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

@@ -1830,7 +1830,7 @@ assertLeaveEvent conv usr leaving e = do
   evtConv e @?= conv
   evtType e @?= Conv.MemberLeave
   evtFrom e @?= usr
-  fmap (sort . qualifiedUserIdList) (evtData e ^? _EdMembersLeave) @?= Just (sort leaving)
+  fmap (sort . qualifiedUserIdList) (evtData e ^? _EdMembersLeave . _2) @?= Just (sort leaving)
 
 wsAssertMemberUpdateWithRole :: Qualified ConvId -> Qualified UserId -> UserId -> RoleName -> Notification -> IO ()
 wsAssertMemberUpdateWithRole conv usr target role n = do
@@ -1863,16 +1863,16 @@ wsAssertConvMessageTimerUpdate conv usr new n = do
   evtFrom e @?= usr
   evtData e @?= EdConvMessageTimerUpdate new
 
-wsAssertMemberLeave :: Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> Notification -> IO ()
-wsAssertMemberLeave conv usr old n = do
+wsAssertMemberLeave :: Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> EdMemberLeftReason -> Notification -> IO ()
+wsAssertMemberLeave conv usr old reason n = do
   let e = List1.head (WS.unpackPayload n)
   ntfTransient n @?= False
   evtConv e @?= conv
   evtType e @?= Conv.MemberLeave
   evtFrom e @?= usr
-  sorted (evtData e) @?= sorted (EdMembersLeave (QualifiedUserIdList old))
+  sorted (evtData e) @?= sorted (EdMembersLeave reason (QualifiedUserIdList old))
   where
-    sorted (EdMembersLeave (QualifiedUserIdList m)) = EdMembersLeave (QualifiedUserIdList (sort m))
+    sorted (EdMembersLeave _ (QualifiedUserIdList m)) = EdMembersLeave reason (QualifiedUserIdList (sort m))
     sorted x = x
 
 wsAssertTyping :: HasCallStack => Qualified ConvId -> Qualified UserId -> TypingStatus -> Notification -> IO ()
@@ -2843,7 +2843,7 @@ checkConvMemberLeaveEvent cid usr w = WS.assertMatch_ checkTimeout w $ \notif ->
   evtConv e @?= cid
   evtType e @?= Conv.MemberLeave
   case evtData e of
-    Conv.EdMembersLeave mm -> mm @?= Conv.QualifiedUserIdList [usr]
+    Conv.EdMembersLeave _ mm -> mm @?= Conv.QualifiedUserIdList [usr]
     other -> assertFailure $ "Unexpected event data: " <> show other
 
 checkTimeout :: WS.Timeout