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
This commit is contained in:
Evgeny
2025-07-05 21:45:07 +01:00
committed by GitHub
parent 2dd54c6697
commit f2e8545c0a
4 changed files with 80 additions and 29 deletions
+10 -10
View File
@@ -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},
+23 -13
View File
@@ -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' "<message>" <> " 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' "<message>" <> " 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' "<message>" <> " 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"
+1
View File
@@ -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
+46 -6
View File
@@ -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 <message> 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 <message> 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 <message> 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 <message> 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 <message> 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