core: group links (#1194)

docs/rfcs/2022-10-10-group-links.md

@@ -0,0 +1,53 @@
+# Group links
+
+## Problem
+
+Friction in group discovery and invitation/joining. Currently each group member has to be invited manually, and has first to be connected to an existing group member, even if group is considered as open/public by its owners.
+
+## Solution
+
+Allow to create group link(s) - a group link is a new type of contact address link, with enabled auto accept. After receiving and automatically accepting a group join request via such link, a contact is automatically invited to group. This allows to publish such link on a site or another platform and reduce friction required to join a "public" group.
+
+## Design considerations
+
+Add group link metadata to contact link?
+
+- It can be used to display information about the group on the link web page, e.g. a group profile or its part, though it introduces a privacy concern.
+- Can be used to display only the fact that it's a group invitation link.
+- If we use a separate contact address for each group link, and we don't do auto-join on receiving group invitation corresponding to the group link, group link metadata in contact link is not necessary.
+
+Use group link metadata when accepting / joining?
+
+- When accepting we can use the fact that this contact request link is tied to a specific group to automatically invite to group, it's not necessary to parse out this part in agent.
+- When joining it could be parsed out in agent and communicated to chat for chat to know it has to automatically accept the corresponding group invite that should follow. Alternatively we can ignore this metadata in agent/chat and let the user to accept incoming group invitation manually. The advantages of the second approach are that it's simpler and that the user can inspect received group profile before accepting. The disadvantage is more friction, though it's on joining side, not on the inviting side (join is performed only once).
+
+Allow each group member who can invite to create their own link, or have such link be a part of group's profile, so it can be created by owners?
+
+- The advantage of the second approach is that owners can set up an always online client, so the connectivity in group would be better compared to one that could be provided by regular clients. Another advantage is that link can be shared by any member role, even without permission to invite members.
+- The disadvantage is that if group has no owners, the link can no longer be created. Also since all member would be using the same link for sharing, it would become a group identifier signalling they're members of the same group.
+- There're probably other advantages/disadvantages to be considered. Other considerations:
+  - Group owners can overwrite each others links.
+  - When member leaves group or is removed from group, he should remove corresponding contact address to avoid accepting respective contact requests.
+  - When member role is changed, link/contact address should be conditionally removed if new role doesn't allow adding members.
+
+Allow to create a link with incognito membership?
+
+- Even though we currently don't allow to add members for incognito memberships to avoid incognito / non incognito profiles confusion, when accepting group join requests via group links, same incognito profile that is used for membership could be shared.
+- Take into account the plan to allow configuring auto-accept on regular contact requests so that accepting is always incognito, regardless of incognito mode. For group links it has to be yet another specific mode of auto accept so that the same profile is re-used instead of usual per request incognito profile.
+
+## Implementation
+
+```
+ALTER TABLE user_contact_links ADD COLUMN group_id INTEGER REFERENCES groups ON DELETE CASCADE;
+```
+
+API:
+
+- APICreateGroupLink GroupId
+- APIDeleteGroupLink GroupId
+- APIShowGroupLink GroupId
+- CreateGroupLink GroupName  -- for terminal
+- DeleteGroupLink GroupName  -- for terminal
+- ShowGroupLink GroupName  -- for terminal
+- CRGroupLinkCreated ConnReqContact  -- response on create
+- CRGroupLink ConnReqContact  -- response on show

simplex-chat.cabal

@@ -54,6 +54,7 @@ library
       Simplex.Chat.Migrations.M20221001_shared_msg_id_indices
       Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_items
       Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
+      Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
       Simplex.Chat.Mobile
       Simplex.Chat.Options
       Simplex.Chat.ProfileGenerator

src/Simplex/Chat.hs

@@ -485,6 +485,7 @@ processChatCommand = \case
       withChatLock . procCmd $ do
         forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo
         when (memberActive membership) . void $ sendGroupMessage gInfo members XGrpDel
+        deleteGroupLink' user gInfo `catchError` \_ -> pure ()
         forM_ members $ deleteMemberConnection user
         -- functions below are called in separate transactions to prevent crashes on android
         -- (possibly, race condition on integrity check?)
@@ -522,7 +523,11 @@ processChatCommand = \case
     CTContactRequest -> pure $ chatCmdError "not supported"
   APIAcceptContact connReqId -> withUser $ \user@User {userId} -> withChatLock $ do
     cReq <- withStore $ \db -> getContactRequest db userId connReqId
-    procCmd $ CRAcceptingContactRequest <$> acceptContactRequest user cReq
+    -- [incognito] generate profile to send, create connection with incognito profile
+    incognito <- readTVarIO =<< asks incognitoMode
+    incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
+    ct <- acceptContactRequest user cReq incognitoProfile
+    pure $ CRAcceptingContactRequest ct
   APIRejectContact connReqId -> withUser $ \User {userId} -> withChatLock $ do
     cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <-
       withStore $ \db ->
@@ -737,15 +742,15 @@ processChatCommand = \case
     withStore $ \db -> createUserContactLink db userId connId cReq
     pure $ CRUserContactLinkCreated cReq
   DeleteMyAddress -> withUser $ \user -> withChatLock $ do
-    conns <- withStore (`getUserContactLinkConnections` user)
+    conns <- withStore (`getUserAddressConnections` user)
     procCmd $ do
       forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure ()
-      withStore' (`deleteUserContactLink` user)
+      withStore' (`deleteUserAddress` user)
       pure CRUserContactLinkDeleted
   ShowMyAddress -> withUser $ \User {userId} ->
-    uncurry3 CRUserContactLink <$> withStore (`getUserContactLink` userId)
+    uncurry3 CRUserContactLink <$> withStore (`getUserAddress` userId)
   AddressAutoAccept onOff msgContent -> withUser $ \User {userId} -> do
-    uncurry3 CRUserContactLinkUpdated <$> withStore (\db -> updateUserContactLinkAutoAccept db userId onOff msgContent)
+    uncurry3 CRUserContactLinkUpdated <$> withStore (\db -> updateUserAddressAutoAccept db userId onOff msgContent)
   AcceptContact cName -> withUser $ \User {userId} -> do
     connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName
     processChatCommand $ APIAcceptContact connReqId
@@ -885,6 +890,7 @@ processChatCommand = \case
       ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) Nothing Nothing
       toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
       -- TODO delete direct connections that were unused
