mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-14 14:45:33 +00:00
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:
@@ -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
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user