mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
core: group links (#1194)
This commit is contained in:
parent
9670da4646
commit
3bf8361911
11 changed files with 603 additions and 82 deletions
53
docs/rfcs/2022-10-10-group-links.md
Normal file
53
docs/rfcs/2022-10-10-group-links.md
Normal file
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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,8 +1138,9 @@ 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 ()
|
||||
sendGrpInvitation user ct@Contact {localDisplayName} GroupInfo {groupId, groupProfile, membership} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do
|
||||
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
|
||||
msg <- sendDirectContactMessage ct $ XGrpInv groupInv
|
||||
|
@ -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 User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} = 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
|
||||
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe Profile -> m Contact
|
||||
acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
|
||||
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
|
||||
[] -> pure ()
|
||||
((_, Just e) : _) -> toView $ CRUserContactLinkSubError e
|
||||
_ -> toView CRUserContactLinkSubscribed
|
||||
contactLinkSubsToView rs = toView . CRUserContactSubSummary . map (uncurry UserContactSubStatus) . resultsFor rs
|
||||
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
|
||||
forM_ mc_ $ \mc -> do
|
||||
msg <- sendDirectContactMessage ct (XMsgNew $ MCSimple (ExtMsgContent mc Nothing))
|
||||
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
|
||||
Just (_, autoAccept, _, groupId_) ->
|
||||
if autoAccept
|
||||
then acceptContactRequest user cReq >>= toView . CRAcceptingContactRequest
|
||||
then case groupId_ of
|
||||
Nothing -> do
|
||||
-- [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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|]
|
|
@ -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
|
||||
);
|
||||
|
|
|
@ -43,12 +43,16 @@ module Simplex.Chat.Store
|
|||
updateContactConnectionAlias,
|
||||
getUserContacts,
|
||||
createUserContactLink,
|
||||
getUserContactLinkConnections,
|
||||
getUserAddressConnections,
|
||||
getUserContactLinks,
|
||||
deleteUserContactLink,
|
||||
getUserContactLink,
|
||||
deleteUserAddress,
|
||||
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]
|
||||
getUserContactLinkConnections db user = do
|
||||
cs <- liftIO $ getUserContactLinks db user
|
||||
if null cs then throwError SEUserContactLinkNotFound else pure $ map fst cs
|
||||
getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection]
|
||||
getUserAddressConnections db User {userId} = do
|
||||
cs <- liftIO getUserAddressConnections_
|
||||
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
|
||||
<$> DB.queryNamed
|
||||
map toUserContactConnection
|
||||
<$> 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
|
||||
AND uc.user_id = :user_id
|
||||
AND uc.local_display_name = ''
|
||||
WHERE c.user_id = ? AND uc.user_id = ?
|
||||
|]
|
||||
[":user_id" := userId]
|
||||
(userId, userId)
|
||||
where
|
||||
toResult :: (ConnectionRow :. (Int64, ConnReqContact)) -> (Connection, UserContact)
|
||||
toResult (connRow :. (userContactLinkId, connReqContact)) = (toConnection connRow, UserContact {userContactLinkId, connReqContact})
|
||||
toUserContactConnection :: (ConnectionRow :. (Int64, ConnReqContact, Maybe GroupId)) -> (Connection, UserContact)
|
||||
toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection connRow, UserContact {userContactLinkId, connReqContact, groupId})
|
||||
|
||||
deleteUserContactLink :: DB.Connection -> User -> IO ()
|
||||
deleteUserContactLink db User {userId} = do
|
||||
deleteUserAddress :: DB.Connection -> User -> IO ()
|
||||
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
|
||||
AND uc.local_display_name = ''
|
||||
WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
|
||||
)
|
||||
|]
|
||||
[":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
|
||||
AND uc.local_display_name = ''
|
||||
WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
|
||||
)
|
||||
|]
|
||||
[":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)
|
||||
getUserContactLink db userId =
|
||||
getUserAddress :: DB.Connection -> UserId -> ExceptT StoreError IO (ConnReqContact, Bool, Maybe MsgContent)
|
||||
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 = ?
|
||||
AND local_display_name = ''
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
|]
|
||||
(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)
|
||||
updateUserContactLinkAutoAccept db userId autoAccept msgContent = do
|
||||
(cReqUri, _, _) <- getUserContactLink db userId
|
||||
liftIO updateUserContactLinkAutoAccept_
|
||||
updateUserAddressAutoAccept :: DB.Connection -> UserId -> Bool -> Maybe MsgContent -> ExceptT StoreError IO (ConnReqContact, Bool, Maybe MsgContent)
|
||||
updateUserAddressAutoAccept db userId autoAccept msgContent = do
|
||||
(cReqUri, _, _) <- getUserAddress db userId
|
||||
liftIO updateUserAddressAutoAccept_
|
||||
pure (cReqUri, autoAccept, msgContent)
|
||||
where
|
||||
updateUserContactLinkAutoAccept_ :: IO ()
|
||||
updateUserContactLinkAutoAccept_ =
|
||||
updateUserAddressAutoAccept_ :: IO ()
|
||||
updateUserAddressAutoAccept_ =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE user_contact_links
|
||||
SET auto_accept = ?, auto_reply_msg_content = ?
|
||||
WHERE user_id = ?
|
||||
AND local_display_name = ''
|
||||
WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL
|
||||
|]
|
||||
(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_ [Only cReq] = Right UserContact {userContactLinkId, connReqContact = cReq}
|
||||
userContact_ :: [(ConnReqContact, Maybe GroupId)] -> Either StoreError UserContact
|
||||
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 contact_profiles p USING (contact_profile_id)
|
||||
WHERE cr.user_id = ?
|
||||
JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id
|
||||
JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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` ""
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue