core: preset simplex contact (#3321)

simplex-chat.cabal

@@ -119,6 +119,7 @@ library
       Simplex.Chat.Migrations.M20231010_member_settings
       Simplex.Chat.Migrations.M20231019_indexes
       Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
+      Simplex.Chat.Migrations.M20231107_indexes
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared

src/Simplex/Chat.hs

@@ -406,6 +406,7 @@ processChatCommand = \case
           withAgent (\a -> createUser a smp xftp)
     ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
     user <- withStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts
+    when (auId == 1) $ withStore (\db -> createContact db user simplexContactProfile) `catchChatError` \_ -> pure ()
     storeServers user smpServers
     storeServers user xftpServers
     atomically . writeTVar u $ Just user
@@ -1391,13 +1392,25 @@ processChatCommand = \case
   Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do
     plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
     unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan)
-    processChatCommand $ APIConnect userId incognito aCReqUri
+    case plan of
+      CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
+        processChatCommand $ APIConnectContactViaAddress userId incognito contactId
+      _ -> processChatCommand $ APIConnect userId incognito aCReqUri
   Connect _ Nothing -> throwChatError CEInvalidConnReq
+  APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do
+    ct@Contact {activeConn, profile = LocalProfile {contactLink}} <- withStore $ \db -> getContact db user contactId
+    when (isJust activeConn) $ throwChatError (CECommandError "contact already has connection")
+    case contactLink of
+      Just cReq -> connectContactViaAddress user incognito ct cReq
+      Nothing -> throwChatError (CECommandError "no address in contact profile")
   ConnectSimplex incognito -> withUser $ \user@User {userId} -> do
     let cReqUri = ACR SCMContact adminContactReq
     plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk)
     unless (connectionPlanProceed plan) $ throwChatError (CEConnectionPlan plan)
-    processChatCommand $ APIConnect userId incognito (Just cReqUri)
+    case plan of
+      CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
+        processChatCommand $ APIConnectContactViaAddress userId incognito contactId
+      _ -> processChatCommand $ APIConnect userId incognito (Just cReqUri)
   DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True
   ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
   APIListContacts userId -> withUserId userId $ \user ->
@@ -2022,15 +2035,27 @@ processChatCommand = \case
               connect' (Just gLinkId) cReqHash xContactId
       where
         connect' groupLinkId cReqHash xContactId = do
-          -- [incognito] generate profile to send
+          (connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId
-          incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
-          let profileToSend = userProfileToSend user incognitoProfile Nothing
-          dm <- directMessage (XContact profileToSend $ Just xContactId)
-          subMode <- chatReadVar subscriptionMode
-          connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode
           conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode
           toView $ CRNewContactConnection user conn
           pure $ CRSentInvitation user incognitoProfile
+    connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> m ChatResponse
+    connectContactViaAddress user incognito ct cReq =
+      withChatLock "connectViaContact" $ do
+        newXContactId <- XContactId <$> drgRandomBytes 16
+        (connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId
+        let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
+        ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode
+        pure $ CRSentInvitationToContact user ct' incognitoProfile
+    requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> m (ConnId, Maybe Profile, SubscriptionMode)
+    requestContact user incognito cReq xContactId = do
+      -- [incognito] generate profile to send
+      incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
+      let profileToSend = userProfileToSend user incognitoProfile Nothing
+      dm <- directMessage (XContact profileToSend $ Just xContactId)
+      subMode <- chatReadVar subscriptionMode
+      connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode
+      pure (connId, incognitoProfile, subMode)
     contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
     contactMember Contact {contactId} =
       find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
@@ -2283,9 +2308,12 @@ processChatCommand = \case
         Nothing ->
           withStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case
             Just _ -> pure $ CPContactAddress CAPOwnLink
-            Nothing -> do
+            Nothing ->
               withStore' (\db -> getContactConnEntityByConnReqHash db user cReqHashes) >>= \case
-                Nothing -> pure $ CPContactAddress CAPOk
+                Nothing ->
+                  withStore' (\db -> getContactWithoutConnViaAddress db user cReqSchemas) >>= \case
+                    Nothing -> pure $ CPContactAddress CAPOk
+                    Just ct -> pure $ CPContactAddress (CAPContactViaAddress ct)
                 Just (RcvDirectMsgConnection _conn Nothing) -> pure $ CPContactAddress CAPConnectingConfirmReconnect
                 Just (RcvDirectMsgConnection _ (Just ct))
                   | not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnectingProhibit ct)
@@ -5880,6 +5908,7 @@ chatCommandP =
       "/_set_file_to_receive " *> (SetFileToReceive <$> A.decimal <*> optional (" encrypt=" *> onOffP)),
       ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
       ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
+      "/_connect contact " *> (APIConnectContactViaAddress <$> A.decimal <*> incognitoOnOffP <* A.space <*> A.decimal),
       "/simplex" *> (ConnectSimplex <$> incognitoP),
       "/_address " *> (APICreateMyAddress <$> A.decimal),
       ("/address" <|> "/ad") $> CreateMyAddress,
@@ -6041,6 +6070,15 @@ adminContactReq :: ConnReqContact
 adminContactReq =
   either error id $ strDecode "simplex:/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D"
 
+simplexContactProfile :: Profile
+simplexContactProfile = Profile {
+  displayName = "SimpleX Chat team",
+  fullName = "",
+  image = Nothing,
+  contactLink = Just adminContactReq,
+  preferences = Nothing
+}
+
 timeItToView :: ChatMonad' m => String -> m a -> m a
 timeItToView s action = do
   t1 <- liftIO getCurrentTime

src/Simplex/Chat/Controller.hs

@@ -336,6 +336,7 @@ data ChatCommand
   | APIConnectPlan UserId AConnectionRequestUri
   | APIConnect UserId IncognitoEnabled (Maybe AConnectionRequestUri)
   | Connect IncognitoEnabled (Maybe AConnectionRequestUri)
+  | APIConnectContactViaAddress UserId IncognitoEnabled ContactId
   | ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
   | DeleteContact ContactName
   | ClearContact ContactName
@@ -489,6 +490,7 @@ data ChatResponse
   | CRConnectionPlan {user :: User, connectionPlan :: ConnectionPlan}
   | CRSentConfirmation {user :: User}
   | CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
+  | CRSentInvitationToContact {user :: User, contact :: Contact, customUserProfile :: Maybe Profile}
   | CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
   | CRGroupMemberUpdated {user :: User, groupInfo :: GroupInfo, fromMember :: GroupMember, toMember :: GroupMember}
   | CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact, updatedContact :: Contact}