+      deleteGroupLink' user gInfo `catchError` \_ -> pure ()
       forM_ members $ deleteMemberConnection user
       withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft
       pure $ CRLeftMemberUser gInfo {membership = membership {memberStatus = GSMemLeft}}
@@ -929,6 +935,30 @@ processChatCommand = \case
   UpdateGroupProfile gName profile -> withUser $ \user -> do
     groupId <- withStore $ \db -> getGroupIdByName db user gName
     processChatCommand $ APIUpdateGroupProfile groupId profile
+  APICreateGroupLink groupId -> withUser $ \user -> withChatLock $ do
+    gInfo@GroupInfo {membership = membership@GroupMember {memberRole = userRole}} <- withStore $ \db -> getGroupInfo db user groupId
+    when (userRole < GRAdmin) $ throwChatError CEGroupUserRole
+    when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined gInfo)
+    unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
+    (connId, cReq) <- withAgent $ \a -> createConnection a True SCMContact
+    withStore $ \db -> createGroupLink db user gInfo connId cReq
+    pure $ CRGroupLinkCreated gInfo cReq
+  APIDeleteGroupLink groupId -> withUser $ \user -> withChatLock $ do
+    gInfo <- withStore $ \db -> getGroupInfo db user groupId
+    deleteGroupLink' user gInfo
+    pure $ CRGroupLinkDeleted gInfo
+  APIGetGroupLink groupId -> withUser $ \user -> do
+    gInfo <- withStore $ \db -> getGroupInfo db user groupId
+    CRGroupLink gInfo <$> withStore (\db -> getGroupLink db user gInfo)
+  CreateGroupLink gName -> withUser $ \user -> do
+    groupId <- withStore $ \db -> getGroupIdByName db user gName
+    processChatCommand $ APICreateGroupLink groupId
+  DeleteGroupLink gName -> withUser $ \user -> do
+    groupId <- withStore $ \db -> getGroupIdByName db user gName
+    processChatCommand $ APIDeleteGroupLink groupId
+  ShowGroupLink gName -> withUser $ \user -> do
+    groupId <- withStore $ \db -> getGroupIdByName db user gName
+    processChatCommand $ APIGetGroupLink groupId
   SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do
     groupId <- withStore $ \db -> getGroupIdByName db user gName
     quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName (safeDecodeUtf8 quotedMsg)
@@ -1108,15 +1138,16 @@ processChatCommand = \case
         groupId <- getGroupIdByName db user gName
         groupMemberId <- getGroupMemberIdByName db user groupId groupMemberName
         pure (groupId, groupMemberId)
-    sendGrpInvitation :: User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> m ()
+
-    sendGrpInvitation user ct@Contact {localDisplayName} GroupInfo {groupId, groupProfile, membership} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do
+sendGrpInvitation :: ChatMonad m => User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> m ()
-      let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
+sendGrpInvitation user ct@Contact {localDisplayName} GroupInfo {groupId, groupProfile, membership} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do
-          groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
+  let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
-      msg <- sendDirectContactMessage ct $ XGrpInv groupInv
+      groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
-      let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
+  msg <- sendDirectContactMessage ct $ XGrpInv groupInv
-      ci <- saveSndChatItem user (CDDirectSnd ct) msg content Nothing Nothing
+  let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
-      toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
+  ci <- saveSndChatItem user (CDDirectSnd ct) msg content Nothing Nothing
-      setActive $ ActiveG localDisplayName
+  toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
+  setActive $ ActiveG localDisplayName
 
 setExpireCIs :: (MonadUnliftIO m, MonadReader ChatController m) => Bool -> m ()
 setExpireCIs b = do
@@ -1266,15 +1297,19 @@ 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 -> m Contact
+acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe Profile -> m Contact
-acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} = do
+acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
-  -- [incognito] generate profile to send, create connection with incognito profile
-  incognito <- readTVarIO =<< asks incognitoMode
-  incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
   let profileToSend = fromMaybe (fromLocalProfile profile) incognitoProfile
+  -- TODO acceptContactAsync
   connId <- withAgent $ \a -> acceptContact a True invId . directMessage $ XInfo profileToSend
   withStore' $ \db -> createAcceptedContact db userId connId cName profileId p userContactLinkId xContactId incognitoProfile
 
+deleteGroupLink' :: ChatMonad m => User -> GroupInfo -> m ()
+deleteGroupLink' user gInfo = do
+  conn <- withStore $ \db -> getGroupLinkConnection db user gInfo
+  deleteAgentConnectionAsync user conn `catchError` \_ -> pure ()
+  withStore' $ \db -> deleteGroupLink db user gInfo
+
 agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
 agentSubscriber = do
   q <- asks $ subQ . smpAgent
@@ -1340,10 +1375,7 @@ subscribeUserConnections agentBatchSubscribe user = do
     contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> m ()
     contactSubsToView rs = toView . CRContactSubSummary . map (uncurry ContactSubStatus) . resultsFor rs
     contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> m ()
-    contactLinkSubsToView rs ucs = case resultsFor rs ucs of
+    contactLinkSubsToView rs = toView . CRUserContactSubSummary . map (uncurry UserContactSubStatus) . resultsFor rs
-      [] -> pure ()
-      ((_, Just e) : _) -> toView $ CRUserContactLinkSubError e
-      _ -> toView CRUserContactLinkSubscribed
     groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> m ()
     groupSubsToView rs gs ms ce = do
       mapM_ groupSub $
