Permanent user addresses (aka contact links) (#139)

* update for ConectionMode parameters

* update with CONF notification and different ConnectionRequest types

* high level flow for contact requests, add x.con to chat protocol

* store functions for user contact links and contact requests

* contact links work

* subscribe to user contact link connection

* subscribe to user contact address: messages

* send rejectContact to the agents when rejected in chat

* user contact link (address) test

* Update src/Simplex/Chat/View.hs

* Update tests/ChatTests.hs

* user address help, fix tests

* delete connection requests when contact link deleted

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>

migrations/20211205_user_contacts.sql

@@ -0,0 +1,29 @@
+CREATE TABLE user_contact_links (
+  user_contact_link_id INTEGER PRIMARY KEY,
+  conn_req_contact BLOB NOT NULL,
+  local_display_name TEXT NOT NULL DEFAULT '',
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  user_id INTEGER NOT NULL REFERENCES users,
+  UNIQUE (user_id, local_display_name)
+);
+
+CREATE TABLE contact_requests (
+  contact_request_id INTEGER PRIMARY KEY,
+  user_contact_link_id INTEGER NOT NULL REFERENCES user_contact_links
+    ON UPDATE CASCADE ON DELETE CASCADE,
+  agent_invitation_id  BLOB NOT NULL,
+  contact_profile_id INTEGER REFERENCES contact_profiles
+    DEFERRABLE INITIALLY DEFERRED, -- NULL if it's an incognito profile
+  local_display_name TEXT NOT NULL,
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  user_id INTEGER NOT NULL REFERENCES users,
+  FOREIGN KEY (user_id, local_display_name)
+    REFERENCES display_names (user_id, local_display_name)
+    ON UPDATE CASCADE
+    DEFERRABLE INITIALLY DEFERRED,
+  UNIQUE (user_id, local_display_name),
+  UNIQUE (user_id, contact_profile_id)
+);
+
+ALTER TABLE connections ADD user_contact_link_id INTEGER
+REFERENCES user_contact_links ON DELETE RESTRICT;

src/Simplex/Chat.hs

@@ -67,10 +67,16 @@ data ChatCommand
   = ChatHelp
   | FilesHelp
   | GroupsHelp
+  | MyAddressHelp
   | MarkdownHelp
   | AddContact
-  | Connect ConnectionRequest
+  | Connect AConnectionRequest
   | DeleteContact ContactName
+  | CreateMyAddress
+  | DeleteMyAddress
+  | ShowMyAddress
+  | AcceptContact ContactName
+  | RejectContact ContactName
   | SendMessage ContactName ByteString
   | NewGroup GroupProfile
   | AddMember GroupName ContactName GroupMemberRole
@@ -176,13 +182,17 @@ processChatCommand user@User {userId, profile} = \case
   ChatHelp -> printToView chatHelpInfo
   FilesHelp -> printToView filesHelpInfo
   GroupsHelp -> printToView groupsHelpInfo
+  MyAddressHelp -> printToView myAddressHelpInfo
   MarkdownHelp -> printToView markdownInfo
   AddContact -> do
-    (connId, cReq) <- withAgent createConnection
+    (connId, cReq) <- withAgent (`createConnection` SCMInvitation)
     withStore $ \st -> createDirectConnection st userId connId
     showInvitation cReq
-  Connect cReq -> do
-    connId <- withAgent $ \a -> joinConnection a cReq . directMessage $ XInfo profile
+  Connect (ACR cMode cReq) -> do
+    let msg :: ChatMsgEvent = case cMode of
+          SCMInvitation -> XInfo profile
+          SCMContact -> XContact profile Nothing
+    connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg
     withStore $ \st -> createDirectConnection st userId connId
   DeleteContact cName ->
     withStore (\st -> getContactGroupNames st userId cName) >>= \case
@@ -194,6 +204,31 @@ processChatCommand user@User {userId, profile} = \case
         unsetActive $ ActiveC cName
         showContactDeleted cName
       gs -> showContactGroups cName gs
+  CreateMyAddress -> do
+    (connId, cReq) <- withAgent (`createConnection` SCMContact)
+    withStore $ \st -> createUserContactLink st userId connId cReq
+    showUserContactLinkCreated cReq
+  DeleteMyAddress -> do
+    conns <- withStore $ \st -> getUserContactLinkConnections st userId
+    withAgent $ \a -> forM_ conns $ \Connection {agentConnId} ->
+      deleteConnection a agentConnId `catchError` \(_ :: AgentErrorType) -> pure ()
+    withStore $ \st -> deleteUserContactLink st userId
+    showUserContactLinkDeleted
+  ShowMyAddress -> do
+    cReq <- withStore $ \st -> getUserContactLink st userId
+    showUserContactLink cReq
+  AcceptContact cName -> do
+    UserContactRequest {agentInvitationId, profileId} <- withStore $ \st ->
+      getContactRequest st userId cName
+    connId <- withAgent $ \a -> acceptContact a agentInvitationId . directMessage $ XInfo profile
+    withStore $ \st -> createAcceptedContact st userId connId cName profileId
+    showAcceptingContactRequest cName
+  RejectContact cName -> do
+    UserContactRequest {agentContactConnId, agentInvitationId} <- withStore $ \st ->
+      getContactRequest st userId cName
+        `E.finally` deleteContactRequest st userId cName
+    withAgent $ \a -> rejectContact a agentContactConnId agentInvitationId
+    showContactRequestRejected cName
   SendMessage cName msg -> do
     contact <- withStore $ \st -> getContact st userId cName
     let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
@@ -213,7 +248,7 @@ processChatCommand user@User {userId, profile} = \case
     unless (memberActive membership) $ chatError CEGroupMemberNotActive
     when (isJust $ contactMember contact members) $ chatError (CEGroupDuplicateMember cName)
     gVar <- asks idsDrg
-    (agentConnId, cReq) <- withAgent createConnection
+    (agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
     GroupMember {memberId} <- withStore $ \st -> createContactGroupMember st gVar user groupId contact memRole agentConnId
     let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
     sendDirectMessage (contactConnId contact) msg
@@ -269,7 +304,7 @@ processChatCommand user@User {userId, profile} = \case
   SendFile cName f -> do
     (fileSize, chSize) <- checkSndFile f
     contact <- withStore $ \st -> getContact st userId cName
-    (agentConnId, fileConnReq) <- withAgent createConnection
+    (agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
     let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq}
     SndFileTransfer {fileId} <- withStore $ \st ->
       createSndFileTransfer st userId contact f fileInv agentConnId chSize
@@ -282,7 +317,7 @@ processChatCommand user@User {userId, profile} = \case
     unless (memberActive membership) $ chatError CEGroupMemberUserRemoved
     let fileName = takeFileName f
     ms <- forM (filter memberActive members) $ \m -> do
-      (connId, fileConnReq) <- withAgent createConnection
+      (connId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
       pure (m, connId, FileInvitation {fileName, fileSize, fileConnReq})
     fileId <- withStore $ \st -> createSndGroupFileTransfer st userId group ms f fileSize chSize
     forM_ ms $ \(m, _, fileInv) ->
@@ -378,6 +413,7 @@ subscribeUserConnections = void . runExceptT $ do
   subscribeGroups user
   subscribeFiles user
   subscribePendingConnections user
+  subscribeUserContactLink user
   where
     subscribeContacts user = do
       contacts <- withStore (`getUserContacts` user)
@@ -418,10 +454,17 @@ subscribeUserConnections = void . runExceptT $ do
             resume RcvFileInfo {agentConnId} =
               subscribe agentConnId `catchError` showRcvFileSubError ft
     subscribePendingConnections user = do
-      connections <- withStore (`getPendingConnections` user)
-      forM_ connections $ \Connection {agentConnId} ->
-        subscribe agentConnId `catchError` \_ -> pure ()
+      cs <- withStore (`getPendingConnections` user)
+      subscribeConns cs `catchError` \_ -> pure ()
+    subscribeUserContactLink User {userId} = do
+      cs <- withStore (`getUserContactLinkConnections` userId)
+      (subscribeConns cs >> showUserContactLinkSubscribed)
+        `catchError` showUserContactLinkSubError
     subscribe cId = withAgent (`subscribeConnection` cId)
+    subscribeConns conns =
+      withAgent $ \a ->
+        forM_ conns $ \Connection {agentConnId} ->
+          subscribeConnection a agentConnId
 
 processAgentMessage :: forall m. ChatMonad m => User -> ConnId -> ACommand 'Agent -> m ()
 processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
@@ -437,6 +480,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
       processRcvFileConn agentMessage conn ft
     SndFileConnection conn ft ->
       processSndFileConn agentMessage conn ft
+    UserContactConnection conn uc ->
+      processUserContactRequest agentMessage conn uc
   where
     isMember :: MemberId -> Group -> Bool
     isMember memId Group {membership, members} =
@@ -450,7 +495,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
 
     agentMsgConnStatus :: ACommand 'Agent -> Maybe ConnStatus
     agentMsgConnStatus = \case
-      REQ _ _ -> Just ConnRequested
+      CONF {} -> Just ConnRequested
       INFO _ -> Just ConnSndReady
       CON -> Just ConnReady
       _ -> Nothing
@@ -458,9 +503,9 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     processDirectMessage :: ACommand 'Agent -> Connection -> Maybe Contact -> m ()
     processDirectMessage agentMsg conn = \case
       Nothing -> case agentMsg of
-        REQ confId connInfo -> do
+        CONF confId connInfo -> do
           saveConnInfo conn connInfo
-          acceptAgentConnection conn confId $ XInfo profile
+          allowAgentConnection conn confId $ XInfo profile
         INFO connInfo ->
           saveConnInfo conn connInfo
         MSG meta _ ->
@@ -478,15 +523,15 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
             XInfoProbeCheck probeHash -> xInfoProbeCheck ct probeHash
             XInfoProbeOk probe -> xInfoProbeOk ct probe
             _ -> pure ()
-        REQ confId connInfo -> do
+        CONF confId connInfo -> do
           -- confirming direct connection with a member
           ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
           case chatMsgEvent of
             XGrpMemInfo _memId _memProfile -> do
               -- TODO check member ID
               -- TODO update member profile
-              acceptAgentConnection conn confId XOk
-            _ -> messageError "REQ from member must have x.grp.mem.info"
+              allowAgentConnection conn confId XOk
+            _ -> messageError "CONF from member must have x.grp.mem.info"
         INFO connInfo -> do
           ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
           case chatMsgEvent of
@@ -494,8 +539,11 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
               -- TODO check member ID
               -- TODO update member profile
               pure ()
+            XInfo _profile -> do
+              -- TODO update contact profile
+              pure ()
             XOk -> pure ()
-            _ -> messageError "INFO from member must have x.grp.mem.info or x.ok"
+            _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok"
         CON ->
           withStore (\st -> getViaGroupMember st user ct) >>= \case
             Nothing -> do
@@ -521,7 +569,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
 
     processGroupMessage :: ACommand 'Agent -> Connection -> GroupName -> GroupMember -> m ()
     processGroupMessage agentMsg conn gName m = case agentMsg of
-      REQ confId connInfo -> do
+      CONF confId connInfo -> do
         ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
         case memberCategory m of
           GCInviteeMember ->
@@ -529,18 +577,18 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
               XGrpAcpt memId
                 | memId == memberId m -> do
                   withStore $ \st -> updateGroupMemberStatus st userId m GSMemAccepted
-                  acceptAgentConnection conn confId XOk
+                  allowAgentConnection conn confId XOk
                 | otherwise -> messageError "x.grp.acpt: memberId is different from expected"
-              _ -> messageError "REQ from invited member must have x.grp.acpt"
+              _ -> messageError "CONF from invited member must have x.grp.acpt"
           _ ->
             case chatMsgEvent of
               XGrpMemInfo memId _memProfile
                 | memId == memberId m -> do
                   -- TODO update member profile
                   Group {membership} <- withStore $ \st -> getGroup st user gName
-                  acceptAgentConnection conn confId $ XGrpMemInfo (memberId membership) profile
+                  allowAgentConnection conn confId $ XGrpMemInfo (memberId membership) profile
                 | otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
-              _ -> messageError "REQ from member must have x.grp.mem.info"
+              _ -> messageError "CONF from member must have x.grp.mem.info"
       INFO connInfo -> do
         ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
         case chatMsgEvent of
@@ -603,15 +651,15 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
     processSndFileConn :: ACommand 'Agent -> Connection -> SndFileTransfer -> m ()
     processSndFileConn agentMsg conn ft@SndFileTransfer {fileId, fileName, fileStatus} =
       case agentMsg of
-        REQ confId connInfo -> do
+        CONF confId connInfo -> do
           ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
           case chatMsgEvent of
             XFileAcpt name
               | name == fileName -> do
                 withStore $ \st -> updateSndFileStatus st ft FSAccepted
-                acceptAgentConnection conn confId XOk
+                allowAgentConnection conn confId XOk
               | otherwise -> messageError "x.file.acpt: fileName is different from expected"
-            _ -> messageError "REQ from file connection must have x.file.acpt"
+            _ -> messageError "CONF from file connection must have x.file.acpt"
         CON -> do
           withStore $ \st -> updateSndFileStatus st ft FSConnected
           showSndFileStart ft
@@ -665,6 +713,22 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
                 RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
         _ -> pure ()
 
+    processUserContactRequest :: ACommand 'Agent -> Connection -> UserContact -> m ()
+    processUserContactRequest agentMsg _conn UserContact {userContactLinkId} = case agentMsg of
+      REQ invId connInfo -> do
+        ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
+        case chatMsgEvent of
+          XContact p _ -> profileContactRequest invId p
+          XInfo p -> profileContactRequest invId p
+          -- TODO show/log error, other events in contact request
+          _ -> pure ()
+      _ -> pure ()
+      where
+        profileContactRequest :: InvitationId -> Profile -> m ()
+        profileContactRequest invId p = do
+          cName <- withStore $ \st -> createContactRequest st userId userContactLinkId invId p
+          showReceivedContactRequest cName p
+
     withAckMessage :: ConnId -> MsgMeta -> m () -> m ()
     withAckMessage cId MsgMeta {recipient = (msgId, _)} action =
       action `E.finally` withAgent (\a -> ackMessage a cId msgId `catchError` \_ -> pure ())
@@ -803,8 +867,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
           if isMember memId group
             then messageWarning "x.grp.mem.intro ignored: member already exists"
             else do
-              (groupConnId, groupConnReq) <- withAgent createConnection
-              (directConnId, directConnReq) <- withAgent createConnection
+              (groupConnId, groupConnReq) <- withAgent (`createConnection` SCMInvitation)
+              (directConnId, directConnReq) <- withAgent (`createConnection` SCMInvitation)
               newMember <- withStore $ \st -> createIntroReMember st user group m memInfo groupConnId directConnId
               let msg = XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq}
               sendDirectMessage agentConnId msg
@@ -1000,9 +1064,9 @@ sendGroupMessage members chatMsgEvent = do
     forM_ (filter memberActive members) $
       traverse (\connId -> sendMessage a connId msg) . memberConnId
 
-acceptAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m ()
-acceptAgentConnection conn@Connection {agentConnId} confId msg = do
-  withAgent $ \a -> acceptConnection a agentConnId confId $ directMessage msg
+allowAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m ()
+allowAgentConnection conn@Connection {agentConnId} confId msg = do
+  withAgent $ \a -> allowConnection a agentConnId confId $ directMessage msg
   withStore $ \st -> updateConnectionStatus st conn ConnAccepted
 
 getCreateActiveUser :: SQLiteStore -> IO User
@@ -1090,6 +1154,7 @@ chatCommandP :: Parser ChatCommand
 chatCommandP =
   ("/help files" <|> "/help file" <|> "/hf") $> FilesHelp
     <|> ("/help groups" <|> "/help group" <|> "/hg") $> GroupsHelp
+    <|> ("/help address" <|> "/ha") $> MyAddressHelp
     <|> ("/help" <|> "/h") $> ChatHelp
     <|> ("/group #" <|> "/group " <|> "/g #" <|> "/g ") *> (NewGroup <$> groupProfile)
     <|> ("/add #" <|> "/add " <|> "/a #" <|> "/a ") *> (AddMember <$> displayName <* A.space <*> displayName <*> memberRole)
@@ -1108,10 +1173,15 @@ chatCommandP =
     <|> ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath))
     <|> ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal)
     <|> ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal)
