IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: confirm to reconnect via address plan (#3212)

Browse Source 
* core: confirm to reconnect plan

* rework query to prefer connections with contacts
This commit is contained in:
spaced4ndy 2023-10-16 16:10:56 +04:00 committed by GitHub
parent 43b67ba157
commit 4b6df43e97
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 67 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/Simplex/Chat.hs
View File

@ -1364,13 +1364,13 @@ processChatCommand = \case
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do
plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
unless (connectionPlanOk plan) $ throwChatError (CEConnectionPlan plan)
unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan)
processChatCommand $ APIConnect userId incognito aCReqUri
Connect _ Nothing -> throwChatError CEInvalidConnReq
ConnectSimplex incognito -> withUser $ \user@User {userId} -> do
let cReqUri = ACR SCMContact adminContactReq
plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
unless (connectionPlanOk plan) $ throwChatError (CEConnectionPlan plan)
unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan)
processChatCommand $ APIConnect userId incognito (Just cReqUri)
DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True
ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
@ -2245,27 +2245,32 @@ processChatCommand = \case
Just _ -> pure $ CPContactAddress CAPOwnLink
Nothing -> do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
withStore' (\db -> getContactByConnReqHash db user cReqHash) >>= \case
withStore' (\db -> getContactConnEntityByConnReqHash db user cReqHash) >>= \case
Nothing -> pure $ CPContactAddress CAPOk
Just ct
| not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnecting ct)
Just (RcvDirectMsgConnection _conn Nothing) -> pure $ CPContactAddress CAPConnectingConfirmReconnect
Just (RcvDirectMsgConnection _ (Just ct))
| not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct)
| contactDeleted ct -> pure $ CPContactAddress CAPOk
| otherwise -> pure $ CPContactAddress (CAPKnown ct)
Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection"
-- group link
Just _ ->
withStore' (\db -> getGroupInfoByUserContactLinkConnReq db user cReq) >>= \case
Just g -> pure $ CPGroupLink (GLPOwnLink g)
Nothing -> do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
ct_ <- withStore' $ \db -> getContactByConnReqHash db user cReqHash
connEnt_ <- withStore' $ \db -> getContactConnEntityByConnReqHash db user cReqHash
gInfo_ <- withStore' $ \db -> getGroupInfoByGroupLinkHash db user cReqHash
case (gInfo_, ct_) of
case (gInfo_, connEnt_) of
(Nothing, Nothing) -> pure $ CPGroupLink GLPOk
(Nothing, Just ct)
| not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnecting gInfo_)
(Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect
(Nothing, Just (RcvDirectMsgConnection _ (Just ct)))
| not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_)
| otherwise -> pure $ CPGroupLink GLPOk
(Nothing, Just _) -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection"
(Just gInfo@GroupInfo {membership}, _)
| not (memberActive membership) && not (memberRemoved membership) ->
pure $ CPGroupLink (GLPConnecting gInfo_)
pure $ CPGroupLink (GLPConnectingProhibit gInfo_)
| memberActive membership -> pure $ CPGroupLink (GLPKnown gInfo)
| otherwise -> pure $ CPGroupLink GLPOk

12
src/Simplex/Chat/Controller.hs
View File

@ -647,7 +647,8 @@ instance ToJSON InvitationLinkPlan where
data ContactAddressPlan
= CAPOk
| CAPOwnLink
| CAPConnecting {contact :: Contact}
| CAPConnectingConfirmReconnect
| CAPConnectingProhibit {contact :: Contact}
| CAPKnown {contact :: Contact}
deriving (Show, Generic)
@ -658,7 +659,8 @@ instance ToJSON ContactAddressPlan where
data GroupLinkPlan
= GLPOk
| GLPOwnLink {groupInfo :: GroupInfo}
| GLPConnecting {groupInfo_ :: Maybe GroupInfo}
| GLPConnectingConfirmReconnect
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
| GLPKnown {groupInfo :: GroupInfo}
deriving (Show, Generic)
@ -666,8 +668,8 @@ instance ToJSON GroupLinkPlan where
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "GLP"
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "GLP"
connectionPlanOk :: ConnectionPlan -> Bool
connectionPlanOk = \case
connectionPlanProceed :: ConnectionPlan -> Bool
connectionPlanProceed = \case
CPInvitationLink ilp -> case ilp of
ILPOk -> True
ILPOwnLink -> True
@ -675,10 +677,12 @@ connectionPlanOk = \case
CPContactAddress cap -> case cap of
CAPOk -> True
CAPOwnLink -> True
CAPConnectingConfirmReconnect -> True
_ -> False
CPGroupLink glp -> case glp of
GLPOk -> True
GLPOwnLink _ -> True
GLPConnectingConfirmReconnect -> True
_ -> False
newtype UserPwd = UserPwd {unUserPwd :: Text}