@@ -1581,12 +1613,21 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
               toView $ CRContactConnected ct (fmap fromLocalProfile incognitoProfile)
               setActive $ ActiveC c
               showToast (c <> "> ") "connected"
-              forM_ viaUserContactLink $ \userContactLinkId -> do
+              forM_ viaUserContactLink $ \userContactLinkId ->
                 withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
-                  Just (_, True, Just mc) -> do
+                  Just (_, True, mc_, groupId_) -> do
-                    msg <- sendDirectContactMessage ct (XMsgNew $ MCSimple (ExtMsgContent mc Nothing))
+                    forM_ mc_ $ \mc -> do
-                    ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) Nothing Nothing
+                      msg <- sendDirectContactMessage ct (XMsgNew $ MCSimple (ExtMsgContent mc Nothing))
-                    toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
+                      ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) Nothing Nothing
+                      toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
+                    forM_ groupId_ $ \groupId -> do
+                      gInfo <- withStore $ \db -> getGroupInfo db user groupId
+                      gVar <- asks idsDrg
+                      -- TODO async and continuation?
+                      (grpAgentConnId, cReq) <- withAgent $ \a -> createConnection a True SCMInvitation
+                      member <- withStore $ \db -> createNewContactMember db gVar user groupId ct GRMember grpAgentConnId cReq
+                      sendGrpInvitation user ct gInfo member cReq
+                      toView $ CRSentGroupInvitation gInfo ct member
                   _ -> pure ()
             Just (gInfo@GroupInfo {membership}, m@GroupMember {activeConn}) -> do
               when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
@@ -1864,12 +1905,26 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
           withStore (\db -> createOrUpdateContactRequest db userId userContactLinkId invId p xContactId_) >>= \case
             CORContact contact -> toView $ CRContactRequestAlreadyAccepted contact
             CORRequest cReq@UserContactRequest {localDisplayName} -> do
-              (_, autoAccept, _) <- withStore $ \db -> getUserContactLink db userId
+              withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
-              if autoAccept
+                Just (_, autoAccept, _, groupId_) ->
-                then acceptContactRequest user cReq >>= toView . CRAcceptingContactRequest
+                  if autoAccept
-                else do
+                    then case groupId_ of
-                  toView $ CRReceivedContactRequest cReq
+                      Nothing -> do
-                  showToast (localDisplayName <> "> ") "wants to connect to you"
+                        -- [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
+                        ct <- acceptContactRequest user cReq incognitoProfile
+                        toView $ CRAcceptingContactRequest ct
+                      Just groupId -> do
+                        gInfo@GroupInfo {membership} <- withStore $ \db -> getGroupInfo db user groupId
+                        let incognitoProfile = if memberIncognito membership then Just . fromLocalProfile $ memberProfile membership else Nothing
+                        ct <- acceptContactRequest user cReq incognitoProfile
+                        toView $ CRAcceptingGroupJoinRequest gInfo ct
+                    else do
+                      toView $ CRReceivedContactRequest cReq
+                      showToast (localDisplayName <> "> ") "wants to connect to you"
+                _ -> pure ()
 
     withCompletedCommand :: Connection -> ACommand 'Agent -> (CommandData -> m ()) -> m ()
     withCompletedCommand Connection {connId} agentMsg action = do
@@ -2406,6 +2461,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
       members <- withStore' $ \db -> getGroupMembers db user gInfo
       if memberId (membership :: GroupMember) == memId
         then checkRole membership $ do
+          deleteGroupLink' user gInfo `catchError` \_ -> pure ()
           forM_ members $ deleteMemberConnection user
           deleteMember membership RGEUserDeleted
           toView $ CRDeletedMemberUser gInfo {membership = membership {memberStatus = GSMemRemoved}} m
@@ -2914,6 +2970,12 @@ chatCommandP =
       ("/groups" <|> "/gs") $> ListGroups,
       "/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP),
       ("/group_profile #" <|> "/gp #" <|> "/group_profile " <|> "/gp ") *> (UpdateGroupProfile <$> displayName <* A.space <*> groupProfile),
+      "/_create link #" *> (APICreateGroupLink <$> A.decimal),
+      "/_delete link #" *> (APIDeleteGroupLink <$> A.decimal),
+      "/_get link #" *> (APIGetGroupLink <$> A.decimal),
+      "/create link #" *> (CreateGroupLink <$> displayName),
+      "/delete link #" *> (DeleteGroupLink <$> displayName),
+      "/show link #" *> (ShowGroupLink <$> displayName),
       (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> A.takeByteString),
       (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* optional (A.char '@') <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> A.takeByteString),
       ("/contacts" <|> "/cs") $> ListContacts,

src/Simplex/Chat/Controller.hs

@@ -161,6 +161,9 @@ data ChatCommand
   | APILeaveGroup GroupId
   | APIListMembers GroupId
   | APIUpdateGroupProfile GroupId GroupProfile
+  | APICreateGroupLink GroupId
+  | APIDeleteGroupLink GroupId
+  | APIGetGroupLink GroupId
   | GetUserSMPServers
   | SetUserSMPServers [SMPServer]
   | APISetChatItemTTL (Maybe Int64)
@@ -203,6 +206,9 @@ data ChatCommand
   | ListMembers GroupName
   | ListGroups
   | UpdateGroupProfile GroupName GroupProfile
+  | CreateGroupLink GroupName
+  | DeleteGroupLink GroupName
+  | ShowGroupLink GroupName
   | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString}
   | LastMessages (Maybe ChatName) Int
   | SendFile ChatName FilePath
@@ -295,6 +301,7 @@ data ChatResponse
   | CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
   | CRContactSubError {contact :: Contact, chatError :: ChatError}
   | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
