diff --git a/.envrc b/.envrc index c96c4e427d..6edee4dad4 100644 --- a/.envrc +++ b/.envrc @@ -50,4 +50,4 @@ 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" \ No newline at end of file +export AWS_SECRET_ACCESS_KEY="dummysecret" diff --git a/changelog.d/2-features/WPB-4547 b/changelog.d/2-features/WPB-4547 new file mode 100644 index 0000000000..54a98f7352 --- /dev/null +++ b/changelog.d/2-features/WPB-4547 @@ -0,0 +1 @@ +Add reason field to conversation.member-leave diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 4730ba2d47..d6930d1448 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 6a15c287ce..cfac6ae07d 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/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 and/or deleted + EdReasonDeleted + | -- | 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 "user-deleted" EdReasonDeleted, + 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 diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 98166f6c43..c009585596 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/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 diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_conversation.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_conversation.hs index 12cc9c7b83..fbe3ab3e5a 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_conversation.hs +++ b/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"}}, diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs index a7309a7a1b..b6ffdeea2e 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Event_user.hs +++ b/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"), diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RemoveBotResponse_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RemoveBotResponse_user.hs index 49b47d17aa..7fd0d92a2f 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RemoveBotResponse_user.hs +++ b/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"), diff --git a/libs/wire-api/test/golden/testObject_Event_conversation_9.json b/libs/wire-api/test/golden/testObject_Event_conversation_9.json index 028aeb144d..e83525ac01 100644 --- a/libs/wire-api/test/golden/testObject_Event_conversation_9.json +++ b/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", diff --git a/libs/wire-api/test/golden/testObject_Event_user_11.json b/libs/wire-api/test/golden/testObject_Event_user_11.json index 8acfbce8fa..870249332d 100644 --- a/libs/wire-api/test/golden/testObject_Event_user_11.json +++ b/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" diff --git a/libs/wire-api/test/golden/testObject_RemoveBotResponse_user_1.json b/libs/wire-api/test/golden/testObject_RemoveBotResponse_user_1.json index 2bd38208dc..d5a64addc4 100644 --- a/libs/wire-api/test/golden/testObject_RemoveBotResponse_user_1.json +++ b/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" diff --git a/nix/wire-server.nix b/nix/wire-server.nix index d5b4935e34..12aafac3dd 100644 --- a/nix/wire-server.nix +++ b/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 diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index f8dce17f04..12749a533a 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/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 () diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 96acc83396..49dbacd7a9 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/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 () diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index d76f059fc6..7fe253c785 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/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 diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 8c0586f5da..2830fc16d4 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -386,7 +386,7 @@ rmUser lusr conn = do Nothing (tUntagged lusr) now - (EdMembersLeave (QualifiedUserIdList [qUser])) + (EdMembersLeave EdReasonDeleted (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) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d4395976b0..410c015285 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1027,7 +1027,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.EdReasonDeleted (Conv.QualifiedUserIdList [tUntagged (qualifyAs lusr remove)]) cc <- E.getTeamConversations tid for_ cc $ \c -> E.getConversation (c ^. conversationId) >>= \conv -> diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index e39df03f31..bbb54cd7b3 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/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 diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index ffc437f2ad..6f6ed15666 100644 --- a/services/galley/test/integration/API.hs +++ b/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 diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 6bb5d767a7..180c09dd3f 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/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 diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 7486dac936..4b4d4eb28a 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/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