core: fix retry when connecting via invitation short link, ios: improve connection status usage (#6014)

* core: fix retry when connecting via invitation short link

* ios: fix conditions, mark contacts as connected, only show spinners on contacts when connection status is ready or sndReady

src/Simplex/Chat/Controller.hs

@@ -456,7 +456,7 @@ data ChatCommand
   | APIChangePreparedGroupUser GroupId UserId
   | APIConnectPreparedContact {contactId :: ContactId, incognito :: IncognitoEnabled, msgContent_ :: Maybe MsgContent}
   | APIConnectPreparedGroup GroupId IncognitoEnabled (Maybe MsgContent)
-  | APIConnect UserId IncognitoEnabled (Maybe ACreatedConnLink)
+  | APIConnect UserId IncognitoEnabled ACreatedConnLink
   | Connect IncognitoEnabled (Maybe AConnectionLink)
   | APIConnectContactViaAddress UserId IncognitoEnabled ContactId
   | ConnectSimplex IncognitoEnabled -- UserId (not used in UI)

src/Simplex/Chat/Library/Commands.hs

@@ -1157,7 +1157,6 @@ processChatCommand' vr = \case
     when (shortLinkDataSet && incognito) $ throwCmdError "incognito not allowed for address with short link data"
     withUserContactLock "acceptContact" uclId $ do
       cReq <- withFastStore $ \db -> getContactRequest db user connReqId
-      -- TODO [short links] accept async, move to continuation on JOIN?
       (ct, conn@Connection {connId}, sqSecured) <- acceptContactRequest user cReq incognito
       let contactUsed = isNothing gLinkInfo_
       ct' <- withStore' $ \db -> do
@@ -1795,18 +1794,16 @@ processChatCommand' vr = \case
     Contact {preparedContact} <- withFastStore $ \db -> getContact db vr user contactId
     case preparedContact of
       Nothing -> throwCmdError "contact doesn't have link to connect"
-      Just PreparedContact {connLinkToConnect = ACCL SCMInvitation ccLink} ->
-        connectViaInvitation user incognito ccLink (Just contactId) >>= \case
-          CRSentConfirmation {customUserProfile} -> do
-            -- get updated contact with connection
-            ct' <- withFastStore $ \db -> getContact db vr user contactId
-            forM_ msgContent_ $ \mc -> do
-              let evt = XMsgNew $ MCSimple (extMsgContent mc Nothing)
-              (msg, _) <- sendDirectContactMessage user ct' evt
-              ci <- saveSndChatItem user (CDDirectSnd ct') msg (CISndMsgContent mc)
-              toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci]
-            pure $ CRStartedConnectionToContact user ct' customUserProfile
-          cr -> pure cr
+      Just PreparedContact {connLinkToConnect = ACCL SCMInvitation ccLink} -> do
+        (_, customUserProfile) <- connectViaInvitation user incognito ccLink (Just contactId)
+        -- get updated contact with connection
+        ct' <- withFastStore $ \db -> getContact db vr user contactId
+        forM_ msgContent_ $ \mc -> do
+          let evt = XMsgNew $ MCSimple (extMsgContent mc Nothing)
+          (msg, _) <- sendDirectContactMessage user ct' evt
+          ci <- saveSndChatItem user (CDDirectSnd ct') msg (CISndMsgContent mc)
+          toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci]
+        pure $ CRStartedConnectionToContact user ct' customUserProfile
       Just PreparedContact {connLinkToConnect = ACCL SCMContact ccLink, welcomeSharedMsgId} -> do
         -- TODO [short links] reuse welcomeSharedMsgId
         msg_ <- forM msgContent_ $ \mc -> (,mc) <$> getSharedMsgId
@@ -1831,11 +1828,12 @@ processChatCommand' vr = \case
             gInfo' <- withFastStore $ \db -> getGroupInfo db vr user groupId
             pure $ CRStartedConnectionToGroup user gInfo' customUserProfile
           cr -> pure cr
-  APIConnect userId incognito (Just (ACCL SCMInvitation ccLink)) -> withUserId userId $ \user ->
-    connectViaInvitation user incognito ccLink Nothing
-  APIConnect userId incognito (Just (ACCL SCMContact ccLink)) -> withUserId userId $ \user ->
-    connectViaContact user incognito ccLink Nothing Nothing Nothing
-  APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
+  APIConnect userId incognito acl -> withUserId userId $ \user -> case acl of
+    ACCL SCMInvitation ccLink -> do
+      (dbConnId, incognitoProfile) <- connectViaInvitation user incognito ccLink Nothing
+      pcc <- withFastStore $ \db -> getPendingContactConnection db userId dbConnId
+      pure $ CRSentConfirmation user pcc incognitoProfile
+    ACCL SCMContact ccLink -> connectViaContact user incognito ccLink Nothing Nothing Nothing
   Connect incognito (Just cLink@(ACL m cLink')) -> withUser $ \user -> do
     (ccLink, plan) <- connectPlan user cLink `catchChatError` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing)); _ -> throwError e
     connectWithPlan user incognito ccLink plan
@@ -2869,9 +2867,9 @@ processChatCommand' vr = \case
       CTGroup -> withFastStore $ \db -> getGroupChatItemIdByText' db user cId msg
       CTLocal -> withFastStore $ \db -> getLocalChatItemIdByText' db user cId msg
       _ -> throwCmdError "not supported"
-    connectViaInvitation :: User -> IncognitoEnabled -> CreatedLinkInvitation -> Maybe ContactId -> CM ChatResponse
+    connectViaInvitation :: User -> IncognitoEnabled -> CreatedLinkInvitation -> Maybe ContactId -> CM (Int64, Maybe Profile)
     connectViaInvitation user@User {userId} incognito (CCLink cReq@(CRInvitationUri crData e2e) sLnk_) contactId_ =
-      withInvitationLock "connect" (strEncode cReq) . procCmd $ do
+      withInvitationLock "connect" (strEncode cReq) $ do
         subMode <- chatReadVar subscriptionMode
         -- [incognito] generate profile to send
         incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
@@ -2884,24 +2882,22 @@ processChatCommand' vr = \case
             dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
             withFastStore' (\db -> getConnectionEntityByConnReq db vr user cReqs) >>= \case
               Nothing -> joinNewConn chatV dm
-              Just (RcvDirectMsgConnection conn@Connection {connId, connStatus, contactConnInitiated} _ct_)
+              Just (RcvDirectMsgConnection conn@Connection {connId = dbConnId, connStatus, contactConnInitiated} _ct_)
                 | connStatus == ConnNew && contactConnInitiated -> joinNewConn chatV dm -- own connection link
-                | connStatus == ConnPrepared -> do
-                    -- retrying join after error
-                    pcc <- withFastStore $ \db -> getPendingContactConnection db userId connId
-                    joinPreparedConn (aConnId conn) pcc dm
+                | connStatus == ConnPrepared -> joinPreparedConn dbConnId (aConnId conn) dm -- retrying join after error
               Just ent -> throwCmdError $ "connection is not RcvDirectMsgConnection: " <> show (connEntityInfo ent)
             where
               joinNewConn chatV dm = do
                 connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
                 let ccLink = CCLink cReq $ serverShortLink <$> sLnk_
-                pcc <- withFastStore' $ \db -> createDirectConnection db user connId ccLink contactId_ ConnPrepared (incognitoProfile $> profileToSend) subMode chatV pqSup'
-                joinPreparedConn connId pcc dm
-              joinPreparedConn connId pcc@PendingContactConnection {pccConnId} dm = do
+                createdAt <- liftIO getCurrentTime
+                (dbConnId, _) <- withFastStore' $ \db -> createDirectConnection_ db userId connId ccLink contactId_ ConnPrepared (incognitoProfile $> profileToSend) subMode chatV pqSup' createdAt
+                joinPreparedConn dbConnId connId dm
+              joinPreparedConn dbConnId connId dm = do
                 (sqSecured, _serviceId) <- withAgent $ \a -> joinConnection a (aUserId user) connId True cReq dm pqSup' subMode
                 let newStatus = if sqSecured then ConnSndReady else ConnJoined
-                withFastStore' $ \db -> updateConnectionStatusFromTo db pccConnId ConnPrepared newStatus
-                pure $ CRSentConfirmation user pcc {pccConnStatus = newStatus} incognitoProfile
+                withFastStore' $ \db -> updateConnectionStatusFromTo db dbConnId ConnPrepared newStatus
+                pure (dbConnId, incognitoProfile)
               cReqs =
                 ( CRInvitationUri crData {crScheme = SSSimplex} e2e,
                   CRInvitationUri crData {crScheme = simplexChat} e2e
@@ -3363,7 +3359,7 @@ processChatCommand' vr = \case
           case plan of
             CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
               processChatCommand $ APIConnectContactViaAddress userId incognito contactId
-            _ -> processChatCommand $ APIConnect userId incognito (Just ccLink)
+            _ -> processChatCommand $ APIConnect userId incognito ccLink
       | otherwise = pure $ CRConnectionPlan user ccLink plan
     invitationRequestPlan :: User -> ConnReqInvitation -> Maybe ContactShortLinkData -> CM ConnectionPlan
     invitationRequestPlan user cReq contactSLinkData_ = do
@@ -4480,7 +4476,7 @@ chatCommandP =
       "/_connect contact @" *> (APIConnectPreparedContact <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)),
       "/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)),
       "/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP),
-      "/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> connLinkP_),
+      "/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> connLinkP),
       "/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),
       "/_set conn user :" *> (APIChangeConnectionUser <$> A.decimal <* A.space <*> A.decimal),
       ("/connect" <|> "/c") *> (AddContact <$> incognitoP),
@@ -4598,8 +4594,6 @@ chatCommandP =
       cReq <- strP
       sLink_ <- optional (A.space *> strP)
       pure $ CCLink cReq sLink_
-    connLinkP_ =
-      ((Just <$> connLinkP) <|> A.takeTill (== ' ') $> Nothing)
     incognitoP = (A.space *> ("incognito" <|> "i")) $> True <|> pure False
     incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False
     imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,")

src/Simplex/Chat/Library/Internal.hs

@@ -869,6 +869,14 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
               liftIO $ B.hPut h "" >> hFlush h
           | otherwise = liftIO $ B.writeFile fPath ""
 
+-- TODO [short links]
+-- Please note:
+-- - the connection here is created as ConnNew, even though when joining it is created as ConnPrepared.
+--   (changing it is risky, as there may be existing "prepared" connections that were not accepted in ConnNew status).
+-- - after accepted, the status is changed by this func caller to ConnSndReady if it is sndSecure, and not changed otherwise - joined changed to ConnJoined in this case.
+-- - xContactId is set on the contact at the first acceptance attempt, not after accept success, which prevents profile updates after such attempt.
+--   It may be reasonable to set it when contact is first prepared, but then we can't use it to ignore requests after acceptance,
+--   and it may lead to race conditions with XInfo events.
 acceptContactRequest :: User -> UserContactRequest -> IncognitoEnabled -> CM (Contact, Connection, SndQueueSecured)
 acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, contactId_, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId, pqSupport} incognito = do
   subMode <- chatReadVar subscriptionMode

