[wip] attach the reason for a member to leave a conversation to the l…

…eave 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

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

@@ -158,9 +158,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
@@ -87,7 +88,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 (..))
 
 --------------------------------------------------------------------------------
@@ -160,9 +161,30 @@ instance ToSchema EventType where
           element "conversation.mls-welcome" MLSWelcome
         ]
 
+--  | The reason for a member to leave
+--    There are three reasons
+--    - the member has left on his own
+--    - the member was removed from the team
+--    - the member was removed by another member
+data EdMemberLeftReason
+  = EdReasonLeft
+  | EdReasonRemovedFromTeam
+  | 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
@@ -182,7 +204,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
@@ -200,7 +222,7 @@ genEventData = \case
 
 eventDataType :: EventData -> EventType
 eventDataType (EdMembersJoin _) = MemberJoin
-eventDataType (EdMembersLeave _) = MemberLeave
+eventDataType (EdMembersLeave _ _) = MemberLeave
 eventDataType (EdMemberUpdate _) = MemberStateUpdate
 eventDataType (EdConvRename _) = ConvRename
 eventDataType (EdConvAccessUpdate _) = ConvAccessUpdate
@@ -376,7 +398,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
@@ -398,6 +420,11 @@ taggedEventDataSchema =
       ConvCodeDelete -> tag _EdConvCodeDelete null_
       ConvDelete -> tag _EdConvDelete null_
 
+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/Routes/Internal/Brig.hs

@@ -589,7 +589,7 @@ type PutConversationByKeyPackageRef =
              'PUT
              '[Servant.JSON]
              [ RespondEmpty 404 "No key package found by reference",
-               RespondEmpty 204 "Converstaion associated"
+               RespondEmpty 204 "Conversation associated"
              ]
              Bool
     )

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

@@ -25,6 +25,7 @@ module Wire.API.User
     UserIdList (..),
     UserIds (..),
     QualifiedUserIdList (..),
+    qualifiedUserIdListObjectSchema,
     LimitedQualifiedUserIdList (..),
     ScimUserInfo (..),
     ScimUserInfos (..),
@@ -546,12 +547,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

@@ -146,7 +146,7 @@ testObject_Event_conversation_9 =
       evtFrom = Qualified {qUnqualified = Id (fromJust (UUID.fromString "2126ea99-ca79-43ea-ad99-a59616468e8e")), qDomain = Domain {_domainText = "9--5grmn.j39y3--9n"}},
       evtTime = UTCTime {utctDay = ModifiedJulianDay 58119, utctDayTime = 0},
       evtData =
-        EdMembersLeave
+        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

@@ -235,7 +235,7 @@ testObject_Event_user_11 =
     Nothing
     (Qualified (Id (fromJust (UUID.fromString "000043a6-0000-1627-0000-490300002017"))) (Domain "faraway.example.com"))
     (read "1864-04-12 01:28:25.705 UTC")
-    ( EdMembersLeave
+    ( 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

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

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

@@ -790,7 +790,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 =
@@ -2037,7 +2037,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 $
@@ -2084,7 +2084,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

@@ -77,6 +77,7 @@ import Wire.API.User.Client.DPoPAccessToken (Proof)
 import Wire.API.User.Client.Prekey
 import Wire.API.User.Handle
 import Wire.API.User.Password
+import Wire.API.Event.Conversation (EdMemberLeftReason)
 
 newtype ConnectionLimit = ConnectionLimit Int64
 
@@ -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

@@ -543,8 +543,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

@@ -379,7 +379,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

@@ -1,4 +1,6 @@
 {-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE RecordWildCards #-}
+
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
@@ -15,7 +17,6 @@
 --
 -- 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 RecordWildCards #-}
 
 module Galley.API.Update
   ( -- * Managing Conversations
@@ -1106,6 +1107,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,
@@ -1120,8 +1126,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 ::
@@ -1140,7 +1146,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 ::
@@ -1614,7 +1620,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

@@ -1606,9 +1606,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/Util.hs

@@ -1814,7 +1814,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
@@ -1847,16 +1847,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 ()
@@ -2827,7 +2827,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