+  | CRUserContactSubSummary {userContactSubscriptions :: [UserContactSubStatus]}
   | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
   | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
   | CRGroupInvitation {groupInfo :: GroupInfo}
@@ -312,6 +319,10 @@ data ChatResponse
   | CRGroupRemoved {groupInfo :: GroupInfo}
   | CRGroupDeleted {groupInfo :: GroupInfo, member :: GroupMember}
   | CRGroupUpdated {fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
+  | CRGroupLinkCreated {groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
+  | CRGroupLink {groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
+  | CRGroupLinkDeleted {groupInfo :: GroupInfo}
+  | CRAcceptingGroupJoinRequest {groupInfo :: GroupInfo, contact :: Contact}
   | CRMemberSubError {groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
   | CRMemberSubSummary {memberSubscriptions :: [MemberSubStatus]}
   | CRGroupSubscribed {groupInfo :: GroupInfo}
@@ -379,6 +390,16 @@ instance ToJSON MemberSubStatus where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
+data UserContactSubStatus = UserContactSubStatus
+  { userContact :: UserContact,
+    userContactError :: Maybe ChatError
+  }
+  deriving (Show, Generic)
+
+instance ToJSON UserContactSubStatus where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
 data PendingSubStatus = PendingSubStatus
   { connection :: PendingContactConnection,
     connError :: Maybe ChatError

src/Simplex/Chat/Migrations/M20221011_user_contact_links_group_id.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20221011_user_contact_links_group_id where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20221011_user_contact_links_group_id :: Query
+m20221011_user_contact_links_group_id =
+  [sql|
+ALTER TABLE user_contact_links ADD COLUMN group_id INTEGER REFERENCES groups ON DELETE CASCADE;
+
+CREATE UNIQUE INDEX idx_user_contact_links_group_id ON user_contact_links(group_id);
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -259,6 +259,7 @@ CREATE TABLE user_contact_links(
   updated_at TEXT CHECK(updated_at NOT NULL),
   auto_accept INTEGER DEFAULT 0,
   auto_reply_msg_content TEXT DEFAULT NULL,
+  group_id INTEGER REFERENCES groups ON DELETE CASCADE,
   UNIQUE(user_id, local_display_name)
 );
 CREATE TABLE contact_requests(
@@ -427,3 +428,6 @@ CREATE UNIQUE INDEX idx_chat_items_group_shared_msg_id ON chat_items(
   shared_msg_id
 );
 CREATE INDEX idx_msg_deliveries_message_id ON msg_deliveries(message_id);
+CREATE UNIQUE INDEX idx_user_contact_links_group_id ON user_contact_links(
+  group_id
+);

src/Simplex/Chat/Store.hs

@@ -43,12 +43,16 @@ module Simplex.Chat.Store
     updateContactConnectionAlias,
     getUserContacts,
     createUserContactLink,
-    getUserContactLinkConnections,
+    getUserAddressConnections,
     getUserContactLinks,
-    deleteUserContactLink,
+    deleteUserAddress,
-    getUserContactLink,
+    getUserAddress,
     getUserContactLinkById,
-    updateUserContactLinkAutoAccept,
+    updateUserAddressAutoAccept,
+    createGroupLink,
+    getGroupLinkConnection,
+    deleteGroupLink,
+    getGroupLink,
     createOrUpdateContactRequest,
     getContactRequest,
     getContactRequestIdByName,
@@ -265,6 +269,7 @@ import Simplex.Chat.Migrations.M20220928_settings
 import Simplex.Chat.Migrations.M20221001_shared_msg_id_indices
 import Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_items
 import Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
+import Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@@ -304,7 +309,8 @@ schemaMigrations =
     ("20220928_settings", m20220928_settings),
     ("20221001_shared_msg_id_indices", m20221001_shared_msg_id_indices),
     ("20221003_delete_broken_integrity_error_chat_items", m20221003_delete_broken_integrity_error_chat_items),
-    ("20221004_idx_msg_deliveries_message_id", m20221004_idx_msg_deliveries_message_id)
+    ("20221004_idx_msg_deliveries_message_id", m20221004_idx_msg_deliveries_message_id),
+    ("20221011_user_contact_links_group_id", m20221011_user_contact_links_group_id)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -683,33 +689,45 @@ createUserContactLink db userId agentConnId cReq =
     userContactLinkId <- insertedRowId db
     void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing Nothing Nothing 0 currentTs
 
-getUserContactLinkConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection]
+getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection]
-getUserContactLinkConnections db user = do
+getUserAddressConnections db User {userId} = do
-  cs <- liftIO $ getUserContactLinks db user
+  cs <- liftIO getUserAddressConnections_
-  if null cs then throwError SEUserContactLinkNotFound else pure $ map fst cs
+  if null cs then throwError SEUserContactLinkNotFound else pure cs
+  where
+    getUserAddressConnections_ :: IO [Connection]
+    getUserAddressConnections_ =
+      map toConnection
+        <$> DB.query
+          db
+          [sql|
+            SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
+              c.conn_status, c.conn_type, c.local_alias, 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 = ? AND uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
+          |]
+          (userId, userId)
 
 getUserContactLinks :: DB.Connection -> User -> IO [(Connection, UserContact)]
 getUserContactLinks db User {userId} =
-  map toResult
+  map toUserContactConnection
-    <$> DB.queryNamed
+    <$> DB.query
       db
       [sql|
         SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
           c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at,
-          uc.user_contact_link_id, uc.conn_req_contact
+          uc.user_contact_link_id, uc.conn_req_contact, uc.group_id
         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
+        WHERE c.user_id = ? AND uc.user_id = ?
-          AND uc.user_id = :user_id
-          AND uc.local_display_name = ''
       |]
-      [":user_id" := userId]
+      (userId, userId)
   where
-    toResult :: (ConnectionRow :. (Int64, ConnReqContact)) -> (Connection, UserContact)
+    toUserContactConnection :: (ConnectionRow :. (Int64, ConnReqContact, Maybe GroupId)) -> (Connection, UserContact)
-    toResult (connRow :. (userContactLinkId, connReqContact)) = (toConnection connRow, UserContact {userContactLinkId, connReqContact})
+    toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection connRow, UserContact {userContactLinkId, connReqContact, groupId})
 
-deleteUserContactLink :: DB.Connection -> User -> IO ()
+deleteUserAddress :: DB.Connection -> User -> IO ()
-deleteUserContactLink db User {userId} = do
+deleteUserAddress db User {userId} = do
   DB.execute
     db
     [sql|
@@ -717,7 +735,7 @@ deleteUserContactLink db User {userId} = do
         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 = ''
+        WHERE uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
       )
     |]
     (Only userId)
@@ -730,8 +748,7 @@ deleteUserContactLink db User {userId} = do
           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
+          WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
-            AND uc.local_display_name = ''
         )
     |]
     [":user_id" := userId]
@@ -743,57 +760,124 @@ deleteUserContactLink db User {userId} = do
         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
+        WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
-          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)
+  DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL" (Only userId)
 
