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

* core: confirm to reconnect plan

* rework query to prefer connections with contacts

src/Simplex/Chat.hs

@@ -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
+                Just (RcvDirectMsgConnection _conn Nothing) -> pure $ CPContactAddress CAPConnectingConfirmReconnect
-                  | not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnecting ct)
+                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)
+                (Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect
-                  | not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnecting gInfo_)
+                (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
 

src/Simplex/Chat/Controller.hs

@@ -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
+connectionPlanProceed :: ConnectionPlan -> Bool
-connectionPlanOk = \case
+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}

src/Simplex/Chat/Store/Connections.hs

@@ -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"

src/Simplex/Chat/Types.hs

@@ -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
 

src/Simplex/Chat/View.hs

@@ -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"]
+    GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
-    GLPConnecting (Just g) -> [grpLink ("connecting to group " <> ttyGroup' g)]
+    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"

tests/ChatTests/Groups.hs

@@ -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",

tests/ChatTests/Profiles.hs

@@ -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"