@@ -653,6 +655,7 @@ data ContactAddressPlan
   | CAPConnectingConfirmReconnect
   | CAPConnectingProhibit {contact :: Contact}
   | CAPKnown {contact :: Contact}
+  | CAPContactViaAddress {contact :: Contact}
   deriving (Show, Generic)
 
 instance ToJSON ContactAddressPlan where
@@ -681,6 +684,7 @@ connectionPlanProceed = \case
     CAPOk -> True
     CAPOwnLink -> True
     CAPConnectingConfirmReconnect -> True
+    CAPContactViaAddress _ -> True
     _ -> False
   CPGroupLink glp -> case glp of
     GLPOk -> True

src/Simplex/Chat/Migrations/M20231107_indexes.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20231107_indexes where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20231107_indexes :: Query
+m20231107_indexes =
+  [sql|
+CREATE INDEX idx_contact_profiles_contact_link ON contact_profiles(user_id, contact_link);
+|]
+
+down_m20231107_indexes :: Query
+down_m20231107_indexes =
+  [sql|
+DROP INDEX idx_contact_profiles_contact_link;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -748,3 +748,7 @@ CREATE INDEX idx_connections_via_contact_uri_hash ON connections(
   user_id,
   via_contact_uri_hash
 );
+CREATE INDEX idx_contact_profiles_contact_link ON contact_profiles(
+  user_id,
+  contact_link
+);

src/Simplex/Chat/Store/Direct.hs

@@ -23,6 +23,7 @@ module Simplex.Chat.Store.Direct
     createDirectConnection,
     createIncognitoProfile,
     createConnReqConnection,
+    createAddressContactConnection,
     getProfileById,
     getConnReqContactXContactId,
     getContactByConnReqHash,
@@ -119,6 +120,12 @@ deletePendingContactConnection db userId connId =
     |]
     (userId, connId, ConnContact)
 
+createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> ExceptT StoreError IO Contact
+createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode = do
+  PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode
+  liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId)
+  getContact db user contactId
+
 createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> IO PendingContactConnection
 createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode = do
   createdAt <- getCurrentTime
@@ -195,12 +202,13 @@ createIncognitoProfile db User {userId} p = do
 
 createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
 createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
-  createdAt <- liftIO getCurrentTime
+  currentTs <- liftIO getCurrentTime
-  (localDisplayName, contactId, profileId) <- createContact_ db userId connId p localAlias Nothing createdAt (Just createdAt)
+  (localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs (Just currentTs)
+  liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
   let profile = toLocalProfile profileId p localAlias
       userPreferences = emptyChatPrefs
       mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
-  pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
+  pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False}
 
 deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
 deleteContactConnectionsAndFiles db userId Contact {contactId} = do
