From 5e1b64c726d272a293dcd6e10943e49f202ec2c9 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 28 Oct 2024 13:39:32 +0100 Subject: [PATCH] integration: Wait for the right notification when consuming commit bundles --- integration/test/MLS/Util.hs | 12 +- integration/test/Notifications.hs | 5 + integration/test/SetupHelpers.hs | 8 + integration/test/Test/MLS/SubConversation.hs | 161 ++++++++++--------- 4 files changed, 101 insertions(+), 85 deletions(-) diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs index 7266da60feb..da2b9f998d6 100644 --- a/integration/test/MLS/Util.hs +++ b/integration/test/MLS/Util.hs @@ -185,6 +185,8 @@ generateKeyPackage cid suite = do -- | Create conversation and corresponding group. -- -- returns (groupId, convId) +-- +-- TODO: Don't return groupId as it is already part of ConvId or remove it from ConvID. createNewGroup :: (HasCallStack) => Ciphersuite -> ClientIdentity -> App (String, ConvId) createNewGroup cs cid = do conv <- postConversation cid defMLS >>= getJSON 201 @@ -603,7 +605,7 @@ consumingMessages mp = Codensity $ \k -> do -- at this point we know that every new user has been added to the -- conversation for_ (zip clients wss) $ \((cid, t), ws) -> case t of - MLSNotificationMessageTag -> void $ consumeMessageNoExternal conv.ciphersuite cid (Just mp) ws + MLSNotificationMessageTag -> void $ consumeMessageNoExternal conv.ciphersuite cid mp ws MLSNotificationWelcomeTag -> consumeWelcome cid mp ws pure r @@ -628,15 +630,15 @@ consumeMessage :: (HasCallStack) => Ciphersuite -> ClientIdentity -> Maybe Messa consumeMessage = consumeMessageWithPredicate isNewMLSMessageNotif -- | like 'consumeMessage' but will not consume a message where the sender is the backend -consumeMessageNoExternal :: (HasCallStack) => Ciphersuite -> ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value -consumeMessageNoExternal cs cid = consumeMessageWithPredicate isNewMLSMessageNotifButNoProposal cs cid +consumeMessageNoExternal :: (HasCallStack) => Ciphersuite -> ClientIdentity -> MessagePackage -> WebSocket -> App Value +consumeMessageNoExternal cs cid mp = consumeMessageWithPredicate isNewMLSMessageNotifButNoProposal cs cid (Just mp) where -- the backend (correctly) reacts to a commit removing someone from a parent conversation with a -- remove proposal, however, we don't want to consume this here isNewMLSMessageNotifButNoProposal :: Value -> App Bool isNewMLSMessageNotifButNoProposal n = do - isNotif <- isNewMLSMessageNotif n - if isNotif + isRelevantNotif <- isNewMLSMessageNotif n &&~ isNotifConvId mp.convId n + if isRelevantNotif then do msg <- n %. "payload.0.data" & asByteString >>= showMessage cs cid sender <- msg `lookupField` "message.content.sender" `catch` \(_ :: AssertionFailure) -> pure Nothing diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index d99b46b8897..ecf71072a5e 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -127,6 +127,11 @@ isConvLeaveNotifWithLeaver user n = isNotifConv :: (MakesValue conv, MakesValue a, HasCallStack) => conv -> a -> App Bool isNotifConv conv n = fieldEquals n "payload.0.qualified_conversation" (objQidObject conv) +isNotifConvId :: (MakesValue a, HasCallStack) => ConvId -> a -> App Bool +isNotifConvId conv n = + fieldEquals n "payload.0.qualified_conversation" (objQidObject conv) + &&~ fieldEquals n "payload.0.subconv" conv.subconvId + isNotifForUser :: (MakesValue user, MakesValue a, HasCallStack) => user -> a -> App Bool isNotifForUser user n = fieldEquals n "payload.0.data.qualified_user_ids.0" (objQidObject user) diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index ad19f9d972b..16751b37166 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -402,3 +402,11 @@ uploadDownloadProfilePicture :: (HasCallStack, MakesValue usr) => usr -> App (St uploadDownloadProfilePicture usr = do (dom, key, _payload) <- uploadProfilePicture usr downloadProfilePicture usr dom key + +addUsersToFailureContext :: (MakesValue user) => [(String, user)] -> App a -> App a +addUsersToFailureContext namesAndUsers action = do + let mkLine (name, user) = do + (domain, id_) <- objQid user + pure $ name <> ": " <> id_ <> "@" <> domain + allLines <- unlines <$> (mapM mkLine namesAndUsers) + addFailureContext allLines action diff --git a/integration/test/Test/MLS/SubConversation.hs b/integration/test/Test/MLS/SubConversation.hs index 51965c9c3d2..a996bd6adae 100644 --- a/integration/test/Test/MLS/SubConversation.hs +++ b/integration/test/Test/MLS/SubConversation.hs @@ -236,86 +236,87 @@ testLeaveSubConv leaver = do testCreatorRemovesUserFromParent :: App () testCreatorRemovesUserFromParent = do [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OwnDomain, OtherDomain] - [alice1, bob1, bob2, charlie1, charlie2] <- traverse (createMLSClient def def) [alice, bob, bob, charlie, charlie] - traverse_ (uploadNewKeyPackage def) [bob1, bob2, charlie1, charlie2] - (_, convId) <- createNewGroup def alice1 - - _ <- createAddCommit alice1 convId [bob, charlie] >>= sendAndConsumeCommitBundle - - -- save the state of the parent group - -- parentState <- getMLSState - -- switch to the subgroup - let subConvName = "conference" - createSubConv def convId alice1 subConvName - subConvId <- getSubConvId alice convId "conference" - - for_ [bob1, bob2, charlie1, charlie2] \c -> - createExternalCommit subConvId c Nothing >>= sendAndConsumeCommitBundle - -- save the state of the subgroup and switch to the parent context - -- childState <- getMLSState <* setMLSState parentState - withWebSockets [alice1, charlie1, charlie2] \wss -> do - removeCommitEvents <- createRemoveCommit alice1 convId [bob1, bob2] >>= sendAndConsumeCommitBundle - modifyMLSState $ \s -> - s - { convs = - Map.adjust - (\conv -> conv {members = conv.members Set.\\ Set.fromList [bob1, bob2]}) - convId - s.convs - } - - removeCommitEvents %. "events.0.type" `shouldMatch` "conversation.member-leave" - removeCommitEvents %. "events.0.data.reason" `shouldMatch` "removed" - removeCommitEvents %. "events.0.from" `shouldMatch` alice1.user - - for_ wss \ws -> do - n <- awaitMatch isConvLeaveNotif ws - n %. "payload.0.data.reason" `shouldMatch` "removed" - n %. "payload.0.from" `shouldMatch` alice1.user - - -- setMLSState childState - let idxBob1 :: Int = 1 - idxBob2 :: Int = 2 - for_ ((,) <$> [idxBob1, idxBob2] <*> wss) \(idx, ws) -> do - msg <- - awaitMatch - do - \n -> - isJust <$> runMaybeT do - msg <- lift $ n %. "payload.0.data" & asByteString >>= showMessage def alice1 - guard =<< lift do - isNewMLSMessageNotif n - - prop <- - maybe mzero pure =<< lift do - lookupField msg "message.content.body.Proposal" - - lift do - (== idx) <$> (prop %. "Remove.removed" & asInt) - ws - for_ ws.client $ \consumer -> - msg %. "payload.0.data" & asByteString >>= mlsCliConsume def consumer - - -- remove bob from the child state - modifyMLSState $ \s -> - s - { convs = - Map.adjust - (\conv -> conv {members = conv.members Set.\\ Set.fromList [bob1, bob2]}) - subConvId - s.convs - } - - _ <- createPendingProposalCommit subConvId alice1 >>= sendAndConsumeCommitBundle - - getSubConversation bob convId subConvName >>= flip withResponse \resp -> - assertBool "access to the conversation for bob should be denied" (resp.status == 403) - - for_ [charlie, alice] \m -> do - resp <- getSubConversation m convId subConvName - assertBool "alice and charlie should have access to the conversation" (resp.status == 200) - mems <- resp.jsonBody %. "members" & asList - mems `shouldMatchSet` ((renameField "id" "user_id" <=< make) `traverse` [alice1, charlie1, charlie2]) + addUsersToFailureContext [("alice", alice), ("bob", bob), ("charlie", charlie)] $ do + [alice1, bob1, bob2, charlie1, charlie2] <- traverse (createMLSClient def def) [alice, bob, bob, charlie, charlie] + traverse_ (uploadNewKeyPackage def) [bob1, bob2, charlie1, charlie2] + (_, convId) <- createNewGroup def alice1 + + _ <- createAddCommit alice1 convId [bob, charlie] >>= sendAndConsumeCommitBundle + + -- save the state of the parent group + -- parentState <- getMLSState + -- switch to the subgroup + let subConvName = "conference" + createSubConv def convId alice1 subConvName + subConvId <- getSubConvId alice convId "conference" + + for_ [bob1, bob2, charlie1, charlie2] \c -> + createExternalCommit subConvId c Nothing >>= sendAndConsumeCommitBundle + -- save the state of the subgroup and switch to the parent context + -- childState <- getMLSState <* setMLSState parentState + withWebSockets [alice1, charlie1, charlie2] \wss -> do + removeCommitEvents <- createRemoveCommit alice1 convId [bob1, bob2] >>= sendAndConsumeCommitBundle + modifyMLSState $ \s -> + s + { convs = + Map.adjust + (\conv -> conv {members = conv.members Set.\\ Set.fromList [bob1, bob2]}) + convId + s.convs + } + + removeCommitEvents %. "events.0.type" `shouldMatch` "conversation.member-leave" + removeCommitEvents %. "events.0.data.reason" `shouldMatch` "removed" + removeCommitEvents %. "events.0.from" `shouldMatch` alice1.user + + for_ wss \ws -> do + n <- awaitMatch isConvLeaveNotif ws + n %. "payload.0.data.reason" `shouldMatch` "removed" + n %. "payload.0.from" `shouldMatch` alice1.user + + -- setMLSState childState + let idxBob1 :: Int = 1 + idxBob2 :: Int = 2 + for_ ((,) <$> [idxBob1, idxBob2] <*> wss) \(idx, ws) -> do + msg <- + awaitMatch + do + \n -> + isJust <$> runMaybeT do + msg <- lift $ n %. "payload.0.data" & asByteString >>= showMessage def alice1 + guard =<< lift do + isNewMLSMessageNotif n + + prop <- + maybe mzero pure =<< lift do + lookupField msg "message.content.body.Proposal" + + lift do + (== idx) <$> (prop %. "Remove.removed" & asInt) + ws + for_ ws.client $ \consumer -> + msg %. "payload.0.data" & asByteString >>= mlsCliConsume def consumer + + -- remove bob from the child state + modifyMLSState $ \s -> + s + { convs = + Map.adjust + (\conv -> conv {members = conv.members Set.\\ Set.fromList [bob1, bob2]}) + subConvId + s.convs + } + + _ <- createPendingProposalCommit subConvId alice1 >>= sendAndConsumeCommitBundle + + getSubConversation bob convId subConvName >>= flip withResponse \resp -> + assertBool "access to the conversation for bob should be denied" (resp.status == 403) + + for_ [charlie, alice] \m -> do + resp <- getSubConversation m convId subConvName + assertBool "alice and charlie should have access to the conversation" (resp.status == 200) + mems <- resp.jsonBody %. "members" & asList + mems `shouldMatchSet` ((renameField "id" "user_id" <=< make) `traverse` [alice1, charlie1, charlie2]) testResendingProposals :: (HasCallStack) => App () testResendingProposals = do