core: use acceptContactAsync on auto-accept, reuse incognito profile for contacts accepted via group link (#1208)

* update simplexmq (acceptContactAsync)

* acceptContactRequestAsync, single profile

* refactor

* refactor 2

* refactor

* Update src/Simplex/Chat/Store.hs

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

* refactor

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

cabal.project

@@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 10e0e58ec3a7c97b5503a49440be08487111960d
+    tag: f97c1a771299e7e6b1e5af77db0ada007d6aa568
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."10e0e58ec3a7c97b5503a49440be08487111960d" = "1l31xagcazyp34pc0qqd53fjghkx5bkxmfsw45gvfxmj961xj32m";
+  "https://github.com/simplex-chat/simplexmq.git"."f97c1a771299e7e6b1e5af77db0ada007d6aa568" = "1p45yp10az0hpqlg4zf4sba2ryqxhhic3zr5bylzqkxzhsy44zg4";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0";
   "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";

src/Simplex/Chat.hs

@@ -525,7 +525,7 @@ processChatCommand = \case
     cReq <- withStore $ \db -> getContactRequest db userId connReqId
     -- [incognito] generate profile to send, create connection with incognito profile
     incognito <- readTVarIO =<< asks incognitoMode
-    incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
+    incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
     ct <- acceptContactRequest user cReq incognitoProfile
     pure $ CRAcceptingContactRequest ct
   APIRejectContact connReqId -> withUser $ \User {userId} -> withChatLock $ do
@@ -1297,12 +1297,26 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F
                   f = filePath `combine` (name <> suffix <> ext)
                in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
 
-acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe Profile -> m Contact
+acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
-acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
+acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
-  let profileToSend = fromMaybe (fromLocalProfile profile) incognitoProfile
+  let profileToSend = profileToSendOnAccept user incognitoProfile
-  -- TODO acceptContactAsync
+  acId <- withAgent $ \a -> acceptContact a True invId . directMessage $ XInfo profileToSend
-  connId <- withAgent $ \a -> acceptContact a True invId . directMessage $ XInfo profileToSend
+  withStore' $ \db -> createAcceptedContact db userId acId cName profileId p userContactLinkId xContactId incognitoProfile
-  withStore' $ \db -> createAcceptedContact db userId connId cName profileId p userContactLinkId xContactId incognitoProfile
+
+acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
+acceptContactRequestAsync user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
+  let profileToSend = profileToSendOnAccept user incognitoProfile
+  (cmdId, acId) <- agentAcceptContactAsync user True invId $ XInfo profileToSend
+  withStore' $ \db -> do
+    ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db userId acId cName profileId p userContactLinkId xContactId incognitoProfile
+    setCommandConnId db user cmdId connId
+    pure ct
+
+profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Profile
+profileToSendOnAccept User {profile} = \case
+  Just (NewIncognito p) -> p
+  Just (ExistingIncognito lp) -> fromLocalProfile lp
+  Nothing -> fromLocalProfile profile
 
 deleteGroupLink' :: ChatMonad m => User -> GroupInfo -> m ()
 deleteGroupLink' user gInfo = do
@@ -1913,13 +1927,13 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
                         -- [incognito] generate profile to send, create connection with incognito profile
                         -- TODO allow to configure incognito setting on auto accept instead of checking incognito mode
                         incognito <- readTVarIO =<< asks incognitoMode
-                        incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
+                        incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
-                        ct <- acceptContactRequest user cReq incognitoProfile
+                        ct <- acceptContactRequestAsync user cReq incognitoProfile
                         toView $ CRAcceptingContactRequest ct
                       Just groupId -> do
-                        gInfo@GroupInfo {membership} <- withStore $ \db -> getGroupInfo db user groupId
+                        gInfo@GroupInfo {membership = membership@GroupMember {memberProfile}} <- withStore $ \db -> getGroupInfo db user groupId
-                        let incognitoProfile = if memberIncognito membership then Just . fromLocalProfile $ memberProfile membership else Nothing
+                        let profileMode = if memberIncognito membership then Just $ ExistingIncognito memberProfile else Nothing
-                        ct <- acceptContactRequest user cReq incognitoProfile
+                        ct <- acceptContactRequestAsync user cReq profileMode
                         toView $ CRAcceptingGroupJoinRequest gInfo ct
                     else do
                       toView $ CRReceivedContactRequest cReq
@@ -2761,6 +2775,12 @@ allowAgentConnectionAsync user conn@Connection {connId} confId msg = do
   withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId $ directMessage msg
   withStore' $ \db -> updateConnectionStatus db conn ConnAccepted
 
+agentAcceptContactAsync :: ChatMonad m => User -> Bool -> InvitationId -> ChatMsgEvent -> m (CommandId, ConnId)
+agentAcceptContactAsync user enableNtfs invId msg = do
+  cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact
+  connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId $ directMessage msg
+  pure (cmdId, connId)
+
 deleteAgentConnectionAsync :: ChatMonad m => User -> Connection -> m ()
 deleteAgentConnectionAsync user Connection {agentConnId, connId} =
   deleteAgentConnectionAsync' user connId agentConnId

src/Simplex/Chat/Store.hs

@@ -390,7 +390,7 @@ setActiveUser db userId = do
 createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> IO PendingContactConnection
 createConnReqConnection db userId acId cReqHash xContactId incognitoProfile = do
   createdAt <- getCurrentTime
-  customUserProfileId <- createIncognitoProfile_ db userId createdAt incognitoProfile
+  customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
   let pccConnStatus = ConnJoined
   DB.execute
     db
@@ -441,7 +441,7 @@ getConnReqContactXContactId db userId cReqHash = do
 createDirectConnection :: DB.Connection -> UserId -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> IO PendingContactConnection
 createDirectConnection db userId acId cReq pccConnStatus incognitoProfile = do
   createdAt <- getCurrentTime
-  customUserProfileId <- createIncognitoProfile_ db userId createdAt incognitoProfile
+  customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
   DB.execute
     db
     [sql|
@@ -452,17 +452,16 @@ createDirectConnection db userId acId cReq pccConnStatus incognitoProfile = do
   pccConnId <- insertedRowId db
   pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt}
 
-createIncognitoProfile_ :: DB.Connection -> UserId -> UTCTime -> Maybe Profile -> IO (Maybe Int64)
+createIncognitoProfile_ :: DB.Connection -> UserId -> UTCTime -> Profile -> IO Int64
-createIncognitoProfile_ db userId createdAt incognitoProfile =
+createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, image} = do
-  forM incognitoProfile $ \Profile {displayName, fullName, image} -> do
+  DB.execute
-    DB.execute
+    db
-      db
+    [sql|
-      [sql|
+      INSERT INTO contact_profiles (display_name, full_name, image, user_id, incognito, created_at, updated_at)
-        INSERT INTO contact_profiles (display_name, full_name, image, user_id, incognito, created_at, updated_at)
+      VALUES (?,?,?,?,?,?,?)
-        VALUES (?,?,?,?,?,?,?)
+    |]
-      |]
+    (displayName, fullName, image, userId, Just True, createdAt, createdAt)
-      (displayName, fullName, image, userId, Just True, createdAt, createdAt)
+  insertedRowId db
-    insertedRowId db
 
 getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
 getProfileById db userId profileId =