+    <|> ("/address" <|> "/ad") $> CreateMyAddress
+    <|> ("/delete_address" <|> "/da") $> DeleteMyAddress
+    <|> ("/show_address" <|> "/sa") $> ShowMyAddress
+    <|> ("/accept @" <|> "/accept " <|> "/ac @" <|> "/ac ") *> (AcceptContact <$> displayName)
+    <|> ("/reject @" <|> "/reject " <|> "/rc @" <|> "/rc ") *> (RejectContact <$> displayName)
     <|> ("/markdown" <|> "/m") $> MarkdownHelp
     <|> ("/profile " <|> "/p ") *> (UpdateProfile <$> userProfile)
     <|> ("/profile" <|> "/p") $> ShowProfile
-    <|> ("/quit" <|> "/q") $> QuitChat
+    <|> ("/quit" <|> "/q" <|> "/exit") $> QuitChat
     <|> ("/version" <|> "/v") $> ShowVersion
   where
     displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' '))

src/Simplex/Chat/Help.hs

@@ -4,6 +4,7 @@ module Simplex.Chat.Help
   ( chatHelpInfo,
     filesHelpInfo,
     groupsHelpInfo,
+    myAddressHelpInfo,
     markdownInfo,
   )
 where
@@ -34,7 +35,7 @@ chatHelpInfo =
       "Follow these steps to set up a connection:",
       "",
       green "Step 1: " <> highlight "/connect" <> " - Alice adds a contact.",
