From c86a65f37ac02725cd1ba2569cb62e29604a9609 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Fri, 28 Feb 2025 20:09:40 +0400 Subject: [PATCH] wip --- src/Simplex/Chat/Library/Commands.hs | 8 ++- src/Simplex/Chat/Library/Subscriber.hs | 16 +++--- src/Simplex/Chat/View.hs | 10 +++- tests/ChatClient.hs | 4 +- tests/ChatTests/Groups.hs | 76 ++++++++++++++++++++++++-- 5 files changed, 94 insertions(+), 20 deletions(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index f15e789fef..f19d1cea47 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2033,7 +2033,7 @@ processChatCommand' vr = \case let msg = XGrpLinkAcpt role void $ sendDirectMemberMessage mConn msg groupId m' <- withFastStore' $ \db -> updateGroupMemberAccepted db user m role - introduceToGroup vr user gInfo m + introduceToGroup vr user gInfo m' pure $ CRJoinedGroupMember user gInfo m' _ -> throwChatError CEGroupMemberNotActive APIMemberRole groupId memberId memRole -> withUser $ \user -> do @@ -3089,7 +3089,11 @@ processChatCommand' vr = \case sendGroupContentMessages_ user gInfo ms numFileInvs live itemTTL cmrs sendGroupContentMessages_ :: User -> GroupInfo -> [GroupMember] -> Int -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} ms numFileInvs live itemTTL cmrs = do - assertUserGroupRole gInfo GRAuthor + -- TODO [knocking] pass GroupSndScope? + let allowedRole = case ms of + [m] | memberCategory m == GCHostMember -> GRObserver + _ -> GRAuthor + assertUserGroupRole gInfo allowedRole assertGroupContentAllowed processComposedMessages where diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 08079e0a98..ada3a34319 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -1238,10 +1238,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- where -- noImage = maybe True (\(ImageData i) -> i == "") image + -- TODO [knocking] review memberCanSend :: GroupMember -> CM () -> CM () - memberCanSend GroupMember {memberRole} a - | memberRole <= GRObserver = messageError "member is not allowed to send messages" - | otherwise = a + memberCanSend GroupMember {memberRole, memberStatus} a + | memberRole > GRObserver || memberStatus == GSMemPendingApproval = a + | otherwise = messageError "member is not allowed to send messages" processConnMERR :: ConnectionEntity -> Connection -> AgentErrorType -> CM () processConnMERR connEntity conn err = do @@ -2071,12 +2072,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = else messageError "x.grp.link.mem error: invalid group link host profile update" xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupMemberRole -> CM () - xGrpLinkAcpt GroupInfo {membership} m role = do - withStore' $ \db -> do - void $ updateGroupMemberAccepted db user membership role + xGrpLinkAcpt gInfo@GroupInfo {membership} m role = do + membership' <- withStore' $ \db -> do updateGroupMemberStatus db userId m GSMemConnected + updateGroupMemberAccepted db user membership role let m' = m {memberStatus = GSMemConnected} - connectedIncognito = memberIncognito membership + toView $ CRUserJoinedGroup user gInfo {membership = membership'} m' + let connectedIncognito = memberIncognito membership probeMatchingMemberContact m' connectedIncognito processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index b0dbb23390..d28fdb10f8 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1074,10 +1074,14 @@ viewNetworkStatuses = map viewStatuses . L.groupBy ((==) `on` netStatus) . sortO viewStatuses ss@(s :| _) = plain $ show (L.length ss) <> " connections " <> netStatusStr (netStatus s) viewUserJoinedGroup :: GroupInfo -> [StyledString] -viewUserJoinedGroup g = +viewUserJoinedGroup g@GroupInfo {membership} = case incognitoMembershipProfile g of - Just mp -> [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile mp)] - Nothing -> [ttyGroup' g <> ": you joined the group"] + Just mp -> [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile mp) <> pendingApproval_] + Nothing -> [ttyGroup' g <> ": you joined the group" <> pendingApproval_] + where + pendingApproval_ = case memberStatus membership of + GSMemPendingApproval -> ", pending approval" + _ -> "" viewJoinedGroupMember :: GroupInfo -> GroupMember -> [StyledString] viewJoinedGroupMember g@GroupInfo {groupId} m@GroupMember {groupMemberId, memberStatus} = case memberStatus of diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 03671d1d94..f312ee6317 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -408,8 +408,8 @@ getTermLine cc@TestCC {printOutput} = 5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case Just s -> do -- remove condition to always echo virtual terminal - -- when True $ do - when printOutput $ do + when True $ do + -- when printOutput $ do name <- userName cc putStrLn $ name <> ": " <> s pure s diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 8a2000dc4c..ce2f3d6a36 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -27,7 +27,7 @@ import Simplex.Chat.Messages (CIMention (..), CIMentionMember (..), ChatItemId) import Simplex.Chat.Options import Simplex.Chat.Protocol (MsgMention (..), MsgContent (..), msgContentText) import Simplex.Chat.Types -import Simplex.Chat.Types.Shared (GroupMemberRole (..)) +import Simplex.Chat.Types.Shared (GroupMemberRole (..), GroupAcceptance (..)) import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.RetryInterval import qualified Simplex.Messaging.Agent.Store.DB as DB @@ -87,7 +87,7 @@ chatGroupTests = do xit'' "shared batch body is reused" testSharedBatchBody describe "async group connections" $ do xit "create and join group when clients go offline" testGroupAsync - fdescribe "group links" $ do + describe "group links" $ do it "create group link, join via group link" testGroupLink it "invitees were previously connected as contacts" testGroupLinkInviteesWereConnected it "all members were previously connected as contacts" testGroupLinkAllMembersWereConnected @@ -98,7 +98,10 @@ chatGroupTests = do it "group link member role" testGroupLinkMemberRole it "host profile received" testGroupLinkHostProfileReceived it "existing contact merged" testGroupLinkExistingContactMerged - it "reject member joining via group link - blocked name" testGroupLinkRejectBlockedName + describe "group links - join rejection" $ do + it "reject member joining via group link - blocked name" testGLinkRejectBlockedName + fdescribe "group links - manual acceptance" $ do + it "manually accept member joining via group link" testGLinkManualAcceptMember describe "group link connection plan" $ do it "ok to connect; known group" testPlanGroupLinkKnown it "own group link" testPlanGroupLinkOwn @@ -184,7 +187,7 @@ chatGroupTests = do it "should send updated mentions in history" testGroupHistoryWithMentions describe "uniqueMsgMentions" testUniqueMsgMentions describe "updatedMentionNames" testUpdatedMentionNames - fdescribe "group direct messages" $ do + describe "group direct messages" $ do it "should send group direct messages" testGroupDirectMessages testGroupCheckMessages :: HasCallStack => TestParams -> IO () @@ -2874,8 +2877,8 @@ testGroupLinkExistingContactMerged = bob #> "#team hi there" alice <# "#team bob> hi there" -testGroupLinkRejectBlockedName :: HasCallStack => TestParams -> IO () -testGroupLinkRejectBlockedName = +testGLinkRejectBlockedName :: HasCallStack => TestParams -> IO () +testGLinkRejectBlockedName = testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do alice ##> "/g team" @@ -2903,6 +2906,67 @@ testGroupLinkRejectBlockedName = where cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Left GRRBlockedName)}} +testGLinkManualAcceptMember :: HasCallStack => TestParams -> IO () +testGLinkManualAcceptMember = + testChatCfg3 cfg aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup2 "team" alice bob + + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + alice <## "cath (Catherine): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: cath connected and pending approval, use /_accept member #1 3 to accept member", + do + cath <## "#team: joining the group..." + cath <## "#team: you joined the group, pending approval" + ] + + -- pending approval member doesn't see messages sent in group + alice #> "#team hi group" + bob <# "#team alice> hi group" + + bob #> "#team hey" + alice <# "#team bob> hey" + + -- pending approval member and host can send messages to each other + alice ##> "/_send #1 @3 text send me proofs" + alice <# "#team send me proofs" + cath <# "#team alice> send me proofs" + + cath ##> "/_send #1 @1 text proofs" + cath <# "#team proofs" + alice <# "#team cath> proofs" + + -- accept member + alice ##> "/_accept member #1 3 member" + concurrentlyN_ + [ alice <## "#team: cath joined the group", + cath + <### [ "#team: you joined the group", + WithTime "#team alice> hi group [>>]", + StartsWith "duplicate group message", -- TODO [knocking] <- bug - remove + WithTime "#team bob> hey [>>]", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + + alice #> "#team welcome cath" + [bob, cath] *<# "#team alice> welcome cath" + + bob #> "#team hi cath" + [alice, cath] *<# "#team bob> hi cath" + + cath #> "#team hi group" + [alice, bob] *<# "#team cath> hi group" + where + cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAManual, GRObserver))}} + testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO () testPlanGroupLinkKnown = testChat2 aliceProfile bobProfile $