24
src/Simplex/Chat/Store/Connections.hs
View File

@ -10,6 +10,7 @@
module Simplex.Chat.Store.Connections
( getConnectionEntity,
getConnectionEntityByConnReq,
getContactConnEntityByConnReqHash,
getConnectionsToSubscribe,
unsetConnectionToSubscribe,
)
@ -159,6 +160,29 @@ getConnectionEntityByConnReq db user cReq = do
DB.query db "SELECT agent_conn_id FROM connections WHERE conn_req_inv = ? LIMIT 1" (Only cReq)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_
-- search connection for connection plan:
-- multiple connections can have same via_contact_uri_hash if request was repeated;
-- this function searches for latest connection with contact so that "known contact" plan would be chosen;
-- deleted connections are filtered out to allow re-connecting via same contact address
getContactConnEntityByConnReqHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash db user cReqHash = do
connId_ <- maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT agent_conn_id FROM (
SELECT
agent_conn_id,
(CASE WHEN contact_id IS NOT NULL THEN 1 ELSE 0 END) AS conn_ord
FROM connections
WHERE via_contact_uri_hash = ? AND conn_status != ?
ORDER BY conn_ord DESC, created_at DESC
LIMIT 1
)
|]
(cReqHash, ConnDeleted)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_
getConnectionsToSubscribe :: DB.Connection -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe db = do
aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"

3
src/Simplex/Chat/Types.hs
View File

@ -219,6 +219,9 @@ contactReady Contact {activeConn} = connReady activeConn
contactActive :: Contact -> Bool
contactActive Contact {contactStatus} = contactStatus == CSActive
contactDeleted :: Contact -> Bool
contactDeleted Contact {contactStatus} = contactStatus == CSDeleted
contactSecurityCode :: Contact -> Maybe SecurityCode
contactSecurityCode Contact {activeConn} = connectionCode activeConn

8
src/Simplex/Chat/View.hs
View File

@ -1281,7 +1281,8 @@ viewConnectionPlan = \case
CPContactAddress cap -> case cap of
CAPOk -> [ctAddr "ok to connect"]
CAPOwnLink -> [ctAddr "own address"]
CAPConnecting ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
CAPConnectingConfirmReconnect -> [ctAddr "connecting, allowed to reconnect"]
CAPConnectingProhibit ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)]
CAPKnown ct ->
[ ctAddr ("known contact " <> ttyContact' ct),
"use " <> ttyToContact' ct <> highlight' "<message>" <> " to send messages"
@ -1291,8 +1292,9 @@ viewConnectionPlan = \case
CPGroupLink glp -> case glp of
GLPOk -> [grpLink "ok to connect"]
GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g]
GLPConnecting Nothing -> [grpLink "connecting"]
GLPConnecting (Just g) -> [grpLink ("connecting to group " <> ttyGroup' g)]
GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
GLPConnectingProhibit Nothing -> [grpLink "connecting"]
GLPConnectingProhibit (Just g) -> [grpLink ("connecting to group " <> ttyGroup' g)]
GLPKnown g ->
[ grpLink ("known group " <> ttyGroup' g),
"use " <> ttyToGroup g <> highlight' "<message>" <> " to send messages"

7
tests/ChatTests/Groups.hs
View File

@ -2397,8 +2397,15 @@ testPlanGroupLinkConnecting tmp = do
alice ##> "/create link #team"
getGroupLink alice "team" GRMember True
withNewTestChat tmp "bob" bobProfile $ \bob -> do
threadDelay 100000
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: connecting, allowed to reconnect"
threadDelay 100000
withTestChat tmp "alice" $ \alice -> do
alice
<### [ "1 group links active",

5
tests/ChatTests/Profiles.hs
View File

@ -651,8 +651,13 @@ testPlanAddressConnecting tmp = do
getContactLink alice True
withNewTestChat tmp "bob" bobProfile $ \bob -> do
threadDelay 100000
bob ##> ("/c " <> cLink)
bob <## "connection request sent!"
bob ##> ("/_connect plan 1 " <> cLink)
bob <## "contact address: connecting, allowed to reconnect"
threadDelay 100000
withTestChat tmp "alice" $ \alice -> do
alice <## "Your address is active! To show: /sa"