-      indent <> "Alice should send the invitation printed by the /add command",
+      indent <> "Alice should send the one-time invitation printed by the /connect command",
       indent <> "to her contact, Bob, out-of-band, via any trusted channel.",
       "",
       green "Step 2: " <> highlight "/connect <invitation>" <> " - Bob accepts the invitation.",
@@ -45,23 +46,20 @@ chatHelpInfo =
       indent <> highlight "@bob Hello, Bob!" <> " - Alice messages Bob (assuming Bob has display name 'bob').",
       indent <> highlight "@alice Hey, Alice!" <> " - Bob replies to Alice.",
       "",
-      green "To send file:",
-      indent <> highlight "/file bob ./photo.jpg" <> " - Alice sends file to Bob",
-      indent <> "File commands: " <> highlight "/help files",
+      green "Send file: " <> highlight "/file bob ./photo.jpg" <> " (see /help files)",
       "",
-      green "To create group:",
-      indent <> highlight "/group team" <> " - create group #team",
-      indent <> "Group commands: " <> highlight "/help groups",
+      green "Create group: " <> highlight "/group team" <> " (see /help groups)",
+      "",
+      green "Create your address: " <> highlight "/address" <> " (see /help address)",
       "",
       green "Other commands:",
-      indent <> highlight "/profile         " <> " - show user profile",
-      indent <> highlight "/profile <name> [<full_name>]" <> " - update user profile",
+      indent <> highlight "/profile         " <> " - show / update user profile",
       indent <> highlight "/delete <contact>" <> " - delete contact and all messages with them",
       indent <> highlight "/markdown        " <> " - show supported markdown syntax",
       indent <> highlight "/version         " <> " - show SimpleX Chat version",
       indent <> highlight "/quit            " <> " - quit chat",
       "",
-      "The commands may be abbreviated to a single letter: " <> listHighlight ["/c", "/f", "/g", "/p", "/h"] <> ", etc."
+      "The commands may be abbreviated: " <> listHighlight ["/c", "/f", "/g", "/p", "/ad"] <> ", etc."
     ]
 
 filesHelpInfo :: [StyledString]
@@ -95,6 +93,22 @@ groupsHelpInfo =
       "The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms"]
     ]
 
+myAddressHelpInfo :: [StyledString]
+myAddressHelpInfo =
+  map
+    styleMarkdown
+    [ green "Your contact address commands:",
+      indent <> highlight "/address       " <> " - create your address",
+      indent <> highlight "/delete_address" <> " - delete your address (accepted contacts will remain connected)",
+      indent <> highlight "/show_address  " <> " - show your address",
+      indent <> highlight "/accept <name> " <> " - accept contact request",
+      indent <> highlight "/reject <name> " <> " - reject contact request",
+      "",
+      "Please note: you can receive spam contact requests, but it's safe to delete the address!",
+      "",
+      "The commands may be abbreviated: " <> listHighlight ["/ad", "/da", "/sa", "/ac", "/rc"]
+    ]
+
 markdownInfo :: [StyledString]
 markdownInfo =
   map

src/Simplex/Chat/Protocol.hs

@@ -11,7 +11,7 @@
 module Simplex.Chat.Protocol where
 
 import Control.Applicative (optional)
-import Control.Monad ((<=<))
+import Control.Monad ((<=<), (>=>))
 import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import Data.Attoparsec.ByteString.Char8 (Parser)
@@ -21,7 +21,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
-import Data.List (find)
+import Data.List (find, findIndex)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -38,6 +38,7 @@ data ChatDirection (p :: AParty) where
   SentGroupMessage :: GroupName -> ChatDirection 'Client
   SndFileConnection :: Connection -> SndFileTransfer -> ChatDirection 'Agent
   RcvFileConnection :: Connection -> RcvFileTransfer -> ChatDirection 'Agent
+  UserContactConnection :: Connection -> UserContact -> ChatDirection 'Agent
 
 deriving instance Eq (ChatDirection p)
 
@@ -49,12 +50,14 @@ fromConnection = \case
   ReceivedGroupMessage conn _ _ -> conn
   SndFileConnection conn _ -> conn
   RcvFileConnection conn _ -> conn
+  UserContactConnection conn _ -> conn
 
 data ChatMsgEvent
   = XMsgNew MsgContent
   | XFile FileInvitation
   | XFileAcpt String
   | XInfo Profile
+  | XContact Profile (Maybe MsgContent)
   | XGrpInv GroupInvitation
   | XGrpAcpt MemberId
   | XGrpMemNew MemberInfo
@@ -107,22 +110,30 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
   case (chatMsgEvent, chatMsgParams) of
     ("x.msg.new", mt : rawFiles) -> do
       t <- toMsgType mt
-      files <- mapM (toContentInfo <=< parseAll contentInfoP) rawFiles
+      files <- toFiles rawFiles
       chatMsg . XMsgNew $ MsgContent {messageType = t, files, content = body}
     ("x.file", [name, size, cReq]) -> do
       let fileName = T.unpack $ safeDecodeUtf8 name
       fileSize <- parseAll A.decimal size
-      fileConnReq <- parseAll connReqP cReq
+      fileConnReq <- parseAll connReqP' cReq
       chatMsg . XFile $ FileInvitation {fileName, fileSize, fileConnReq}
     ("x.file.acpt", [name]) ->
       chatMsg . XFileAcpt . T.unpack $ safeDecodeUtf8 name
     ("x.info", []) -> do
       profile <- getJSON body
       chatMsg $ XInfo profile