@@ -1033,11 +1032,13 @@ deleteContactRequest db userId contactRequestId = do
     (userId, userId, contactRequestId)
   DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
 
-createAcceptedContact :: DB.Connection -> UserId -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe Profile -> IO Contact
+createAcceptedContact :: DB.Connection -> UserId -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact
 createAcceptedContact db userId agentConnId localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do
   DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
   createdAt <- getCurrentTime
-  customUserProfileId <- createIncognitoProfile_ db userId createdAt incognitoProfile
+  customUserProfileId <- forM incognitoProfile $ \case
+    NewIncognito p -> createIncognitoProfile_ db userId createdAt p
+    ExistingIncognito LocalProfile {profileId = pId} -> pure pId
   DB.execute
     db
     "INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, created_at, updated_at, xcontact_id) VALUES (?,?,?,?,?,?,?)"

src/Simplex/Chat/Types.hs

@@ -241,6 +241,8 @@ instance ToJSON Profile where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
+data IncognitoProfile = NewIncognito Profile | ExistingIncognito LocalProfile
+
 type LocalAlias = Text
 
 data LocalProfile = LocalProfile
@@ -966,6 +968,7 @@ data CommandFunction
   = CFCreateConn
   | CFJoinConn
   | CFAllowConn
+  | CFAcceptContact
   | CFAckMessage
   | CFDeleteConn
   deriving (Eq, Show, Generic)
@@ -979,6 +982,7 @@ instance TextEncoding CommandFunction where
     "create_conn" -> Just CFCreateConn
     "join_conn" -> Just CFJoinConn
     "allow_conn" -> Just CFAllowConn
+    "accept_contact" -> Just CFAcceptContact
     "ack_message" -> Just CFAckMessage
     "delete_conn" -> Just CFDeleteConn
     _ -> Nothing
@@ -986,6 +990,7 @@ instance TextEncoding CommandFunction where
     CFCreateConn -> "create_conn"
     CFJoinConn -> "join_conn"
     CFAllowConn -> "allow_conn"
+    CFAcceptContact -> "accept_contact"
     CFAckMessage -> "ack_message"
     CFDeleteConn -> "delete_conn"
 
@@ -994,6 +999,7 @@ commandExpectedResponse = \case
   CFCreateConn -> INV_
   CFJoinConn -> OK_
   CFAllowConn -> OK_
+  CFAcceptContact -> OK_
   CFAckMessage -> OK_
   CFDeleteConn -> OK_
 

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 10e0e58ec3a7c97b5503a49440be08487111960d
+    commit: f97c1a771299e7e6b1e5af77db0ada007d6aa568
   # - ../direct-sqlcipher
   - github: simplex-chat/direct-sqlcipher
     commit: 34309410eb2069b029b8fc1872deb1e0db123294