-getUserContactLink :: DB.Connection -> UserId -> ExceptT StoreError IO (ConnReqContact, Bool, Maybe MsgContent)
+getUserAddress :: DB.Connection -> UserId -> ExceptT StoreError IO (ConnReqContact, Bool, Maybe MsgContent)
-getUserContactLink db userId =
+getUserAddress db userId =
   ExceptT . firstRow id SEUserContactLinkNotFound $
     DB.query
       db
       [sql|
         SELECT conn_req_contact, auto_accept, auto_reply_msg_content
         FROM user_contact_links
-        WHERE user_id = ?
+        WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
-          AND local_display_name = ''
       |]
       (Only userId)
 
-getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> IO (Maybe (ConnReqContact, Bool, Maybe MsgContent))
+getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> IO (Maybe (ConnReqContact, Bool, Maybe MsgContent, Maybe GroupId))
 getUserContactLinkById db userId userContactLinkId =
   maybeFirstRow id $
     DB.query
       db
       [sql|
-        SELECT conn_req_contact, auto_accept, auto_reply_msg_content
+        SELECT conn_req_contact, auto_accept, auto_reply_msg_content, group_id
         FROM user_contact_links
         WHERE user_id = ?
           AND user_contact_link_id = ?
       |]
       (userId, userContactLinkId)
 
-updateUserContactLinkAutoAccept :: DB.Connection -> UserId -> Bool -> Maybe MsgContent -> ExceptT StoreError IO (ConnReqContact, Bool, Maybe MsgContent)
+updateUserAddressAutoAccept :: DB.Connection -> UserId -> Bool -> Maybe MsgContent -> ExceptT StoreError IO (ConnReqContact, Bool, Maybe MsgContent)
-updateUserContactLinkAutoAccept db userId autoAccept msgContent = do
+updateUserAddressAutoAccept db userId autoAccept msgContent = do
-  (cReqUri, _, _) <- getUserContactLink db userId
+  (cReqUri, _, _) <- getUserAddress db userId
-  liftIO updateUserContactLinkAutoAccept_
+  liftIO updateUserAddressAutoAccept_
   pure (cReqUri, autoAccept, msgContent)
   where
-    updateUserContactLinkAutoAccept_ :: IO ()
+    updateUserAddressAutoAccept_ :: IO ()
-    updateUserContactLinkAutoAccept_ =
+    updateUserAddressAutoAccept_ =
       DB.execute
         db
         [sql|
           UPDATE user_contact_links
           SET auto_accept = ?, auto_reply_msg_content = ?
-          WHERE user_id = ?
+          WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
-            AND local_display_name = ''
         |]
         (autoAccept, msgContent, userId)
 
+createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> ExceptT StoreError IO ()
+createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId cReq =
+  checkConstraint (SEDuplicateGroupLink groupInfo) . liftIO $ do
+    currentTs <- getCurrentTime
+    DB.execute
+      db
+      "INSERT INTO user_contact_links (user_id, group_id, local_display_name, conn_req_contact, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
+      (userId, groupId, "group_link_" <> localDisplayName, cReq, True, currentTs, currentTs)
+    groupLinkId <- insertedRowId db
+    void $ createConnection_ db userId ConnUserContact (Just groupLinkId) agentConnId Nothing Nothing Nothing 0 currentTs
+
+getGroupLinkConnection :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO Connection
+getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} =
+  ExceptT . firstRow toConnection (SEGroupLinkNotFound groupInfo) $
+    DB.query
+      db
+      [sql|
+        SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.custom_user_profile_id,
+          c.conn_status, c.conn_type, c.local_alias, 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 = ? AND uc.user_id = ? AND uc.group_id = ?
+      |]
+      (userId, userId, groupId)
+
+deleteGroupLink :: DB.Connection -> User -> GroupInfo -> IO ()
+deleteGroupLink db User {userId} GroupInfo {groupId} = 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.group_id = ?
+      )
+    |]
+    (userId, groupId)
+  DB.execute
+    db
+    [sql|
+      DELETE FROM display_names
+      WHERE 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 = ? AND uc.group_id = ?
+        )
+    |]
+    (userId, userId, groupId)
+  DB.execute
+    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 = ? AND uc.group_id = ?
+      )
+    |]
+    (userId, groupId)
+  DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId)
+
+getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO ConnReqContact
+getGroupLink db User {userId} gInfo@GroupInfo {groupId} =
+  ExceptT . firstRow fromOnly (SEGroupLinkNotFound gInfo) $
+    DB.query db "SELECT conn_req_contact FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId)
+
 createOrUpdateContactRequest :: DB.Connection -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest
 createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayName, fullName, image} xContactId_ =
   liftIO (maybeM getContact' xContactId_) >>= \case
@@ -1307,14 +1391,14 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
         <$> DB.query
           db
           [sql|
-            SELECT conn_req_contact
+            SELECT conn_req_contact, group_id
             FROM user_contact_links
             WHERE user_id = ? AND user_contact_link_id = ?
           |]
           (userId, userContactLinkId)
       where
-        userContact_ :: [Only ConnReqContact] -> Either StoreError UserContact
+        userContact_ :: [(ConnReqContact, Maybe GroupId)] -> Either StoreError UserContact
-        userContact_ [Only cReq] = Right UserContact {userContactLinkId, connReqContact = cReq}
+        userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
         userContact_ _ = Left SEUserContactLinkNotFound
 
 getConnectionById :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Connection
@@ -2947,11 +3031,12 @@ getContactRequestChatPreviews_ db User {userId} =
           cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
           c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, cr.created_at, cr.updated_at
         FROM contact_requests cr
-        JOIN connections c USING (user_contact_link_id)
+        JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id
-        JOIN contact_profiles p USING (contact_profile_id)
+        JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
-        WHERE cr.user_id = ?
+        JOIN user_contact_links uc ON uc.user_contact_link_id = cr.user_contact_link_id
+        WHERE cr.user_id = ? AND uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
       |]