+    ("x.con", []) -> do
+      profile <- getJSON body
+      chatMsg $ XContact profile Nothing
+    ("x.con", mt : rawFiles) -> do
+      (profile, body') <- extractJSON body
+      t <- toMsgType mt
+      files <- toFiles rawFiles
+      chatMsg . XContact profile $ Just MsgContent {messageType = t, files, content = body'}
     ("x.grp.inv", [fromMemId, fromRole, memId, role, cReq]) -> do
       fromMem <- (,) <$> B64.decode fromMemId <*> toMemberRole fromRole
       invitedMem <- (,) <$> B64.decode memId <*> toMemberRole role
-      groupConnReq <- parseAll connReqP cReq
+      groupConnReq <- parseAll connReqP' cReq
       profile <- getJSON body
       chatMsg . XGrpInv $ GroupInvitation fromMem invitedMem groupConnReq profile
     ("x.grp.acpt", [memId]) ->
@@ -164,11 +175,18 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
     toMemberInfo :: ByteString -> ByteString -> [MsgContentBody] -> Either String MemberInfo
     toMemberInfo memId role body = MemberInfo <$> B64.decode memId <*> toMemberRole role <*> getJSON body
     toIntroInv :: ByteString -> ByteString -> Either String IntroInvitation
-    toIntroInv groupConnReq directConnReq = IntroInvitation <$> parseAll connReqP groupConnReq <*> parseAll connReqP directConnReq
+    toIntroInv groupConnReq directConnReq = IntroInvitation <$> parseAll connReqP' groupConnReq <*> parseAll connReqP' directConnReq
     toContentInfo :: (RawContentType, Int) -> Either String (ContentType, Int)
     toContentInfo (rawType, size) = (,size) <$> toContentType rawType
+    toFiles :: [ByteString] -> Either String [(ContentType, Int)]
+    toFiles = mapM $ toContentInfo <=< parseAll contentInfoP
     getJSON :: FromJSON a => [MsgContentBody] -> Either String a
     getJSON = J.eitherDecodeStrict' <=< getSimplexContentType XCJson
+    extractJSON :: FromJSON a => [MsgContentBody] -> Either String (a, [MsgContentBody])
+    extractJSON =
+      extractSimplexContentType XCJson >=> \(a, bs) -> do
+        j <- J.eitherDecodeStrict' a
+        pure (j, bs)
 
 isContentType :: ContentType -> MsgContentBody -> Bool
 isContentType t MsgContentBody {contentType = t'} = t == t'
@@ -181,28 +199,41 @@ getContentType t body = case find (isContentType t) body of
   Just MsgContentBody {contentData} -> Right contentData
   Nothing -> Left "no required content type"
 
+extractContentType :: ContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
+extractContentType t body = case findIndex (isContentType t) body of
+  Just i -> case splitAt i body of
+    (b, el : a) -> Right (contentData (el :: MsgContentBody), b ++ a)
+    (_, []) -> Left "no required content type" -- this can only happen if findIndex returns incorrect result
+  Nothing -> Left "no required content type"
+
 getSimplexContentType :: XContentType -> [MsgContentBody] -> Either String ByteString
 getSimplexContentType = getContentType . SimplexContentType
 
+extractSimplexContentType :: XContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
+extractSimplexContentType = extractContentType . SimplexContentType
+
 rawChatMessage :: ChatMessage -> RawChatMessage
 rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
   case chatMsgEvent of
     XMsgNew MsgContent {messageType = t, files, content} ->
-      let rawFiles = map (serializeContentInfo . rawContentInfo) files
-       in rawMsg "x.msg.new" (rawMsgType t : rawFiles) content
+      rawMsg "x.msg.new" (rawMsgType t : toRawFiles files) content
     XFile FileInvitation {fileName, fileSize, fileConnReq} ->
-      rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq fileConnReq] []
+      rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq' fileConnReq] []
     XFileAcpt fileName ->
       rawMsg "x.file.acpt" [encodeUtf8 $ T.pack fileName] []
     XInfo profile ->
       rawMsg "x.info" [] [jsonBody profile]
+    XContact profile Nothing ->
+      rawMsg "x.con" [] [jsonBody profile]
+    XContact profile (Just MsgContent {messageType = t, files, content}) ->
+      rawMsg "x.con" (rawMsgType t : toRawFiles files) (jsonBody profile : content)
     XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) cReq groupProfile) ->
       let params =
             [ B64.encode fromMemId,
               serializeMemberRole fromRole,
               B64.encode memId,
               serializeMemberRole role,
-              serializeConnReq cReq
+              serializeConnReq' cReq
             ]
        in rawMsg "x.grp.inv" params [jsonBody groupProfile]
     XGrpAcpt memId ->
@@ -213,14 +244,14 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
     XGrpMemIntro (MemberInfo memId role profile) ->
       rawMsg "x.grp.mem.intro" [B64.encode memId, serializeMemberRole role] [jsonBody profile]
     XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq} ->
-      let params = [B64.encode memId, serializeConnReq groupConnReq, serializeConnReq directConnReq]
+      let params = [B64.encode memId, serializeConnReq' groupConnReq, serializeConnReq' directConnReq]
        in rawMsg "x.grp.mem.inv" params []
     XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupConnReq, directConnReq} ->
       let params =
             [ B64.encode memId,
               serializeMemberRole role,
-              serializeConnReq groupConnReq,
-              serializeConnReq directConnReq
+              serializeConnReq' groupConnReq,
+              serializeConnReq' directConnReq
             ]
        in rawMsg "x.grp.mem.fwd" params [jsonBody profile]
     XGrpMemInfo memId profile ->
@@ -257,6 +288,8 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
     rawWithDAG body = map rawMsgBodyContent $ case chatDAG of
       Nothing -> body
       Just dag -> MsgContentBody {contentType = SimplexDAG, contentData = dag} : body
+    toRawFiles :: [(ContentType, Int)] -> [ByteString]
+    toRawFiles = map $ serializeContentInfo . rawContentInfo
 
 toMsgBodyContent :: RawMsgBodyContent -> Either String MsgContentBody
 toMsgBodyContent RawMsgBodyContent {contentType, contentData} = do

src/Simplex/Chat/Store.hs

@@ -28,6 +28,14 @@ module Simplex.Chat.Store
     updateUserProfile,
     updateContactProfile,
     getUserContacts,
+    createUserContactLink,
+    getUserContactLinkConnections,
+    deleteUserContactLink,
+    getUserContactLink,
+    createContactRequest,
+    getContactRequest,
+    deleteContactRequest,
+    createAcceptedContact,
     getLiveSndFileTransfers,
     getLiveRcvFileTransfers,
     getPendingSndChunks,
@@ -107,7 +115,7 @@ import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
-import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, ConnectionRequest)
+import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, InvitationId)
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 import qualified Simplex.Messaging.Crypto as C
@@ -180,20 +188,45 @@ setActiveUser st userId = do
 createDirectConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> m ()
 createDirectConnection st userId agentConnId =
   liftIO . withTransaction st $ \db ->
-    void $ createConnection_ db userId agentConnId Nothing 0
+    void $ createContactConnection_ db userId agentConnId Nothing 0
 
-createConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> IO Connection
-createConnection_ db userId agentConnId viaContact connLevel = do
+createContactConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> IO Connection
+createContactConnection_ db userId = createConnection_ db userId ConnContact Nothing
+
+-- field types coincidentally match, but the first element here is user ID and not connection ID as in ConnectionRow
+type InsertedConnectionRow = ConnectionRow
+
+createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
+createConnection_ db userId connType entityId agentConnId viaContact connLevel = do
   createdAt <- getCurrentTime
   DB.execute
     db
     [sql|
-      INSERT INTO connections
-        (user_id, agent_conn_id, conn_status, conn_type, via_contact, conn_level, created_at) VALUES (?,?,?,?,?,?,?);
+      INSERT INTO connections (
+        user_id, agent_conn_id, conn_level, via_contact, conn_status, conn_type,
+        contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
+      ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?);
     |]
-    (userId, agentConnId, ConnNew, ConnContact, viaContact, connLevel, createdAt)
+    (insertConnParams createdAt)
   connId <- insertedRowId db
-  pure Connection {connId, agentConnId, connType = ConnContact, entityId = Nothing, viaContact, connLevel, connStatus = ConnNew, createdAt}
+  pure Connection {connId, agentConnId, connType, entityId, viaContact, connLevel, connStatus = ConnNew, createdAt}
+  where
+    insertConnParams :: UTCTime -> InsertedConnectionRow
+    insertConnParams createdAt =
+      ( userId,
+        agentConnId,
+        connLevel,
+        viaContact,
+        ConnNew,
+        connType,
+        ent ConnContact,
+        ent ConnMember,
+        ent ConnSndFile,
+        ent ConnRcvFile,
+        ent ConnUserContact,
+        createdAt
+      )
+    ent ct = if connType == ct then entityId else Nothing
 
 createDirectContact :: StoreMonad m => SQLiteStore -> UserId -> Connection -> Profile -> m ()
 createDirectContact st userId Connection {connId} profile =