@@ -678,17 +686,20 @@ getContact_ db user@User {userId} contactId deleted =
         LEFT JOIN connections c ON c.contact_id = ct.contact_id
         WHERE ct.user_id = ? AND ct.contact_id = ?
           AND ct.deleted = ?
-          AND c.connection_id = (
+          AND (
-            SELECT cc_connection_id FROM (
+            c.connection_id = (
-              SELECT
+              SELECT cc_connection_id FROM (
-                cc.connection_id AS cc_connection_id,
+                SELECT
-                cc.created_at AS cc_created_at,
+                  cc.connection_id AS cc_connection_id,
-                (CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
+                  cc.created_at AS cc_created_at,
-              FROM connections cc
+                  (CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
-              WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
+                FROM connections cc
-              ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
+                WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
-              LIMIT 1
+                ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
+                LIMIT 1
+              )
             )
+            OR c.connection_id IS NULL
           )
       |]
       (userId, contactId, deleted, ConnReady, ConnSndReady)

src/Simplex/Chat/Store/Groups.hs

@@ -1054,7 +1054,8 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
     Just (directCmdId, directAgentConnId) -> do
       Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
       liftIO $ setCommandConnId db user directCmdId directConnId
-      (localDisplayName, contactId, memProfileId) <- createContact_ db userId directConnId memberProfile "" (Just groupId) currentTs Nothing
+      (localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs Nothing
+      liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
       pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Just contactId, memProfileId}
     Nothing -> do
       (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs

src/Simplex/Chat/Store/Migrations.hs

@@ -87,6 +87,7 @@ import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
 import Simplex.Chat.Migrations.M20231010_member_settings
 import Simplex.Chat.Migrations.M20231019_indexes
 import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
+import Simplex.Chat.Migrations.M20231107_indexes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -173,7 +174,8 @@ schemaMigrations =
     ("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash),
     ("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings),
     ("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes),
-    ("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received)
+    ("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received),
+    ("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Store/Profiles.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -43,6 +44,7 @@ module Simplex.Chat.Store.Profiles
     getUserAddress,
     getUserContactLinkById,
     getUserContactLinkByConnReq,
+    getContactWithoutConnViaAddress,
     updateUserAddressAutoAccept,
     getProtocolServers,
     overwriteProtocolServers,
@@ -87,7 +89,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (safeDecodeUtf8)
+import Simplex.Messaging.Util (safeDecodeUtf8, eitherToMaybe)
 
 createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User
 createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
@@ -453,6 +455,21 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
       |]
       (userId, cReqSchema1, cReqSchema2)
 
+getContactWithoutConnViaAddress :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
+getContactWithoutConnViaAddress db user@User {userId} (cReqSchema1, cReqSchema2) = do
+  ctId_ <- maybeFirstRow fromOnly $
+    DB.query
+      db
+      [sql|
+        SELECT ct.contact_id
+        FROM contacts ct
+        JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
+        LEFT JOIN connections c ON c.contact_id = ct.contact_id
+        WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
+      |]
+      (userId, cReqSchema1, cReqSchema2)
+  maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) ctId_
+
 updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
 updateUserAddressAutoAccept db user@User {userId} autoAccept = do
   link <- getUserAddress db user

src/Simplex/Chat/Store/Shared.hs

@@ -218,8 +218,13 @@ setCommandConnId db User {userId} cmdId connId = do
     |]
     (connId, updatedAt, userId, cmdId)
 
-createContact_ :: DB.Connection -> UserId -> Int64 -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> Maybe UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
+createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
-createContact_ db userId connId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs chatTs =
+createContact db User {userId} profile = do
+  currentTs <- liftIO getCurrentTime
+  void $ createContact_ db userId profile "" Nothing currentTs Nothing
+
+createContact_ :: DB.Connection -> UserId -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> Maybe UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
+createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs chatTs =
   ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
     DB.execute
       db
@@ -231,7 +236,6 @@ createContact_ db userId connId Profile {displayName, fullName, image, contactLi
       "INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)"
       (profileId, ldn, userId, viaGroup, currentTs, currentTs, chatTs)
     contactId <- insertedRowId db
-    DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
     pure $ Right (ldn, contactId, profileId)
 
 deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO ()

src/Simplex/Chat/View.hs

@@ -153,6 +153,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRConnectionPlan u connectionPlan -> ttyUser u $ viewConnectionPlan connectionPlan
   CRSentConfirmation u -> ttyUser u ["confirmation sent!"]
   CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
+  CRSentInvitationToContact u _c customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView
   CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"]
   CRContactDeletedByContact u c -> ttyUser u [ttyFullContact c <> " deleted contact with you"]
   CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo
@@ -1309,6 +1310,7 @@ viewConnectionPlan = \case
       [ ctAddr ("known contact " <> ttyContact' ct),
         "use " <> ttyToContact' ct <> highlight' "<message>" <> " to send messages"
       ]
+    CAPContactViaAddress ct -> [ctAddr ("known contact without connection " <> ttyContact' ct)]
     where
       ctAddr = ("contact address: " <>)
   CPGroupLink glp -> case glp of

tests/ChatTests/Profiles.hs

@@ -7,10 +7,16 @@ import ChatClient
 import ChatTests.Utils
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (concurrently_)
+import Control.Monad.Except
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
 import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), Profile (..))
 import System.Directory (copyFile, createDirectoryIfMissing)
 import Test.Hspec
+import Simplex.Chat.Store.Shared (createContact)
+import Control.Monad
+import Simplex.Messaging.Encoding.String (StrEncoding(..))
 
 chatProfileTests :: SpecWith FilePath
 chatProfileTests = do
@@ -33,6 +39,7 @@ chatProfileTests = do
     it "own contact address" testPlanAddressOwn
     it "connecting via contact address" testPlanAddressConnecting
     it "re-connect with deleted contact" testPlanAddressContactDeletedReconnected
+    it "contact via address" testPlanAddressContactViaAddress
   describe "incognito" $ do
     it "connect incognito via invitation link" testConnectIncognitoInvitationLink
     it "connect incognito via contact address" testConnectIncognitoContactAddress
@@ -755,6 +762,60 @@ testPlanAddressContactDeletedReconnected =
       bob <## "contact address: known contact alice_1"
       bob <## "use @alice_1 <message> to send messages"
 
+testPlanAddressContactViaAddress :: HasCallStack => FilePath -> IO ()
+testPlanAddressContactViaAddress =
+  testChat2 aliceProfile bobProfile $
+    \alice bob -> do
+      alice ##> "/ad"
+      cLink <- getContactLink alice True
+
+      alice ##> "/pa on" -- not necessary, without it bob would receive profile update removing contact link
+      alice <## "new contact address set"
+
+      case A.parseOnly strP (B.pack cLink) of
+        Left _ -> error "error parsing contact link"
+        Right cReq -> do
+          let profile = aliceProfile {contactLink = Just cReq}
+          void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
+          bob @@@ [("@alice", "")]
+
+          bob ##> ("/_connect plan 1 " <> cLink)
+          bob <## "contact address: known contact without connection alice"
+
+          let cLinkSchema2 = linkAnotherSchema cLink
+          bob ##> ("/_connect plan 1 " <> cLinkSchema2)
+          bob <## "contact address: known contact without connection alice"
+
+          -- terminal api
+          bob ##> ("/c " <> cLink)
+          connecting alice bob
+
+          bob ##> "/_delete @2 notify=off"
+          bob <## "alice: contact is deleted"
+          alice ##> "/_delete @2 notify=off"
+          alice <## "bob: contact is deleted"
+
+          void $ withCCUser bob $ \user -> withCCTransaction bob $ \db -> runExceptT $ createContact db user profile
+          bob @@@ [("@alice", "")]
+
+          -- GUI api
+          bob ##> "/_connect contact 1 2"
+          connecting alice bob
+  where
+    connecting alice bob = do
+      bob <## "connection request sent!"
+      alice <## "bob (Bob) wants to connect to you!"
+      alice <## "to accept: /ac bob"
+      alice <## "to reject: /rc bob (the sender will NOT be notified)"
+      alice ##> "/ac bob"
+      alice <## "bob (Bob): accepting contact request..."
+      concurrently_
+        (bob <## "alice (Alice): contact is connected")
+        (alice <## "bob (Bob): contact is connected")
+
+      alice <##> bob
+      bob @@@ [("@alice", "hey")]
+
 testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
 testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
   \alice bob cath -> do

tests/ChatTests/Utils.hs

@@ -435,6 +435,17 @@ getContactProfiles cc = do
       profiles <- withTransaction (chatStore $ chatController cc) $ \db -> getUserContactProfiles db user
       pure $ map (\Profile {displayName} -> displayName) profiles
 
+withCCUser :: TestCC -> (User -> IO a) -> IO a
+withCCUser cc action = do
+  user_ <- readTVarIO (currentUser $ chatController cc)
+  case user_ of
+    Nothing -> error "no user"
+    Just user -> action user
+
+withCCTransaction :: TestCC -> (DB.Connection -> IO a) -> IO a
+withCCTransaction cc action =
+  withTransaction (chatStore $ chatController cc) $ \db -> action db
+
 getProfilePictureByName :: TestCC -> String -> IO (Maybe String)
 getProfilePictureByName cc displayName =
   withTransaction (chatStore $ chatController cc) $ \db ->