-      (Only userId)
+      (userId, userId)
   where
     toContactRequestChatPreview :: ContactRequestRow -> AChat
     toContactRequestChatPreview cReqRow =
@@ -4240,6 +4325,8 @@ data StoreError
   | SEChatItemNotFoundByFileId {fileId :: FileTransferId}
   | SEChatItemNotFoundByGroupId {groupId :: GroupId}
   | SEProfileNotFound {profileId :: Int64}
+  | SEDuplicateGroupLink {groupInfo :: GroupInfo}
+  | SEGroupLinkNotFound {groupInfo :: GroupInfo}
   deriving (Show, Exception, Generic)
 
 instance ToJSON StoreError where

src/Simplex/Chat/Types.hs

@@ -110,10 +110,14 @@ instance ToJSON ContactRef where toEncoding = J.genericToEncoding J.defaultOptio
 
 data UserContact = UserContact
   { userContactLinkId :: Int64,
-    connReqContact :: ConnReqContact
+    connReqContact :: ConnReqContact,
+    groupId :: Maybe GroupId
   }
   deriving (Eq, Show, Generic)
 
+userContactGroupId :: UserContact -> Maybe GroupId
+userContactGroupId UserContact {groupId} = groupId
+
 instance ToJSON UserContact where
   toJSON = J.genericToJSON J.defaultOptions
   toEncoding = J.genericToEncoding J.defaultOptions

src/Simplex/Chat/View.hs