@@ -337,7 +370,7 @@ getContact_ db userId localDisplayName = do
           db
           [sql|
             SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
             FROM connections c
             WHERE c.user_id = :user_id AND c.contact_id == :contact_id
             ORDER BY c.connection_id DESC
@@ -359,6 +392,142 @@ getUserContacts st User {userId} =
     contactNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM contacts WHERE user_id = ?" (Only userId)
     rights <$> mapM (runExceptT . getContact_ db userId) contactNames
 
+createUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> ConnId -> ConnReqContact -> m ()
+createUserContactLink st userId agentConnId cReq =
+  liftIOEither . checkConstraint SEDuplicateContactLink . withTransaction st $ \db -> do
+    DB.execute db "INSERT INTO user_contact_links (user_id, conn_req_contact) VALUES (?, ?)" (userId, cReq)
+    userContactLinkId <- insertedRowId db
+    Right () <$ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing 0
+
+getUserContactLinkConnections :: StoreMonad m => SQLiteStore -> UserId -> m [Connection]
+getUserContactLinkConnections st userId =
+  liftIOEither . withTransaction st $ \db ->
+    connections
+      <$> DB.queryNamed
+        db
+        [sql|
+          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
+          FROM connections c
+          JOIN user_contact_links uc ON c.user_contact_link_id == uc.user_contact_link_id
+          WHERE c.user_id = :user_id
+            AND uc.user_id = :user_id
+            AND uc.local_display_name = ''
+        |]
+        [":user_id" := userId]
+  where
+    connections [] = Left SEUserContactLinkNotFound
+    connections rows = Right $ map toConnection rows
+
+deleteUserContactLink :: MonadUnliftIO m => SQLiteStore -> UserId -> m ()
+deleteUserContactLink st userId =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute
+      db
+      [sql|
+        DELETE FROM connections WHERE connection_id IN (
+          SELECT connection_id
+          FROM connections c
+          JOIN user_contact_links uc USING (user_contact_link_id)
+          WHERE uc.user_id = ? AND uc.local_display_name = ''
+        )
+      |]
+      (Only userId)
+    DB.executeNamed
+      db
+      [sql|
+        DELETE FROM display_names
+        WHERE user_id = :user_id
+          AND local_display_name in (
+            SELECT cr.local_display_name
+            FROM contact_requests cr
+            JOIN user_contact_links uc USING (user_contact_link_id)
+            WHERE uc.user_id = :user_id
+              AND uc.local_display_name = ''
+          )
+      |]
+      [":user_id" := userId]
+    DB.executeNamed
+      db
+      [sql|
+        DELETE FROM contact_profiles
+        WHERE contact_profile_id in (
+          SELECT cr.contact_profile_id
+          FROM contact_requests cr
+          JOIN user_contact_links uc USING (user_contact_link_id)
+          WHERE uc.user_id = :user_id
+            AND uc.local_display_name = ''
+        )
+      |]
+      [":user_id" := userId]
+    DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = ''" (Only userId)
+
+getUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> m ConnReqContact
+getUserContactLink st userId =
+  liftIOEither . withTransaction st $ \db ->
+    connReq
+      <$> DB.query
+        db
+        [sql|
+          SELECT conn_req_contact
+          FROM user_contact_links
+          WHERE user_id = ?
+            AND local_display_name = ''
+        |]
+        (Only userId)
+  where
+    connReq [Only cReq] = Right cReq
+    connReq _ = Left SEUserContactLinkNotFound
+
+createContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> m ContactName
+createContactRequest st userId userContactId invId Profile {displayName, fullName} =
+  liftIOEither . withTransaction st $ \db ->
+    withLocalDisplayName db userId displayName $ \ldn -> do
+      DB.execute db "INSERT INTO contact_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
+      profileId <- insertedRowId db
+      DB.execute
+        db
+        [sql|
+          INSERT INTO contact_requests
+          (user_contact_link_id, agent_invitation_id, contact_profile_id, local_display_name, user_id) VALUES (?,?,?,?,?)
+        |]
+        (userContactId, invId, profileId, ldn, userId)
+      pure ldn
+
+getContactRequest :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m UserContactRequest
+getContactRequest st userId localDisplayName =
+  liftIOEither . withTransaction st $ \db ->
+    contactReq
+      <$> DB.query
+        db
+        [sql|
+          SELECT cr.contact_request_id, cr.agent_invitation_id, cr.user_contact_link_id,
+            c.agent_conn_id, cr.contact_profile_id
+          FROM contact_requests cr
+          JOIN connections c USING (user_contact_link_id)
+          WHERE cr.user_id = ?
+            AND cr.local_display_name = ?
+        |]
+        (userId, localDisplayName)
+  where
+    contactReq [(contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId)] =
+      Right UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId, localDisplayName}
+    contactReq _ = Left $ SEContactRequestNotFound localDisplayName
+
+deleteContactRequest :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactName -> m ()
+deleteContactRequest st userId localDisplayName =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+    DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+
+createAcceptedContact :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> ContactName -> Int64 -> m ()
+createAcceptedContact st userId agentConnId localDisplayName profileId =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
+    DB.execute db "INSERT INTO contacts (user_id, local_display_name, contact_profile_id) VALUES (?,?,?)" (userId, localDisplayName, profileId)
+    contactId <- insertedRowId db
+    void $ createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing 0
+
 getLiveSndFileTransfers :: MonadUnliftIO m => SQLiteStore -> User -> m [SndFileTransfer]
 getLiveSndFileTransfers st User {userId} =
   liftIO . withTransaction st $ \db -> do
@@ -416,7 +585,7 @@ getPendingConnections st User {userId} =
         db
         [sql|
           SELECT connection_id, agent_conn_id, conn_level, via_contact,
-            conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
+            conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
           FROM connections
           WHERE user_id = :user_id
             AND conn_type = :conn_type
@@ -432,7 +601,7 @@ getContactConnections st userId displayName =
         db
         [sql|
           SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
           FROM connections c
           JOIN contacts cs ON c.contact_id == cs.contact_id
           WHERE c.user_id = :user_id
@@ -444,12 +613,12 @@ getContactConnections st userId displayName =
     connections [] = Left $ SEContactNotFound displayName
     connections rows = Right $ map toConnection rows
 
-type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
+type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
 
-type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
+type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
 
 toConnection :: ConnectionRow -> Connection
-toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt) =
+toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, createdAt) =
   let entityId = entityId_ connType
    in Connection {connId, agentConnId, connLevel, viaContact, connStatus, connType, entityId, createdAt}
   where
@@ -458,10 +627,11 @@ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType,
     entityId_ ConnMember = groupMemberId
     entityId_ ConnRcvFile = rcvFileId
     entityId_ ConnSndFile = sndFileId
+    entityId_ ConnUserContact = userContactLinkId
 
 toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
-toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, sndFileId, rcvFileId, Just createdAt) =
-  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt)
+toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, Just createdAt) =
+  Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, createdAt)
 toMaybeConnection _ = Nothing
 
 getMatchingContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [Contact]
@@ -599,6 +769,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
           ConnContact -> ReceivedDirectMessage c . Just <$> getContactRec_ db entId c
           ConnSndFile -> SndFileConnection c <$> getConnSndFileTransfer_ db entId c
           ConnRcvFile -> RcvFileConnection c <$> ExceptT (getRcvFileTransfer_ db userId entId)
+          ConnUserContact -> UserContactConnection c <$> getUserContact_ db entId
   where
     getConnection_ :: DB.Connection -> ExceptT StoreError IO Connection
     getConnection_ db = ExceptT $ do
@@ -607,7 +778,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
           db
           [sql|
             SELECT connection_id, agent_conn_id, conn_level, via_contact,
-              conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
+              conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
             FROM connections
             WHERE user_id = ? AND agent_conn_id = ?
           |]
