From f2e8545c0a3aecf68054123f22825c2565f36c2e Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sat, 5 Jul 2025 21:45:07 +0100 Subject: [PATCH] core: fix plans for deleted contacts and groups to allow connecting to them again (#6041) * core: fix plans for deleted contacts and groups to allow connecting to them again * improve, tests * query plans * remove comment --- src/Simplex/Chat/Library/Commands.hs | 20 +++++------ src/Simplex/Chat/View.hs | 36 ++++++++++++------- tests/ChatTests/Direct.hs | 1 + tests/ChatTests/Profiles.hs | 52 ++++++++++++++++++++++++---- 4 files changed, 80 insertions(+), 29 deletions(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 40bf3f0d13..9e38d2c96d 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -3398,6 +3398,7 @@ processChatCommand' vr = \case let inv cReq = ACCL SCMInvitation $ CCLink cReq (Just l') liftIO (getConnectionEntityViaShortLink db vr user l') >>= \case Just (cReq, ent) -> pure $ Just (inv cReq, invitationEntityPlan Nothing ent) + -- deleted contact is returned as known, as invitation link cannot be re-used too connect anyway Nothing -> bimap inv (CPInvitationLink . ILPKnown) <$$> getContactViaShortLinkToConnect db vr user l' invitationReqAndPlan cReq sLnk_ contactSLinkData_ = do plan <- invitationRequestPlan user cReq contactSLinkData_ `catchChatError` (pure . CPError) @@ -3409,6 +3410,7 @@ processChatCommand' vr = \case CLShort l@(CSLContact _ ct _ _) -> do let l' = serverShortLink l con cReq = ACCL SCMContact $ CCLink cReq (Just l') + gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g)) case ct of CCTContact -> knownLinkPlans >>= \case @@ -3427,8 +3429,8 @@ processChatCommand' vr = \case Just UserContactLink {connLinkContact = CCLink cReq _} -> pure $ Just (con cReq, CPContactAddress CAPOwnLink) Nothing -> getContactViaShortLinkToConnect db vr user l' >>= \case - Just (cReq, ct') -> pure $ Just (con cReq, CPContactAddress (CAPKnown ct')) - Nothing -> bimap con (CPGroupLink . GLPKnown) <$$> getGroupViaShortLinkToConnect db vr user l' + Just (cReq, ct') -> pure $ if contactDeleted ct' then Nothing else Just (con cReq, CPContactAddress (CAPKnown ct')) + Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db vr user l' CCTGroup -> knownLinkPlans >>= \case Just r -> pure r @@ -3441,8 +3443,7 @@ processChatCommand' vr = \case knownLinkPlans = withFastStore $ \db -> liftIO (getGroupInfoViaUserShortLink db vr user l') >>= \case Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g)) - Nothing -> - bimap con (CPGroupLink . GLPKnown ) <$$> getGroupViaShortLinkToConnect db vr user l' + Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db vr user l' CCTChannel -> throwCmdError "channel links are not supported in this version" connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse connectWithPlan user@User {userId} incognito ccLink plan @@ -3501,7 +3502,7 @@ processChatCommand' vr = \case | contactDeleted ct -> pure $ CPContactAddress (CAPOk contactSLinkData_) | otherwise -> pure $ CPContactAddress (CAPKnown ct) -- TODO [short links] RcvGroupMsgConnection branch is deprecated? (old group link protocol?) - Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo + Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing Just _ -> throwCmdError "found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection" groupJoinRequestPlan :: User -> ConnReqContact -> Maybe GroupShortLinkData -> CM ConnectionPlan groupJoinRequestPlan user (CRContactUri crData) groupSLinkData_ = do @@ -3520,15 +3521,14 @@ processChatCommand' vr = \case | not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_) | otherwise -> pure $ CPGroupLink (GLPOk groupSLinkData_) (Nothing, Just _) -> throwCmdError "found connection entity is not RcvDirectMsgConnection" - (Just gInfo, _) -> groupPlan gInfo - groupPlan :: GroupInfo -> CM ConnectionPlan - groupPlan gInfo@GroupInfo {membership} + (Just gInfo, _) -> groupPlan gInfo groupSLinkData_ + groupPlan :: GroupInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan + groupPlan gInfo@GroupInfo {membership} groupSLinkData_ | memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo) | not (memberActive membership) && not (memberRemoved membership) = pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo) | memberActive membership = pure $ CPGroupLink (GLPKnown gInfo) - -- TODO [short links] entity is already found - passing GroupShortLinkData doesn't make sense? - | otherwise = pure $ CPGroupLink (GLPOk Nothing) + | otherwise = pure $ CPGroupLink (GLPOk groupSLinkData_) contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact) contactCReqSchemas crData = ( CRContactUri crData {crScheme = SSSimplex}, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 71b6a0aef1..fe28775c50 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -386,7 +386,7 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView} CEvtGroupMemberSwitch u g m progress -> ttyUser u $ viewGroupMemberSwitch g m progress CEvtContactRatchetSync u ct progress -> ttyUser u $ viewContactRatchetSync ct progress CEvtGroupMemberRatchetSync u g m progress -> ttyUser u $ viewGroupMemberRatchetSync g m progress - CEvtChatInfoUpdated u chatInfo -> [] + CEvtChatInfoUpdated _ _ -> [] CEvtNewChatItems u chatItems -> viewChatItems ttyUser unmuted u chatItems ts tz CEvtChatItemsStatusesUpdated u chatItems | length chatItems <= 20 -> @@ -1895,6 +1895,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)] ILPKnown ct | nextConnectPrepared ct -> [invLink ("known prepared contact " <> ttyContact' ct)] + | contactDeleted ct -> [invLink ("known deleted contact " <> ttyContact' ct)] | otherwise -> [ invLink ("known contact " <> ttyContact' ct), "use " <> ttyToContact' ct <> highlight' "" <> " to send messages" @@ -1903,7 +1904,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case invLink = ("invitation link: " <>) invOrBiz = \case Just ContactShortLinkData {business} - | business -> ("business link: " <>) + | business -> ("business address: " <>) _ -> ("invitation link: " <>) CPContactAddress cap -> case cap of CAPOk contactSLinkData -> [addrOrBiz contactSLinkData "ok to connect"] <> [viewJSON contactSLinkData | testView] @@ -1921,7 +1922,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case ctAddr = ("contact address: " <>) addrOrBiz = \case Just ContactShortLinkData {business} - | business -> ("business link: " <>) + | business -> ("business address: " <>) _ -> ("contact address: " <>) CPGroupLink glp -> case glp of GLPOk groupSLinkData -> [grpLink "ok to connect"] <> [viewJSON groupSLinkData | testView] @@ -1929,19 +1930,28 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"] GLPConnectingProhibit Nothing -> [grpLink "connecting"] GLPConnectingProhibit (Just g) -> connecting g - GLPKnown g@GroupInfo {preparedGroup} -> case preparedGroup of - Just PreparedGroup {connLinkStartedConnection} - | connLinkStartedConnection -> connecting g - | otherwise -> [knownGroup "prepared "] - Nothing -> - [ knownGroup "", - "use " <> ttyToGroup g Nothing <> highlight' "" <> " to send messages" - ] + GLPKnown g@GroupInfo {preparedGroup, membership = m} -> case preparedGroup of + Just PreparedGroup {connLinkStartedConnection} -> case memberStatus m of + GSMemUnknown + | connLinkStartedConnection -> connecting g + | otherwise -> [knownGroup "prepared "] + GSMemAccepted -> connecting g + _ + | memberRemoved m -> [knownGroup "deleted "] -- it should not get here, as this plan is returned as GLPOk + | otherwise -> knownActive + _ -> knownActive where - knownGroup prepared = grpOrBiz g <> " link: known " <> prepared <> grpOrBiz g <> " " <> ttyGroup' g + knownActive = + [ knownGroup "", + "use " <> ttyToGroup g Nothing <> highlight' "" <> " to send messages" + ] + knownGroup prepared = grpOrBizLink g <> ": known " <> prepared <> grpOrBiz g <> " " <> ttyGroup' g where - connecting g = [grpOrBiz g <> " link: connecting to " <> grpOrBiz g <> " " <> ttyGroup' g] + connecting g = [grpOrBizLink g <> ": connecting to " <> grpOrBiz g <> " " <> ttyGroup' g] grpLink = ("group link: " <>) + grpOrBizLink GroupInfo {businessChat} = case businessChat of + Just _ -> "business address" + Nothing -> "group link" grpOrBiz GroupInfo {businessChat} = case businessChat of Just _ -> "business" Nothing -> "group" diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 63668e6df1..66dc5b9571 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -313,6 +313,7 @@ testRetryConnectingClientTimeout ps = do withSmpServer' serverCfg' $ do withTestChatCfgOpts ps cfg' opts' "alice" $ \alice -> do withTestChatCfgOpts ps cfg' opts' "bob" $ \bob -> do + threadDelay 250000 bob ##> ("/_connect plan 1 " <> inv) bob <## "invitation link: ok to connect" _sLinkData <- getTermLine bob diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 47fd16f642..639b50d1ad 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -819,7 +819,7 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice bob <## "#biz: joining the group..." -- the next command can be prone to race conditions bob ##> ("/_connect plan 1 " <> cLink) - bob <## "business link: connecting to business #biz" + bob <## "business address: connecting to business #biz" biz <## "#bob: bob_1 joined the group" bob <## "#biz: you joined the group" biz #> "#bob hi" @@ -827,7 +827,7 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice bob #> "#biz hello" biz <# "#bob bob_1> hello" bob ##> ("/_connect plan 1 " <> cLink) - bob <## "business link: known business #biz" + bob <## "business address: known business #biz" bob <## "use #biz to send messages" connectUsers biz alice biz <##> alice @@ -2989,6 +2989,14 @@ testShortLinkInvitationPrepareContact ps@TestParams {largeLinkData} = testChatCf (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") alice <##> bob + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: known contact alice" + bob <## "use @alice to send messages" + alice ##> "/d bob" + alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "invitation link: known deleted contact alice" testShortLinkInvitationImage :: HasCallStack => TestParams -> IO () testShortLinkInvitationImage ps@TestParams {largeLinkData} = testChatCfg2 testCfg {largeLinkData} aliceProfile bobProfile test ps @@ -3117,6 +3125,15 @@ testShortLinkAddressPrepareContact ps@TestParams {largeLinkData} = testChatCfg2 (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") alice <##> bob + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" + alice ##> "/d bob" + alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "contact address: ok to connect" + void $ getTermLine bob testShortLinkDeletedInvitation :: HasCallStack => TestParams -> IO () testShortLinkDeletedInvitation ps@TestParams {largeLinkData} = testChatCfg2 testCfg {largeLinkData} aliceProfile bobProfile test ps @@ -3288,19 +3305,19 @@ testShortLinkAddressPrepareBusiness ps@TestParams {largeLinkData} = testChatCfg3 biz ##> "/auto_accept on business" biz <## "auto_accept on, business" bob ##> ("/_connect plan 1 " <> shortLink) - bob <## "business link: ok to connect" + bob <## "business address: ok to connect" contactSLinkData <- getTermLine bob bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> contactSLinkData) bob <## "#biz: group is prepared" bob ##> ("/_connect plan 1 " <> shortLink) - bob <## "business link: known prepared business #biz" + bob <## "business address: known prepared business #biz" bob ##> "/_connect group #1" bob <## "#biz: connection started" biz <## "#bob (Bob): accepting business address request..." bob <## "#biz: joining the group..." -- the next command can be prone to race conditions bob ##> ("/_connect plan 1 " <> shortLink) - bob <## "business link: connecting to business #biz" + bob <## "business address: connecting to business #biz" biz <## "#bob: bob_1 joined the group" bob <## "#biz: you joined the group" biz #> "#bob hi" @@ -3333,6 +3350,18 @@ testShortLinkAddressPrepareBusiness ps@TestParams {largeLinkData} = testChatCfg3 concurrently_ (alice <# "#bob bob_1> hey there") (biz <# "#bob bob_1> hey there") + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "business address: known business #biz" + bob <## "use #biz to send messages" + biz ##> "/d #bob" + biz <## "#bob: you deleted the group" + alice <## "#bob: biz deleted the group" + alice <## "use /d #bob to delete the local copy of the group" + bob <## "#biz: biz_1 deleted the group" + bob <## "use /d #biz to delete the local copy of the group" + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "business address: ok to connect" + void $ getTermLine bob testBusinessAddressRequestMessage :: HasCallStack => TestParams -> IO () testBusinessAddressRequestMessage ps@TestParams {largeLinkData} = testChatCfg3 testCfg {largeLinkData} businessProfile aliceProfile {fullName = "Alice @ Biz"} bobProfile test ps @@ -3345,7 +3374,7 @@ testBusinessAddressRequestMessage ps@TestParams {largeLinkData} = testChatCfg3 t biz <## "auto reply:" biz <## "Welcome!" bob ##> ("/_connect plan 1 " <> shortLink) - bob <## "business link: ok to connect" + bob <## "business address: ok to connect" contactSLinkData <- getTermLine bob bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> shortLink <> " " <> contactSLinkData) bob <## "#biz: group is prepared" @@ -3415,6 +3444,17 @@ testShortLinkPrepareGroup ps@TestParams {largeLinkData} = testChatCfg3 testCfg { [alice, cath] *<# "#team bob> 2" cath #> "#team 3" [alice, bob] *<# "#team cath> 3" + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "group link: known group #team" + bob <## "use #team to send messages" + bob ##> "/l #team" + bob <## "#team: you left the group" + bob <## "use /d #team to delete the group" + alice <## "#team: bob left the group" + cath <## "#team: bob left the group" + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "group link: ok to connect" + void $ getTermLine bob testShortLinkPrepareGroupReject :: HasCallStack => TestParams -> IO () testShortLinkPrepareGroupReject ps@TestParams {largeLinkData} = testChatCfg3 cfg {largeLinkData} aliceProfile bobProfile cathProfile test ps