src/Simplex/Chat/Store/Direct.hs

@@ -23,6 +23,7 @@ module Simplex.Chat.Store.Direct
     -- * Contacts and connections functions
     getPendingContactConnection,
     deletePendingContactConnection,
+    createDirectConnection_,
     createDirectConnection,
     createIncognitoProfile,
     createConnReqConnection,
@@ -63,7 +64,6 @@ module Simplex.Chat.Store.Direct
     deleteContactRequest,
     createContactFromRequest,
     createAcceptedContactConn,
-    createAcceptedContact,
     updateContactAccepted,
     getUserByContactRequestId,
     getPendingContactConnections,
@@ -235,8 +235,13 @@ getContactByConnReqHash db vr user@User {userId} cReqHash = do
   mapM (addDirectChatTags db) ct_
 
 createDirectConnection :: DB.Connection -> User -> ConnId -> CreatedLinkInvitation -> Maybe ContactId -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
-createDirectConnection db User {userId} acId ccLink@(CCLink cReq shortLinkInv) contactId_ pccConnStatus incognitoProfile subMode chatV pqSup = do
+createDirectConnection db User {userId} acId ccLink contactId_ pccConnStatus incognitoProfile subMode chatV pqSup = do
   createdAt <- getCurrentTime
+  (pccConnId, customUserProfileId) <- createDirectConnection_ db userId acId ccLink contactId_ pccConnStatus incognitoProfile subMode chatV pqSup createdAt
+  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connLinkInv = Just ccLink, localAlias = "", createdAt, updatedAt = createdAt}
+
+createDirectConnection_ :: DB.Connection -> UserId -> ConnId -> CreatedLinkInvitation -> Maybe ContactId -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> UTCTime -> IO (Int64, Maybe Int64)
+createDirectConnection_ db userId acId (CCLink cReq shortLinkInv) contactId_ pccConnStatus incognitoProfile subMode chatV pqSup createdAt = do
   customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
   let contactConnInitiated = pccConnStatus == ConnNew
   DB.execute