@@ -674,6 +845,21 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
         Just recipientDisplayName -> Right SndFileTransfer {..}
         Nothing -> Left $ SESndFileInvalid fileId
     sndFileTransfer_ fileId _ _ = Left $ SESndFileNotFound fileId
+    getUserContact_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UserContact
+    getUserContact_ db userContactLinkId = ExceptT $ do
+      userContact_
+        <$> DB.query
+          db
+          [sql|
+            SELECT conn_req_contact
+            FROM user_contact_links
+            WHERE user_id = ? AND user_contact_link_id = ?
+          |]
+          (userId, userContactLinkId)
+      where
+        userContact_ :: [Only ConnReqContact] -> Either StoreError UserContact
+        userContact_ [Only cReq] = Right UserContact {userContactLinkId, connReqContact = cReq}
+        userContact_ _ = Left SEUserContactLinkNotFound
 
 updateConnectionStatus :: MonadUnliftIO m => SQLiteStore -> Connection -> ConnStatus -> m ()
 updateConnectionStatus st Connection {connId} connStatus =
@@ -717,14 +903,14 @@ getGroup :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Group
 getGroup st user localDisplayName =
   liftIOEither . withTransaction st $ \db -> runExceptT $ fst <$> getGroup_ db user localDisplayName
 
-getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe ConnectionRequest)
+getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe ConnReqInvitation)
 getGroup_ db User {userId, userContactId} localDisplayName = do
   (g@Group {groupId}, cReq) <- getGroupRec_
   allMembers <- getMembers_ groupId
   (members, membership) <- liftEither $ splitUserMember_ allMembers
   pure (g {members, membership}, cReq)
   where
-    getGroupRec_ :: ExceptT StoreError IO (Group, Maybe ConnectionRequest)
+    getGroupRec_ :: ExceptT StoreError IO (Group, Maybe ConnReqInvitation)
     getGroupRec_ = ExceptT $ do
       toGroup
         <$> DB.query
@@ -736,7 +922,7 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
             WHERE g.local_display_name = ? AND g.user_id = ?
           |]
           (localDisplayName, userId)
-    toGroup :: [(Int64, GroupName, Text, Maybe ConnectionRequest)] -> Either StoreError (Group, Maybe ConnectionRequest)
+    toGroup :: [(Int64, GroupName, Text, Maybe ConnReqInvitation)] -> Either StoreError (Group, Maybe ConnReqInvitation)
     toGroup [(groupId, displayName, fullName, cReq)] =
       let groupProfile = GroupProfile {displayName, fullName}
        in Right (Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}, cReq)
@@ -751,7 +937,7 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
               m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
               m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
               c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+              c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
             FROM group_members m
             JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
             LEFT JOIN connections c ON c.connection_id = (
@@ -975,7 +1161,7 @@ getIntroduction_ db reMember toMember = ExceptT $ do
       |]
       (groupMemberId reMember, groupMemberId toMember)
   where