@@ -141,6 +141,13 @@ responseToView testView = \case
     [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
     where
       (errors, subscribed) = partition (isJust . contactError) summary
+  CRUserContactSubSummary summary ->
+    map addressSS addresses
+      <> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary groupLinkErrors " group link errors")
+    where
+      (addresses, groupLinks) = partition (\UserContactSubStatus {userContact} -> isNothing . userContactGroupId $ userContact) summary
+      addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
+      (groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
   CRGroupInvitation g -> [groupInvitation' g]
   CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role
   CRUserJoinedGroup g _ -> viewUserJoinedGroup g
@@ -158,6 +165,10 @@ responseToView testView = \case
   CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
   CRGroupDeleted g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
   CRGroupUpdated g g' m -> viewGroupUpdated g g' m
+  CRGroupLinkCreated g cReq -> groupLink_ "Group link is created!" g cReq
+  CRGroupLink g cReq -> groupLink_ "Group link:" g cReq
+  CRGroupLinkDeleted g -> viewGroupLinkDeleted g
+  CRAcceptingGroupJoinRequest g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
   CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
   CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
   CRGroupSubscribed g -> viewGroupSubscribed g
@@ -424,6 +435,23 @@ autoAcceptStatus_ autoAccept autoReply =
   ("auto_accept " <> if autoAccept then "on" else "off") :
   maybe [] ((["auto reply:"] <>) . ttyMsgContent) autoReply
 
+groupLink_ :: StyledString -> GroupInfo -> ConnReqContact -> [StyledString]
+groupLink_ intro g cReq =
+  [ intro,
+    "",
+    (plain . strEncode) cReq,
+    "",
+    "Anybody can connect to you and join group with: " <> highlight' "/c <group_link_above>",
+    "to show it again: " <> highlight ("/show link #" <> groupName' g),
+    "to delete it: " <> highlight ("/delete link #" <> groupName' g) <> " (joined members will remain connected to you)"
+  ]
+
+viewGroupLinkDeleted :: GroupInfo -> [StyledString]
+viewGroupLinkDeleted g =
+  [ "Group link is deleted - joined members will remain connected.",
+    "To create a new group link use " <> highlight ("/create link #" <> groupName' g)
+  ]
+
 viewSentInvitation :: Maybe Profile -> Bool -> [StyledString]
 viewSentInvitation incognitoProfile testView =
   case incognitoProfile of
@@ -988,6 +1016,8 @@ viewChatError = \case
     SEFileIdNotFoundBySharedMsgId _ -> [] -- recipient tried to accept cancelled file
     SEConnectionNotFound _ -> [] -- TODO mutes delete group error, but also mutes any error from getConnectionEntity
     SEQuotedChatItemNotFound -> ["message not found - reply is not sent"]
+    SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> groupName' g)]
+    SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> groupName' g)]
     e -> ["chat db error: " <> sShow e]
   ChatErrorDatabase err -> case err of
     DBErrorEncrypted -> ["error: chat database is already encrypted"]

tests/ChatTests.hs

@@ -125,6 +125,9 @@ chatTests = do
     it "mute/unmute group" testMuteGroup
   describe "chat item expiration" $ do
     it "set chat item TTL" testSetChatItemTTL
+  describe "group links" $ do
+    it "create group link, join via group link" testGroupLink
+    it "create group link, join via group link - incognito membership" testGroupLinkIncognitoMembership
 
 versionTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec
 versionTestMatrix2 runTest = do
@@ -3039,6 +3042,229 @@ testSetChatItemTTL =
       alice #$> ("/ttl none", id, "ok")
       alice #$> ("/ttl", id, "old messages are not being deleted")
 
+testGroupLink :: IO ()
+testGroupLink =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      alice ##> "/g team"
+      alice <## "group #team is created"
+      alice <## "use /a team <name> to add members"
+      alice ##> "/show link #team"
+      alice <## "no group link, to create: /create link #team"
+      alice ##> "/create link #team"
+      gLink <- getGroupLink alice "team" True
+      alice ##> "/show link #team"
+      _ <- getGroupLink alice "team" False
+      alice ##> "/create link #team"
+      alice <## "you already have link for this group, to show: /show link #team"
+      bob ##> ("/c " <> gLink)
+      bob <## "connection request sent!"
+      alice <## "bob (Bob): accepting request to join group #team..."
+      concurrentlyN_
+        [ do
+            alice <## "bob (Bob): contact is connected"
+            alice <## "invitation to join the group #team sent to bob",
+          do
+            bob <## "alice (Alice): contact is connected"
+            bob <## "#team: alice invites you to join the group as member"
+            bob <## "use /j team to accept"
+        ]
+      alice <##> bob
+      bob ##> "/j team"
+      concurrently_
+        (alice <## "#team: bob joined the group")
+        (bob <## "#team: you joined the group")
+
+      -- user address doesn't interfere
+      alice ##> "/ad"
+      cLink <- getContactLink alice True
+      cath ##> ("/c " <> cLink)
+      alice <#? cath
+      alice ##> "/ac cath"
+      alice <## "cath (Catherine): accepting contact request..."
+      concurrently_
+        (cath <## "alice (Alice): contact is connected")
+        (alice <## "cath (Catherine): contact is connected")
+      alice <##> cath
+
+      -- third member
+      cath ##> ("/c " <> gLink)
+      cath <## "connection request sent!"
+      alice <## "cath_1 (Catherine): accepting request to join group #team..."
+      concurrentlyN_
+        [ do
+            alice <## "cath_1 (Catherine): contact is connected"
+            alice <## "invitation to join the group #team sent to cath_1",
+          do
+            cath <## "alice_1 (Alice): contact is connected"
+            cath <## "#team: alice_1 invites you to join the group as member"
+            cath <## "use /j team to accept"
+        ]
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath_1 joined the group",
+          do
+            cath <## "#team: you joined the group"
+            cath <## "#team: member bob (Bob) is connected",
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+      alice #> "#team hello"
+      concurrently_
+        (bob <# "#team alice> hello")
+        (cath <# "#team alice_1> hello")
+      bob #> "#team hi there"
+      concurrently_
+        (alice <# "#team bob> hi there")
+        (cath <# "#team bob> hi there")
+      cath #> "#team hey team"
+      concurrently_
+        (alice <# "#team cath_1> hey team")
+        (bob <# "#team cath> hey team")
+
+      -- leaving team removes link
+      alice ##> "/l team"
+      concurrentlyN_
+        [ do
+            alice <## "#team: you left the group"
+            alice <## "use /d #team to delete the group",
+          bob <## "#team: alice left the group",
+          cath <## "#team: alice_1 left the group"
+        ]
+      alice ##> "/show link #team"
+      alice <## "no group link, to create: /create link #team"
+
+testGroupLinkIncognitoMembership :: IO ()
+testGroupLinkIncognitoMembership =
+  testChat4 aliceProfile bobProfile cathProfile danProfile $
+    \alice bob cath dan -> do
+      -- bob connected incognito to alice
+      alice ##> "/c"
+      inv <- getInvitation alice
+      bob #$> ("/incognito on", id, "ok")
+      bob ##> ("/c " <> inv)
+      bob <## "confirmation sent!"
+      bobIncognito <- getTermLine bob
+      concurrentlyN_
+        [ do
+            bob <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito)
+            bob <## "use /info alice to print out this incognito profile again",
+          alice <## (bobIncognito <> ": contact is connected")
+        ]
+      bob #$> ("/incognito off", id, "ok")
+      -- alice creates group
+      alice ##> "/g team"
+      alice <## "group #team is created"
+      alice <## "use /a team <name> to add members"
+      -- alice invites bob
+      alice ##> ("/a team " <> bobIncognito)
+      concurrentlyN_
+        [ alice <## ("invitation to join the group #team sent to " <> bobIncognito),
+          do
+            bob <## "#team: alice invites you to join the group as admin"
+            bob <## ("use /j team to join incognito as " <> bobIncognito)
+        ]
+      bob ##> "/j team"
+      concurrently_
+        (alice <## ("#team: " <> bobIncognito <> " joined the group"))
+        (bob <## ("#team: you joined the group incognito as " <> bobIncognito))
+      -- bob creates group link, cath joins
+      bob ##> "/create link #team"
+      gLink <- getGroupLink bob "team" True
+      cath ##> ("/c " <> gLink)
+      cath <## "connection request sent!"
+      bob <## "cath (Catherine): accepting request to join group #team..."
+      _ <- getTermLine bob
+      concurrentlyN_
+        [ do
+            bob <## ("cath (Catherine): contact is connected, your incognito profile for this contact is " <> bobIncognito)
+            bob <## "use /info cath to print out this incognito profile again"
+            bob <## "invitation to join the group #team sent to cath",
+          do
+            cath <## (bobIncognito <> ": contact is connected")
+            cath <## ("#team: " <> bobIncognito <> " invites you to join the group as member")
+            cath <## "use /j team to accept"
+        ]
+      bob ?#> "@cath hi, I'm incognito"
+      cath <# (bobIncognito <> "> hi, I'm incognito")
+      cath #> ("@" <> bobIncognito <> " hey, I'm cath")
+      bob ?<# "cath> hey, I'm cath"
+      cath ##> "/j team"
+      concurrentlyN_
+        [ bob <## "#team: cath joined the group",
+          do
+            cath <## "#team: you joined the group"
+            cath <## "#team: member alice (Alice) is connected",
+          do
+            alice <## ("#team: " <> bobIncognito <> " added cath (Catherine) to the group (connecting...)")
+            alice <## "#team: new member cath is connected"
+        ]
+      -- dan joins incognito
+      dan #$> ("/incognito on", id, "ok")
+      dan ##> ("/c " <> gLink)
+      danIncognito <- getTermLine dan
+      dan <## "connection request sent incognito!"
+      bob <## (danIncognito <> ": accepting request to join group #team...")
+      _ <- getTermLine bob
+      _ <- getTermLine dan
+      concurrentlyN_
+        [ do
+            bob <## (danIncognito <> ": contact is connected, your incognito profile for this contact is " <> bobIncognito)
+            bob <## ("use /info " <> danIncognito <> " to print out this incognito profile again")
+            bob <## ("invitation to join the group #team sent to " <> danIncognito),
+          do
+            dan <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> danIncognito)
+            dan <## ("use /info " <> bobIncognito <> " to print out this incognito profile again")
+            dan <## ("#team: " <> bobIncognito <> " invites you to join the group as member")
+            dan <## ("use /j team to join incognito as " <> danIncognito)
+        ]
+      dan #$> ("/incognito off", id, "ok")
+      bob ?#> ("@" <> danIncognito <> " hi, I'm incognito")
+      dan ?<# (bobIncognito <> "> hi, I'm incognito")
+      dan ?#> ("@" <> bobIncognito <> " hey, me too")
+      bob ?<# (danIncognito <> "> hey, me too")
+      dan ##> "/j team"
+      concurrentlyN_
+        [ bob <## ("#team: " <> danIncognito <> " joined the group"),
+          do
+            dan <## ("#team: you joined the group incognito as " <> danIncognito)
+            dan
+              <### [ "#team: member alice (Alice) is connected",
+                     "#team: member cath (Catherine) is connected"
+                   ],
+          do
+            alice <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)")
+            alice <## ("#team: new member " <> danIncognito <> " is connected"),
+          do
+            cath <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)")
+            cath <## ("#team: new member " <> danIncognito <> " is connected")
+        ]
+      alice #> "#team hello"
+      concurrentlyN_
+        [ bob ?<# "#team alice> hello",
+          cath <# "#team alice> hello",
+          dan ?<# "#team alice> hello"
+        ]
+      bob ?#> "#team hi there"
+      concurrentlyN_
+        [ alice <# ("#team " <> bobIncognito <> "> hi there"),
+          cath <# ("#team " <> bobIncognito <> "> hi there"),
+          dan ?<# ("#team " <> bobIncognito <> "> hi there")
+        ]
+      cath #> "#team hey"
+      concurrentlyN_
+        [ alice <# "#team cath> hey",
+          bob ?<# "#team cath> hey",
+          dan ?<# "#team cath> hey"
+        ]
+      dan ?#> "#team how is it going?"
+      concurrentlyN_
+        [ alice <# ("#team " <> danIncognito <> "> how is it going?"),
+          bob ?<# ("#team " <> danIncognito <> "> how is it going?"),
+          cath <# ("#team " <> danIncognito <> "> how is it going?")
+        ]
+
 withTestChatContactConnected :: String -> (TestCC -> IO a) -> IO a
 withTestChatContactConnected dbPrefix action =
   withTestChat dbPrefix $ \cc -> do
@@ -3289,3 +3515,14 @@ getContactLink cc created = do
   cc <## "to show it again: /sa"
   cc <## "to delete it: /da (accepted contacts will remain connected)"
   pure link
+
+getGroupLink :: TestCC -> String -> Bool -> IO String
+getGroupLink cc gName created = do
+  cc <## if created then "Group link is created!" else "Group link:"
+  cc <## ""
+  link <- getTermLine cc
+  cc <## ""
+  cc <## "Anybody can connect to you and join group with: /c <group_link_above>"
+  cc <## ("to show it again: /show link #" <> gName)
+  cc <## ("to delete it: /delete link #" <> gName <> " (joined members will remain connected to you)")
+  pure link

tests/MobileTests.hs

@@ -57,6 +57,13 @@ memberSubSummary = "{\"resp\":{\"memberSubSummary\":{\"memberSubscriptions\":[]}
 memberSubSummary = "{\"resp\":{\"type\":\"memberSubSummary\",\"memberSubscriptions\":[]}}"
 #endif
 
+userContactSubSummary :: String
+#if defined(darwin_HOST_OS) && defined(swiftJSON)
+userContactSubSummary = "{\"resp\":{\"userContactSubSummary\":{\"userContactSubscriptions\":[]}}}"
+#else
+userContactSubSummary = "{\"resp\":{\"type\":\"userContactSubSummary\",\"userContactSubscriptions\":[]}}"
+#endif
+
 pendingSubSummary :: String
 #if defined(darwin_HOST_OS) && defined(swiftJSON)
 pendingSubSummary = "{\"resp\":{\"pendingSubSummary\":{\"pendingSubscriptions\":[]}}}"
@@ -93,6 +100,7 @@ testChatApi = withTmpFiles $ do
   chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists
   chatSendCmd cc "/_start" `shouldReturn` chatStarted
   chatRecvMsg cc `shouldReturn` contactSubSummary
+  chatRecvMsg cc `shouldReturn` userContactSubSummary
   chatRecvMsg cc `shouldReturn` memberSubSummary
   chatRecvMsgWait cc 10000 `shouldReturn` pendingSubSummary
   chatRecvMsgWait cc 10000 `shouldReturn` ""