@@ -250,8 +255,8 @@ createDirectConnection db User {userId} acId ccLink@(CCLink cReq shortLinkInv) c
     ( (userId, acId, cReq, shortLinkInv, pccConnStatus, ConnContact, contactId_, BI contactConnInitiated, customUserProfileId)
         :. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
     )
-  pccConnId <- insertedRowId db
-  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connLinkInv = Just ccLink, localAlias = "", createdAt, updatedAt = createdAt}
+  dbConnId <- insertedRowId db
+  pure (dbConnId, customUserProfileId)
 
 createIncognitoProfile :: DB.Connection -> User -> Profile -> IO Int64
 createIncognitoProfile db User {userId} p = do
@@ -777,37 +782,6 @@ createAcceptedContactConn db User {userId} uclId contactId agentConnId connChatV
     ExistingIncognito LocalProfile {profileId = pId} -> pure pId
   createConnection_ db userId ConnContact (Just contactId) agentConnId ConnNew connChatVersion cReqChatVRange Nothing (Just uclId) customUserProfileId 0 currentTs subMode pqSup
 
-createAcceptedContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> Maybe IncognitoProfile -> SubscriptionMode -> ExceptT StoreError IO (Contact, Connection)
-createAcceptedContact
-  db
-  vr
-  user@User {userId}
-  uclId
-  agentConnId
-  connChatVersion
-  cReqChatVRange
-  Profile {displayName, fullName, image, contactLink, preferences}
-  xContactId
-  pqSup
-  incognitoProfile
-  subMode = do
-    currentTs <- liftIO getCurrentTime
-    let userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
-    contactId <- ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
-      DB.execute
-        db
-        "INSERT INTO contact_profiles (display_name, full_name, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
-        (displayName, fullName, image, contactLink, userId, preferences, currentTs, currentTs)
-      profileId <- insertedRowId db
-      DB.execute
-        db
-        "INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
-        (userId, ldn, profileId, BI True, userPreferences, currentTs, currentTs, currentTs, xContactId, BI True)
-      Right <$> insertedRowId db
-    conn <- liftIO $ createAcceptedContactConn db user uclId contactId agentConnId connChatVersion cReqChatVRange pqSup incognitoProfile subMode currentTs
-    ct <- getContact db vr user contactId
-    pure (ct, conn)
-
 updateContactAccepted :: DB.Connection -> User -> Contact -> Bool -> IO ()
 updateContactAccepted db User {userId} Contact {contactId} contactUsed =
   DB.execute

src/Simplex/Chat/Store/Files.hs

@@ -99,7 +99,6 @@ import Data.Type.Equality
 import Data.Word (Word32)
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
-import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Direct
 import Simplex.Chat.Store.Messages
 import Simplex.Chat.Store.Profiles