-    toIntro :: [(Int64, Maybe ConnectionRequest, Maybe ConnectionRequest, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
+    toIntro :: [(Int64, Maybe ConnReqInvitation, Maybe ConnReqInvitation, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
     toIntro [(introId, groupConnReq, directConnReq, introStatus)] =
       let introInvitation = IntroInvitation <$> groupConnReq <*> directConnReq
        in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
@@ -985,7 +1171,7 @@ createIntroReMember :: StoreMonad m => SQLiteStore -> User -> Group -> GroupMemb
 createIntroReMember st user@User {userId} group@Group {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) groupAgentConnId directAgentConnId =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
     let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
-    Connection {connId = directConnId} <- liftIO $ createConnection_ db userId directAgentConnId memberContactId cLevel
+    Connection {connId = directConnId} <- liftIO $ createContactConnection_ db userId directAgentConnId memberContactId cLevel
     (localDisplayName, contactId, memProfileId) <- ExceptT $ createContact_ db userId directConnId memberProfile (Just groupId)
     liftIO $ do
       let newMember =
@@ -1007,7 +1193,7 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
   liftIO . withTransaction st $ \db -> do
     let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
     void $ createMemberConnection_ db userId groupMemberId groupAgentConnId viaContactId cLevel
-    Connection {connId = directConnId} <- createConnection_ db userId directAgentConnId viaContactId cLevel
+    Connection {connId = directConnId} <- createContactConnection_ db userId directAgentConnId viaContactId cLevel
     contactId <- createMemberContact_ db directConnId
     updateMember_ db contactId
   where
@@ -1040,17 +1226,7 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
         [":contact_id" := contactId, ":group_member_id" := groupMemberId]
 
 createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
-createMemberConnection_ db userId groupMemberId agentConnId viaContact connLevel = do
-  createdAt <- getCurrentTime
-  DB.execute
-    db
-    [sql|
-      INSERT INTO connections
-        (user_id, agent_conn_id, conn_status, conn_type, group_member_id, via_contact, conn_level, created_at) VALUES (?,?,?,?,?,?,?,?);
-    |]
-    (userId, agentConnId, ConnNew, ConnMember, groupMemberId, viaContact, connLevel, createdAt)
-  connId <- insertedRowId db
-  pure Connection {connId, agentConnId, connType = ConnMember, entityId = Just groupMemberId, viaContact, connLevel, connStatus = ConnNew, createdAt}
+createMemberConnection_ db userId groupMemberId = createConnection_ db userId ConnMember (Just groupMemberId)
 
 createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
 createContactMember_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy = do
@@ -1098,7 +1274,7 @@ getViaGroupMember st User {userId, userContactId} Contact {contactId} =
             m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
             m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
           FROM group_members m
           JOIN contacts ct ON ct.contact_id = m.contact_id
           JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
@@ -1128,7 +1304,7 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} =
           SELECT
             ct.contact_id, ct.local_display_name, p.display_name, p.full_name, ct.via_group,
             c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
+            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
           FROM contacts ct
           JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
           JOIN connections c ON c.connection_id = (
@@ -1171,19 +1347,8 @@ createSndGroupFileTransfer st userId Group {groupId} ms filePath fileSize chunkS
     pure fileId
 
 createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO Connection
-createSndFileConnection_ db userId fileId agentConnId = do
-  createdAt <- getCurrentTime
-  let connType = ConnSndFile
-      connStatus = ConnNew
-  DB.execute
-    db
-    [sql|
-      INSERT INTO connections
-        (user_id, snd_file_id, agent_conn_id, conn_status, conn_type, created_at) VALUES (?,?,?,?,?,?)
-    |]
-    (userId, fileId, agentConnId, connStatus, connType, createdAt)
-  connId <- insertedRowId db
-  pure Connection {connId, agentConnId, connType, entityId = Just fileId, viaContact = Nothing, connLevel = 0, connStatus, createdAt}
+createSndFileConnection_ db userId fileId agentConnId =
+  createConnection_ db userId ConnSndFile (Just fileId) agentConnId Nothing 0
 
 updateSndFileStatus :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> FileStatus -> m ()
 updateSndFileStatus st SndFileTransfer {fileId, connId} status =
@@ -1275,7 +1440,7 @@ getRcvFileTransfer_ db userId fileId =
       (userId, fileId)
   where
     rcvFileTransfer ::
-      [(FileStatus, ConnectionRequest, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
+      [(FileStatus, ConnReqInvitation, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
       Either StoreError RcvFileTransfer
     rcvFileTransfer [(fileStatus', fileConnReq, fileName, fileSize, chunkSize, contactName_, memberName_, filePath_, connId_, agentConnId_)] =
       let fileInv = FileInvitation {fileName, fileSize, fileConnReq}
@@ -1473,6 +1638,9 @@ data StoreError
   = SEDuplicateName
   | SEContactNotFound ContactName
   | SEContactNotReady ContactName
+  | SEDuplicateContactLink
+  | SEUserContactLinkNotFound
+  | SEContactRequestNotFound ContactName
   | SEGroupNotFound GroupName
   | SEGroupWithoutUser
   | SEDuplicateGroupMember

src/Simplex/Chat/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
@@ -20,7 +21,7 @@ import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics
-import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionRequest)
+import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionMode (..), ConnectionRequest, InvitationId)
 import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
 
 class IsContact a where
@@ -60,6 +61,22 @@ data Contact = Contact
 contactConnId :: Contact -> ConnId
 contactConnId Contact {activeConn = Connection {agentConnId}} = agentConnId
 
+data UserContact = UserContact
+  { userContactLinkId :: Int64,
+    connReqContact :: ConnReqContact
+  }
+  deriving (Eq, Show)
+
+data UserContactRequest = UserContactRequest
+  { contactRequestId :: Int64,
+    agentInvitationId :: InvitationId,
+    userContactLinkId :: Int64,
+    agentContactConnId :: ConnId,
+    localDisplayName :: ContactName,
+    profileId :: Int64
+  }
+  deriving (Eq, Show)
+
 type ContactName = Text
 
 type GroupName = Text
@@ -96,14 +113,14 @@ instance FromJSON GroupProfile
 data GroupInvitation = GroupInvitation
   { fromMember :: (MemberId, GroupMemberRole),
     invitedMember :: (MemberId, GroupMemberRole),
-    connRequest :: ConnectionRequest,
+    connRequest :: ConnReqInvitation,
     groupProfile :: GroupProfile
   }
   deriving (Eq, Show)
 
 data IntroInvitation = IntroInvitation
-  { groupConnReq :: ConnectionRequest,
-    directConnReq :: ConnectionRequest
+  { groupConnReq :: ConnReqInvitation,
+    directConnReq :: ConnReqInvitation
   }
   deriving (Eq, Show)
 
@@ -116,7 +133,7 @@ memberInfo m = MemberInfo (memberId m) (memberRole m) (memberProfile m)
 data ReceivedGroupInvitation = ReceivedGroupInvitation
   { fromMember :: GroupMember,
     userMember :: GroupMember,
-    connRequest :: ConnectionRequest,
+    connRequest :: ConnReqInvitation,
     groupProfile :: GroupProfile
   }
   deriving (Eq, Show)
@@ -316,7 +333,7 @@ data SndFileTransfer = SndFileTransfer
 data FileInvitation = FileInvitation
   { fileName :: String,
     fileSize :: Integer,
-    fileConnReq :: ConnectionRequest
+    fileConnReq :: ConnReqInvitation
   }
   deriving (Eq, Show)
 
@@ -372,6 +389,10 @@ serializeFileStatus = \case
 data RcvChunkStatus = RcvChunkOk | RcvChunkFinal | RcvChunkDuplicate | RcvChunkError
   deriving (Eq, Show)
 
+type ConnReqInvitation = ConnectionRequest 'CMInvitation
+
+type ConnReqContact = ConnectionRequest 'CMContact
+
 data Connection = Connection
   { connId :: Int64,
     agentConnId :: ConnId,
@@ -379,7 +400,7 @@ data Connection = Connection
     viaContact :: Maybe Int64,
     connType :: ConnType,
     connStatus :: ConnStatus,
-    entityId :: Maybe Int64, -- contact, group member or file ID
+    entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID
     createdAt :: UTCTime
   }
   deriving (Eq, Show)
@@ -426,7 +447,7 @@ serializeConnStatus = \case
   ConnReady -> "ready"
   ConnDeleted -> "deleted"
 
-data ConnType = ConnContact | ConnMember | ConnSndFile | ConnRcvFile
+data ConnType = ConnContact | ConnMember | ConnSndFile | ConnRcvFile | ConnUserContact
   deriving (Eq, Show)
 
 instance FromField ConnType where fromField = fromTextField_ connTypeT
@@ -439,6 +460,7 @@ connTypeT = \case
   "member" -> Just ConnMember
   "snd_file" -> Just ConnSndFile
   "rcv_file" -> Just ConnRcvFile
+  "user_contact" -> Just ConnUserContact
   _ -> Nothing
 
 serializeConnType :: ConnType -> Text
@@ -447,6 +469,7 @@ serializeConnType = \case
   ConnMember -> "member"
   ConnSndFile -> "snd_file"
   ConnRcvFile -> "rcv_file"
+  ConnUserContact -> "user_contact"
 
 data NewConnection = NewConnection
   { agentConnId :: ByteString,

src/Simplex/Chat/View.hs

@@ -16,6 +16,14 @@ module Simplex.Chat.View
     showContactAnotherClient,
     showContactSubscribed,
     showContactSubError,
+    showUserContactLinkCreated,
+    showUserContactLinkDeleted,
+    showUserContactLink,
+    showReceivedContactRequest,
+    showAcceptingContactRequest,
+    showContactRequestRejected,
+    showUserContactLinkSubscribed,
+    showUserContactLinkSubError,
     showGroupSubscribed,
     showGroupEmpty,
     showGroupRemoved,
@@ -87,12 +95,13 @@ import Simplex.Chat.Terminal (printToTerminal)
 import Simplex.Chat.Types
 import Simplex.Chat.Util (safeDecodeUtf8)
 import Simplex.Messaging.Agent.Protocol
+import qualified Simplex.Messaging.Protocol as SMP
 import System.Console.ANSI.Types
 
 type ChatReader m = (MonadUnliftIO m, MonadReader ChatController m)
 
-showInvitation :: ChatReader m => ConnectionRequest -> m ()
-showInvitation = printToView . connReq
+showInvitation :: ChatReader m => ConnReqInvitation -> m ()
+showInvitation = printToView . connReqInvitation_
 
 showChatError :: ChatReader m => ChatError -> m ()
 showChatError = printToView . chatError
@@ -118,6 +127,30 @@ showContactSubscribed = printToView . contactSubscribed
 showContactSubError :: ChatReader m => ContactName -> ChatError -> m ()
 showContactSubError = printToView .: contactSubError
 
+showUserContactLinkCreated :: ChatReader m => ConnReqContact -> m ()
+showUserContactLinkCreated = printToView . userContactLinkCreated
+
+showUserContactLinkDeleted :: ChatReader m => m ()
+showUserContactLinkDeleted = printToView userContactLinkDeleted
+
+showUserContactLink :: ChatReader m => ConnReqContact -> m ()
+showUserContactLink = printToView . userContactLink
+
+showReceivedContactRequest :: ChatReader m => ContactName -> Profile -> m ()
+showReceivedContactRequest = printToView .: receivedContactRequest
+
+showAcceptingContactRequest :: ChatReader m => ContactName -> m ()
+showAcceptingContactRequest = printToView . acceptingContactRequest
+
+showContactRequestRejected :: ChatReader m => ContactName -> m ()
+showContactRequestRejected = printToView . contactRequestRejected
+
+showUserContactLinkSubscribed :: ChatReader m => m ()
+showUserContactLinkSubscribed = printToView ["Your address is active! To show: " <> highlight' "/sa"]
+
+showUserContactLinkSubError :: ChatReader m => ChatError -> m ()
+showUserContactLinkSubError = printToView . userContactLinkSubError
+
 showGroupSubscribed :: ChatReader m => GroupName -> m ()
 showGroupSubscribed = printToView . groupSubscribed
 
@@ -256,13 +289,13 @@ showContactUpdated = printToView .: contactUpdated
 showMessageError :: ChatReader m => Text -> Text -> m ()
 showMessageError = printToView .: messageError
 
-connReq :: ConnectionRequest -> [StyledString]
-connReq cReq =
-  [ "pass this connection link to your contact (via another channel): ",
+connReqInvitation_ :: ConnReqInvitation -> [StyledString]
+connReqInvitation_ cReq =
+  [ "pass this invitation link to your contact (via another channel): ",
     "",
-    (plain . serializeConnReq) cReq,
+    (plain . serializeConnReq') cReq,
     "",
-    "and ask them to connect: " <> highlight' "/c <invitation_above>"
+    "and ask them to connect: " <> highlight' "/c <invitation_link_above>"
   ]
 
 contactDeleted :: ContactName -> [StyledString]
@@ -291,6 +324,48 @@ contactSubscribed c = [ttyContact c <> ": connected to server"]
 contactSubError :: ContactName -> ChatError -> [StyledString]
 contactSubError c e = [ttyContact c <> ": contact error " <> sShow e]
 
+userContactLinkCreated :: ConnReqContact -> [StyledString]
+userContactLinkCreated = connReqContact_ "Your new chat address is created!"
+
+userContactLinkDeleted :: [StyledString]
+userContactLinkDeleted =
+  [ "Your chat address is deleted - accepted contacts will remain connected.",
+    "To create a new chat address use " <> highlight' "/ad"
+  ]
+
+userContactLink :: ConnReqContact -> [StyledString]
+userContactLink = connReqContact_ "Your chat address:"
+
+connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
+connReqContact_ intro cReq =
+  [ intro,
+    "",
+    (plain . serializeConnReq') cReq,
+    "",
+    "Anybody can send you contact requests with: " <> highlight' "/c <contact_link_above>",
+    "to show it again: " <> highlight' "/sa",
+    "to delete it: " <> highlight' "/da" <> " (accepted contacts will remain connected)"
+  ]
+
+receivedContactRequest :: ContactName -> Profile -> [StyledString]
+receivedContactRequest c Profile {fullName} =
+  [ ttyFullName c fullName <> " wants to connect to you!",
+    "to accept: " <> highlight ("/ac " <> c),
+    "to reject: " <> highlight ("/rc " <> c) <> " (the sender will NOT be notified)"
+  ]
+
+acceptingContactRequest :: ContactName -> [StyledString]
+acceptingContactRequest c = [ttyContact c <> ": accepting contact request..."]
+
+contactRequestRejected :: ContactName -> [StyledString]
+contactRequestRejected c = [ttyContact c <> ": contact request rejected"]
+
+userContactLinkSubError :: ChatError -> [StyledString]
+userContactLinkSubError e =
+  [ "user address error: " <> sShow e,
+    "to delete your address: " <> highlight' "/da"
+  ]
+
 groupSubscribed :: GroupName -> [StyledString]
 groupSubscribed g = [ttyGroup g <> ": connected to server(s)"]
 
@@ -625,8 +700,13 @@ chatError = \case
     SEFileNotFound fileId -> fileNotFound fileId
     SESndFileNotFound fileId -> fileNotFound fileId
     SERcvFileNotFound fileId -> fileNotFound fileId
+    SEDuplicateContactLink -> ["you already have chat address, to show: " <> highlight' "/sa"]
+    SEUserContactLinkNotFound -> ["no chat address, to create: " <> highlight' "/ad"]
+    SEContactRequestNotFound c -> ["no contact request from " <> ttyContact c]
     e -> ["chat db error: " <> sShow e]
-  ChatErrorAgent e -> ["smp agent error: " <> sShow e]
+  ChatErrorAgent err -> case err of
+    SMP SMP.AUTH -> ["error: this connection is deleted"]
+    e -> ["smp agent error: " <> sShow e]
   ChatErrorMessage e -> ["chat message error: " <> sShow e]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]

stack.yaml

@@ -43,7 +43,7 @@ extra-deps:
   # - simplexmq-0.4.1@sha256:3a1bc40d85e4e398458e5b9b79757e0af4fe27b8ef44eb3157f7f1e07412a8e8,7640
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 391a48d588b460d4fa06ecee0e93f0aca563b00b
+    commit: fe2d6607de44d6be468d3a3a1a8536cf85b4f237
 #
 # extra-deps: []
 

tests/ChatTests.hs

@@ -46,6 +46,10 @@ chatTests = do
     it "sender cancelled file transfer" testFileSndCancel
     it "recipient cancelled file transfer" testFileRcvCancel
     it "send and receive file to group" testGroupFileTransfer
+  describe "user contact link" $ do
+    it "should create and connect via contact link" testUserContactLink
+    it "should reject contact and delete contact link" testRejectContactAndDeleteUserContact
+    it "should delete connection requests when contact link deleted" testDeleteConnectionRequests
 
 testAddContact :: IO ()
 testAddContact =
@@ -530,6 +534,73 @@ testGroupFileTransfer =
             cath <## "completed receiving file 1 (test.jpg) from alice"
         ]
 
+testUserContactLink :: IO ()
+testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $
+  \alice bob cath -> do
+    alice ##> "/ad"
+    cLink <- getContactLink alice True
+    bob ##> ("/c " <> cLink)
+    alice <#? bob
+    alice ##> "/ac bob"
+    alice <## "bob: accepting contact request..."
+    concurrently_
+      (bob <## "alice (Alice): contact is connected")
+      (alice <## "bob (Bob): contact is connected")
+    alice <##> bob
+
+    cath ##> ("/c " <> cLink)
+    alice <#? cath
+    alice ##> "/ac cath"
+    alice <## "cath: accepting contact request..."
+    concurrently_
+      (cath <## "alice (Alice): contact is connected")
+      (alice <## "cath (Catherine): contact is connected")
+    alice <##> cath
+
+testRejectContactAndDeleteUserContact :: IO ()
+testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
+  \alice bob cath -> do
+    alice ##> "/ad"
+    cLink <- getContactLink alice True
+    bob ##> ("/c " <> cLink)
+    alice <#? bob
+    alice ##> "/rc bob"
+    alice <## "bob: contact request rejected"
+    (bob </)
+
+    alice ##> "/sa"
+    cLink' <- getContactLink alice False
+    cLink' `shouldBe` cLink
+
+    alice ##> "/da"
+    alice <## "Your chat address is deleted - accepted contacts will remain connected."
+    alice <## "To create a new chat address use /ad"
+
+    cath ##> ("/c " <> cLink)
+    cath <## "error: this connection is deleted"
+
+testDeleteConnectionRequests :: IO ()
+testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
+  \alice bob cath -> do
+    alice ##> "/ad"
+    cLink <- getContactLink alice True
+    bob ##> ("/c " <> cLink)
+    alice <#? bob
+    cath ##> ("/c " <> cLink)
+    alice <#? cath
+
+    alice ##> "/da"
+    alice <## "Your chat address is deleted - accepted contacts will remain connected."
+    alice <## "To create a new chat address use /ad"
+
+    alice ##> "/ad"
+    cLink' <- getContactLink alice True
+    bob ##> ("/c " <> cLink')
+    -- same names are used here, as they were released at /da
+    alice <#? bob
+    cath ##> ("/c " <> cLink')
+    alice <#? cath
+
 startFileTransfer :: TestCC -> TestCC -> IO ()
 startFileTransfer alice bob = do
   alice #> "/f @bob ./tests/fixtures/test.jpg"
@@ -648,6 +719,14 @@ cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line
 (</) :: TestCC -> Expectation
 (</) cc = timeout 500000 (getTermLine cc) `shouldReturn` Nothing
 
+(<#?) :: TestCC -> TestCC -> Expectation
+cc1 <#? cc2 = do
+  name <- userName cc2
+  sName <- showName cc2
+  cc1 <## (sName <> " wants to connect to you!")
+  cc1 <## ("to accept: /ac " <> name)
+  cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)")
+
 dropTime :: String -> String
 dropTime msg = case splitAt 6 msg of
   ([m, m', ':', s, s', ' '], text) ->
@@ -659,9 +738,20 @@ getTermLine = atomically . readTQueue . termQ
 
 getInvitation :: TestCC -> IO String
 getInvitation cc = do
-  cc <## "pass this connection link to your contact (via another channel):"
+  cc <## "pass this invitation link to your contact (via another channel):"
   cc <## ""
   inv <- getTermLine cc
   cc <## ""
-  cc <## "and ask them to connect: /c <invitation_above>"
+  cc <## "and ask them to connect: /c <invitation_link_above>"
   pure inv
+
+getContactLink :: TestCC -> Bool -> IO String
+getContactLink cc created = do
+  cc <## if created then "Your new chat address is created!" else "Your chat address:"
+  cc <## ""
+  link <- getTermLine cc
+  cc <## ""
+  cc <## "Anybody can send you contact requests with: /c <contact_link_above>"
+  cc <## "to show it again: /sa"
+  cc <## "to delete it: /da (accepted contacts will remain connected)"
+  pure link