core: improve group link protocol (immediately establish group connection without first creating contact) (#3288)

This commit is contained in:
spaced4ndy 2023-10-30 20:40:20 +04:00 committed by GitHub
parent 9568279b0f
commit f34bbdbd9c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
15 changed files with 613 additions and 39 deletions

View File

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

View File

@ -2599,6 +2599,24 @@ acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvI
setCommandConnId db user cmdId connId
pure ct
acceptGroupJoinRequestAsync :: ChatMonad m => User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> Maybe IncognitoProfile -> m GroupMember
acceptGroupJoinRequestAsync
user
gInfo@GroupInfo {groupProfile, membership}
ucr@UserContactRequest {agentInvitationId = AgentInvId invId}
gLinkMemRole
incognitoProfile = do
gVar <- asks idsDrg
(groupMemberId, memberId) <- withStore $ \db -> createAcceptedMember db gVar user gInfo ucr gLinkMemRole
let Profile {displayName} = profileToSendOnAccept user incognitoProfile
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
msg = XGrpLinkInv $ GroupLinkInvitation (MemberIdRole userMemberId userRole) displayName (MemberIdRole memberId gLinkMemRole) groupProfile
subMode <- chatReadVar subscriptionMode
connIds <- agentAcceptContactAsync user True invId msg subMode
withStore $ \db -> do
liftIO $ createAcceptedMemberConnection db user connIds ucr groupMemberId subMode
getGroupMemberById db user groupMemberId
profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Profile
profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing
where
@ -3402,8 +3420,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- TODO update member profile
pure ()
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
XInfo _ -> pure () -- sent when connecting via group link
XOk -> pure ()
_ -> messageError "INFO from member must have x.grp.mem.info"
_ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok"
pure ()
CON -> do
members <- withStore' $ \db -> getGroupMembers db user gInfo
@ -3424,11 +3443,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
GCInviteeMember -> do
memberConnectedChatItem gInfo m
toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
let Connection {viaUserContactLink} = conn
when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
intros <- withStore' $ \db -> createIntroductions db members m
void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
forM_ intros $ \intro ->
processIntro intro `catchChatError` (toView . CRChatError (Just user))
where
sendXGrpLinkMem = do
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
profileToSend = profileToSendOnAccept user profileMode
void $ sendDirectMessage conn (XGrpLinkMem profileToSend) (GroupId groupId)
processIntro intro@GroupMemberIntro {introId} = do
void $ sendDirectMessage conn (XGrpMemIntro $ memberInfo (reMember intro)) (GroupId groupId)
withStore' $ \db -> updateIntroStatus db introId GMIntroSent
@ -3461,6 +3486,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
XFile fInv -> processGroupFileInvitation' gInfo m' fInv msg msgMeta
XFileCancel sharedMsgId -> xFileCancelGroup gInfo m' sharedMsgId msgMeta
XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo m' sharedMsgId fileConnReq_ fName msgMeta
-- XInfo p -> xInfoMember gInfo m' p -- TODO use for member profile update
XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p
XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg msgMeta
XGrpMemIntro memInfo -> xGrpMemIntro gInfo m' memInfo
XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv
@ -3721,7 +3748,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
CORRequest cReq -> do
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
Just (UserContactLink {autoAccept}, groupId_, _) ->
Just (UserContactLink {autoAccept}, groupId_, gLinkMemRole) ->
case autoAccept of
Just AutoAccept {acceptIncognito} -> case groupId_ of
Nothing -> do
@ -3732,8 +3759,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Just groupId -> do
gInfo <- withStore $ \db -> getGroupInfo db user groupId
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
ct <- acceptContactRequestAsync user cReq profileMode
toView $ CRAcceptingGroupJoinRequest user gInfo ct
if isCompatibleRange chatVRange groupLinkNoContactVRange
then do
mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode
createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
else do
ct <- acceptContactRequestAsync user cReq profileMode
toView $ CRAcceptingGroupJoinRequest user gInfo ct
_ -> toView $ CRReceivedContactRequest user cReq
_ -> pure ()
@ -4446,6 +4479,33 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
| otherwise -> Nothing
in setPreference_ SCFTimedMessages ctUserTMPref' ctUserPrefs
-- TODO use for member profile update
-- xInfoMember :: GroupInfo -> GroupMember -> Profile -> m ()
-- xInfoMember gInfo m p' = void $ processMemberProfileUpdate gInfo m p'
xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> m ()
xGrpLinkMem gInfo@GroupInfo {membership} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do
xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
if viaGroupLink && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
then do
m' <- processMemberProfileUpdate gInfo m p'
withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True
let connectedIncognito = memberIncognito membership
probeMatchingMemberContact m' connectedIncognito
else messageError "x.grp.link.mem error: invalid group link host profile update"
processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> m GroupMember
processMemberProfileUpdate gInfo m@GroupMember {memberContactId} p' =
case memberContactId of
Nothing -> do
m' <- withStore $ \db -> updateMemberProfile db user m p'
toView $ CRGroupMemberUpdated user gInfo m m'
pure m'
Just mContactId -> do
mCt <- withStore $ \db -> getContact db user mContactId
Contact {profile} <- processContactProfileUpdate mCt p' True
pure m {memberProfile = profile}
createFeatureEnabledItems :: Contact -> m ()
createFeatureEnabledItems ct@Contact {mergedPreferences} =
forM_ allChatFeatures $ \(ACF f) -> do
@ -4707,6 +4767,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ct <- withStore $ \db -> createDirectContact db user conn' p
toView $ CRContactConnecting user ct
pure conn'
XGrpLinkInv glInv -> do
(gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db user conn' glInv
toView $ CRGroupLinkConnecting user gInfo host
pure conn'
-- TODO show/log error, other events in SMP confirmation
_ -> pure conn'
@ -5488,7 +5552,7 @@ getCreateActiveUser st testView = do
where
loop = do
displayName <- getContactName
withTransaction st (\db -> runExceptT $ createUserRecord db (AgentUserId 1) Profile {displayName, fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing} True) >>= \case
withTransaction st (\db -> runExceptT $ createUserRecord db (AgentUserId 1) (profileFromName displayName) True) >>= \case
Left SEDuplicateName -> do
putStrLn "chosen display name is already used by another profile on this device, choose another one"
loop

View File

@ -474,6 +474,7 @@ data ChatResponse
| CRUserContactLinkUpdated {user :: User, contactLink :: UserContactLink}
| CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest}
| CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
| CRGroupLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
@ -489,6 +490,7 @@ data ChatResponse
| CRSentConfirmation {user :: User}
| CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
| CRGroupMemberUpdated {user :: User, groupInfo :: GroupInfo, fromMember :: GroupMember, toMember :: GroupMember}
| CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact, updatedContact :: Contact}
| CRContactDeleted {user :: User, contact :: Contact}
| CRContactDeletedByContact {user :: User, contact :: Contact}
@ -559,6 +561,7 @@ data ChatResponse
| CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole}
| CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
| CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact}
| CRAcceptingGroupJoinRequestMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRNoMemberContactCreating {user :: User, groupInfo :: GroupInfo, member :: GroupMember} -- only used in CLI
| CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}

View File

@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20231030_xgrplinkmem_received where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20231030_xgrplinkmem_received :: Query
m20231030_xgrplinkmem_received =
[sql|
ALTER TABLE group_members ADD COLUMN xgrplinkmem_received INTEGER NOT NULL DEFAULT 0;
|]
down_m20231030_xgrplinkmem_received :: Query
down_m20231030_xgrplinkmem_received =
[sql|
ALTER TABLE group_members DROP COLUMN xgrplinkmem_received;
|]

View File

@ -146,6 +146,7 @@ CREATE TABLE group_members(
updated_at TEXT CHECK(updated_at NOT NULL),
member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
show_messages INTEGER NOT NULL DEFAULT 1,
xgrplinkmem_received INTEGER NOT NULL DEFAULT 0,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE

View File

@ -51,7 +51,7 @@ import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
import Simplex.Messaging.Version hiding (version)
currentChatVersion :: Version
currentChatVersion = 2
currentChatVersion = 3
supportedChatVRange :: VersionRange
supportedChatVRange = mkVersionRange 1 currentChatVersion
@ -64,6 +64,10 @@ groupNoDirectVRange = mkVersionRange 2 currentChatVersion
xGrpDirectInvVRange :: VersionRange
xGrpDirectInvVRange = mkVersionRange 2 currentChatVersion
-- version range that supports joining group via group link without creating direct contact
groupLinkNoContactVRange :: VersionRange
groupLinkNoContactVRange = mkVersionRange 3 currentChatVersion
data ConnectionEntity
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
@ -218,6 +222,8 @@ data ChatMsgEvent (e :: MsgEncoding) where
XDirectDel :: ChatMsgEvent 'Json
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
XGrpMemIntro :: MemberInfo -> ChatMsgEvent 'Json
XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
@ -559,6 +565,8 @@ data CMEventTag (e :: MsgEncoding) where
XDirectDel_ :: CMEventTag 'Json
XGrpInv_ :: CMEventTag 'Json
XGrpAcpt_ :: CMEventTag 'Json
XGrpLinkInv_ :: CMEventTag 'Json
XGrpLinkMem_ :: CMEventTag 'Json
XGrpMemNew_ :: CMEventTag 'Json
XGrpMemIntro_ :: CMEventTag 'Json
XGrpMemInv_ :: CMEventTag 'Json
@ -606,6 +614,8 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
XDirectDel_ -> "x.direct.del"
XGrpInv_ -> "x.grp.inv"
XGrpAcpt_ -> "x.grp.acpt"
XGrpLinkInv_ -> "x.grp.link.inv"
XGrpLinkMem_ -> "x.grp.link.mem"
XGrpMemNew_ -> "x.grp.mem.new"
XGrpMemIntro_ -> "x.grp.mem.intro"
XGrpMemInv_ -> "x.grp.mem.inv"
@ -654,6 +664,8 @@ instance StrEncoding ACMEventTag where
"x.direct.del" -> XDirectDel_
"x.grp.inv" -> XGrpInv_
"x.grp.acpt" -> XGrpAcpt_
"x.grp.link.inv" -> XGrpLinkInv_
"x.grp.link.mem" -> XGrpLinkMem_
"x.grp.mem.new" -> XGrpMemNew_
"x.grp.mem.intro" -> XGrpMemIntro_
"x.grp.mem.inv" -> XGrpMemInv_
@ -698,6 +710,8 @@ toCMEventTag msg = case msg of
XDirectDel -> XDirectDel_
XGrpInv _ -> XGrpInv_
XGrpAcpt _ -> XGrpAcpt_
XGrpLinkInv _ -> XGrpLinkInv_
XGrpLinkMem _ -> XGrpLinkMem_
XGrpMemNew _ -> XGrpMemNew_
XGrpMemIntro _ -> XGrpMemIntro_
XGrpMemInv _ _ -> XGrpMemInv_
@ -795,6 +809,8 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
XDirectDel_ -> pure XDirectDel
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo"
XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
@ -853,6 +869,8 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
XDirectDel -> JM.empty
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
XGrpAcpt memId -> o ["memberId" .= memId]
XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
XGrpLinkMem profile -> o ["profile" .= profile]
XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo]
XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]

View File

@ -31,6 +31,7 @@ module Simplex.Chat.Store.Groups
getGroupAndMember,
createNewGroup,
createGroupInvitation,
createGroupInvitedViaLink,
setViaGroupLinkHash,
setGroupInvitationChatItemId,
getGroup,
@ -59,6 +60,8 @@ module Simplex.Chat.Store.Groups
getGroupInvitation,
createNewContactMember,
createNewContactMemberAsync,
createAcceptedMember,
createAcceptedMemberConnection,
getContactViaMember,
setNewContactMemberConnRequest,
getMemberInvitation,
@ -102,6 +105,9 @@ module Simplex.Chat.Store.Groups
createMemberContactInvited,
updateMemberContactInvited,
resetMemberContactFields,
updateMemberProfile,
getXGrpLinkMemReceived,
setXGrpLinkMemReceived,
)
where
@ -412,6 +418,54 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
)
pure $ Right incognitoLdn
createGroupInvitedViaLink :: DB.Connection -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink
db
user@User {userId, userContactId}
Connection {connId, customUserProfileId}
GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile} = do
currentTs <- liftIO getCurrentTime
groupId <- insertGroup_ currentTs
hostMemberId <- insertHost_ currentTs groupId
liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId)
-- using IBUnknown since host is created without contact
void $ createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs
liftIO $ setViaGroupLinkHash db groupId connId
(,) <$> getGroupInfo db user groupId <*> getGroupMemberById db user hostMemberId
where
insertGroup_ currentTs = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
liftIO $ do
DB.execute
db
"INSERT INTO group_profiles (display_name, full_name, description, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(displayName, fullName, description, image, userId, groupPreferences, currentTs, currentTs)
profileId <- insertedRowId db
DB.execute
db
"INSERT INTO groups (group_profile_id, local_display_name, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?)"
(profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
insertedRowId db
insertHost_ currentTs groupId = ExceptT $ do
let fromMemberProfile = profileFromName fromMemberName
withLocalDisplayName db userId fromMemberName $ \localDisplayName -> runExceptT $ do
(_, profileId) <- createNewMemberProfile_ db user fromMemberProfile currentTs
let MemberIdRole {memberId, memberRole} = fromMember
liftIO $ do
DB.execute
db
[sql|
INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (groupId, memberId, memberRole, GCHostMember, GSMemAccepted, fromInvitedBy userContactId IBUnknown)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
)
insertedRowId db
setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO ()
setViaGroupLinkHash db groupId connId =
DB.execute
@ -713,6 +767,47 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
:. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt)
)
createAcceptedMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId)
createAcceptedMember
db
gVar
User {userId, userContactId}
GroupInfo {groupId}
UserContactRequest {localDisplayName, profileId}
memberRole = do
liftIO $
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime
insertMember_ (MemberId memId) createdAt
groupMemberId <- liftIO $ insertedRowId db
pure (groupMemberId, MemberId memId)
where
insertMember_ memberId createdAt =
DB.execute
db
[sql|
INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (groupId, memberId, memberRole, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, createdAt, createdAt)
)
createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
createAcceptedMemberConnection
db
user@User {userId}
(cmdId, agentConnId)
UserContactRequest {cReqChatVRange, userContactLinkId}
groupMemberId
subMode = do
createdAt <- liftIO getCurrentTime
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode
setCommandConnId db user cmdId connId
getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact
getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do
contactId <-
@ -768,9 +863,9 @@ updateGroupMemberStatusById db userId groupMemberId memStatus = do
-- | add new member with profile
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
createNewGroupMember db user gInfo memInfo memCategory memStatus = do
createNewGroupMember db user gInfo memInfo@MemberInfo {profile} memCategory memStatus = do
currentTs <- liftIO getCurrentTime
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memInfo currentTs
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user profile currentTs
let newMember =
NewGroupMember
{ memInfo,
@ -783,8 +878,8 @@ createNewGroupMember db user gInfo memInfo memCategory memStatus = do
}
liftIO $ createNewMember_ db user gInfo newMember currentTs
createNewMemberProfile_ :: DB.Connection -> User -> MemberInfo -> UTCTime -> ExceptT StoreError IO (Text, ProfileId)
createNewMemberProfile_ db User {userId} (MemberInfo _ _ _ Profile {displayName, fullName, image, contactLink, preferences}) createdAt =
createNewMemberProfile_ :: DB.Connection -> User -> Profile -> UTCTime -> ExceptT StoreError IO (Text, ProfileId)
createNewMemberProfile_ db User {userId} Profile {displayName, fullName, image, contactLink, preferences} createdAt =
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
DB.execute
db
@ -960,7 +1055,7 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
(localDisplayName, contactId, memProfileId) <- createContact_ db userId directConnId memberProfile "" (Just groupId) currentTs Nothing
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Just contactId, memProfileId}
Nothing -> do
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memInfo currentTs
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Nothing, memProfileId}
liftIO $ do
member <- createNewMember_ db user gInfo newMember currentTs
@ -1737,3 +1832,36 @@ createMemberContactConn_
connId <- insertedRowId db
setCommandConnId db user cmdId connId
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = False, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnJoined, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile db User {userId} m p'
| displayName == newName = do
liftIO $ updateContactProfile_ db userId profileId p'
pure m {memberProfile = profile}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs
DB.execute
db
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?"
(ldn, currentTs, userId, groupMemberId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
pure $ Right m {localDisplayName = ldn, memberProfile = profile}
where
GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
Profile {displayName = newName} = p'
profile = toLocalProfile profileId p' localAlias
getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
getXGrpLinkMemReceived db mId =
ExceptT . firstRow fromOnly (SEGroupMemberNotFound mId) $
DB.query db "SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?" (Only mId)
setXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> Bool -> IO ()
setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
currentTs <- getCurrentTime
DB.execute
db
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
(xGrpLinkMemReceived, currentTs, mId)

View File

@ -86,6 +86,7 @@ import Simplex.Chat.Migrations.M20231002_conn_initiated
import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash
import Simplex.Chat.Migrations.M20231010_member_settings
import Simplex.Chat.Migrations.M20231019_indexes
import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@ -171,7 +172,8 @@ schemaMigrations =
("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated),
("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash),
("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings),
("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes)
("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes),
("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received)
]
-- | The list of migrations in ascending order by date

View File

@ -515,6 +515,10 @@ instance ToJSON Profile where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
profileFromName :: ContactName -> Profile
profileFromName displayName =
Profile {displayName, fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
-- check if profiles match ignoring preferences
profilesMatch :: LocalProfile -> LocalProfile -> Bool
profilesMatch
@ -621,6 +625,18 @@ instance ToJSON GroupInvitation where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
data GroupLinkInvitation = GroupLinkInvitation
{ fromMember :: MemberIdRole,
fromMemberName :: ContactName,
invitedMember :: MemberIdRole,
groupProfile :: GroupProfile
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON GroupLinkInvitation where
toJSON = J.genericToJSON J.defaultOptions
toEncoding = J.genericToEncoding J.defaultOptions
data MemberIdRole = MemberIdRole
{ memberId :: MemberId,
memberRole :: GroupMemberRole

View File

@ -160,6 +160,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRUserContactLinkCreated u cReq -> ttyUser u $ connReqContact_ "Your new chat address is created!" cReq
CRUserContactLinkDeleted u -> ttyUser u viewUserContactLinkDeleted
CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
CRGroupLinkConnecting u g _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
@ -176,6 +177,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRContactAliasUpdated u c -> ttyUser u $ viewContactAliasUpdated c
CRConnectionAliasUpdated u c -> ttyUser u $ viewConnectionAliasUpdated c
CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
CRGroupMemberUpdated {} -> []
CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' testView "started" ci
@ -235,6 +237,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRGroupLink u g cReq mRole -> ttyUser u $ groupLink_ "Group link:" g cReq mRole
CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
CRAcceptingGroupJoinRequestMember _ g m -> [ttyFullMember m <> ": accepting request to join group " <> ttyGroup' g <> "..."]
CRNoMemberContactCreating u g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " does not have direct connection, creating"]
CRNewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"]
CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m]

View File

@ -195,10 +195,10 @@ testSuspendResume tmp =
testJoinGroup :: HasCallStack => FilePath -> IO ()
testJoinGroup tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat tmp "cath" cathProfile $ \cath ->
withNewTestChat tmp "dan" danProfile $ \dan -> do
withDirectoryServiceCfg tmp testCfgGroupLinkViaContact $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgGroupLinkViaContact "bob" bobProfile $ \bob -> do
withNewTestChatCfg tmp testCfgGroupLinkViaContact "cath" cathProfile $ \cath ->
withNewTestChatCfg tmp testCfgGroupLinkViaContact "dan" danProfile $ \dan -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
cath `connectVia` dsLink

View File

@ -146,6 +146,16 @@ mkCfgCreateGroupDirect cfg = cfg {chatVRange = groupCreateDirectVRange}
groupCreateDirectVRange :: VersionRange
groupCreateDirectVRange = mkVersionRange 1 1
testCfgGroupLinkViaContact :: ChatConfig
testCfgGroupLinkViaContact =
mkCfgGroupLinkViaContact testCfg
mkCfgGroupLinkViaContact :: ChatConfig -> ChatConfig
mkCfgGroupLinkViaContact cfg = cfg {chatVRange = groupLinkViaContactVRange}
groupLinkViaContactVRange :: VersionRange
groupLinkViaContactVRange = mkVersionRange 1 2
createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
createTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefix profile = do
Right db@ChatDatabase {chatStore} <- createChatDatabase (tmp </> dbPrefix) dbKey MCError

View File

@ -64,6 +64,16 @@ chatGroupTests = do
it "own group link" testPlanGroupLinkOwn
it "connecting via group link" testPlanGroupLinkConnecting
it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin
describe "group links without contact" $ do
it "join via group link without creating contact" testGroupLinkNoContact
it "group link member role" testGroupLinkNoContactMemberRole
it "host incognito" testGroupLinkNoContactHostIncognito
it "invitee incognito" testGroupLinkNoContactInviteeIncognito
it "host profile received" testGroupLinkNoContactHostProfileReceived
it "existing contact merged" testGroupLinkNoContactExistingContactMerged
describe "group links without contact connection plan" $ do
it "group link without contact - known group" testPlanGroupLinkNoContactKnown
it "group link without contact - connecting" testPlanGroupLinkNoContactConnecting
describe "group message errors" $ do
it "show message decryption error" testGroupMsgDecryptError
it "should report ratchet de-synchronization, synchronize ratchets" testGroupSyncRatchet
@ -280,7 +290,7 @@ testGroupShared alice bob cath checkMessages = do
testNewGroupIncognito :: HasCallStack => FilePath -> IO ()
testNewGroupIncognito =
testChat2 aliceProfile bobProfile $
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
@ -1735,7 +1745,7 @@ testGroupAsync tmp = do
testGroupLink :: HasCallStack => FilePath -> IO ()
testGroupLink =
testChat3 aliceProfile bobProfile cathProfile $
testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/g team"
alice <## "group #team is created"
@ -1836,7 +1846,7 @@ testGroupLink =
testGroupLinkDeleteGroupRejoin :: HasCallStack => FilePath -> IO ()
testGroupLinkDeleteGroupRejoin =
testChat2 aliceProfile bobProfile $
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
@ -1892,7 +1902,7 @@ testGroupLinkDeleteGroupRejoin =
testGroupLinkContactUsed :: HasCallStack => FilePath -> IO ()
testGroupLinkContactUsed =
testChat2 aliceProfile bobProfile $
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
@ -1925,7 +1935,7 @@ testGroupLinkContactUsed =
testGroupLinkIncognitoMembership :: HasCallStack => FilePath -> IO ()
testGroupLinkIncognitoMembership =
testChat4 aliceProfile bobProfile cathProfile danProfile $
testChatCfg4 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
-- bob connected incognito to alice
alice ##> "/c"
@ -2098,7 +2108,7 @@ testGroupLinkUnusedHostContactDeleted =
(bob </)
bob `hasContactProfiles` ["bob"]
where
cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
cfg = mkCfgGroupLinkViaContact $ testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
bobLeaveDeleteGroup :: HasCallStack => TestCC -> TestCC -> String -> IO ()
bobLeaveDeleteGroup alice bob group = do
bob ##> ("/l " <> group)
@ -2136,7 +2146,7 @@ testGroupLinkIncognitoUnusedHostContactsDeleted =
(bob </)
bob `hasContactProfiles` ["bob"]
where
cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
cfg = mkCfgGroupLinkViaContact $ testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
createGroupBobIncognito :: HasCallStack => TestCC -> TestCC -> String -> String -> IO String
createGroupBobIncognito alice bob group bobsAliceContact = do
alice ##> ("/g " <> group)
@ -2174,7 +2184,7 @@ testGroupLinkIncognitoUnusedHostContactsDeleted =
testGroupLinkMemberRole :: HasCallStack => FilePath -> IO ()
testGroupLinkMemberRole =
testChat3 aliceProfile bobProfile cathProfile $
testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/g team"
alice <## "group #team is created"
@ -2309,7 +2319,7 @@ testGroupLinkLeaveDelete =
testPlanGroupLinkOkKnown :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkOkKnown =
testChat2 aliceProfile bobProfile $
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
@ -2352,7 +2362,7 @@ testPlanGroupLinkOkKnown =
testPlanHostContactDeletedGroupLinkKnown :: HasCallStack => FilePath -> IO ()
testPlanHostContactDeletedGroupLinkKnown =
testChat2 aliceProfile bobProfile $
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
@ -2398,7 +2408,7 @@ testPlanHostContactDeletedGroupLinkKnown =
testPlanGroupLinkOwn :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkOwn tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChatCfg tmp testCfgGroupLinkViaContact "alice" aliceProfile $ \alice -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
@ -2458,13 +2468,13 @@ testPlanGroupLinkOwn tmp =
testPlanGroupLinkConnecting :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkConnecting tmp = do
gLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
gLink <- withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
getGroupLink alice "team" GRMember True
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
threadDelay 100000
bob ##> ("/c " <> gLink)
@ -2478,13 +2488,13 @@ testPlanGroupLinkConnecting tmp = do
bob <## "group link: connecting, allowed to reconnect"
threadDelay 100000
withTestChat tmp "alice" $ \alice -> do
withTestChatCfg tmp cfg "alice" $ \alice -> do
alice
<### [ "1 group links active",
"#team: group is empty",
"bob (Bob): accepting request to join group #team..."
]
withTestChat tmp "bob" $ \bob -> do
withTestChatCfg tmp cfg "bob" $ \bob -> do
threadDelay 500000
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: connecting"
@ -2495,10 +2505,12 @@ testPlanGroupLinkConnecting tmp = do
bob ##> ("/c " <> gLink)
bob <## "group link: connecting"
where
cfg = testCfgGroupLinkViaContact
testPlanGroupLinkLeaveRejoin :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkLeaveRejoin =
testChat2 aliceProfile bobProfile $
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
@ -2578,6 +2590,296 @@ testPlanGroupLinkLeaveRejoin =
bob <## "group link: known group #team_1"
bob <## "use #team_1 <message> to send messages"
testGroupLinkNoContact :: HasCallStack => FilePath -> IO ()
testGroupLinkNoContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ alice <## "#team: bob joined the group",
do
bob <## "#team: joining the group..."
bob <## "#team: you joined the group"
]
threadDelay 100000
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
alice @@@ [("#team", "connected")]
bob @@@ [("#team", "connected")]
alice ##> "/contacts"
bob ##> "/contacts"
alice #> "#team hello"
bob <# "#team alice> hello"
bob #> "#team hi there"
alice <# "#team bob> hi there"
testGroupLinkNoContactMemberRole :: HasCallStack => FilePath -> IO ()
testGroupLinkNoContactMemberRole =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team observer"
gLink <- getGroupLink alice "team" GRObserver True
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ alice <## "#team: bob joined the group",
do
bob <## "#team: joining the group..."
bob <## "#team: you joined the group"
]
threadDelay 100000
alice ##> "/ms team"
alice
<### [ "alice (Alice): owner, you, created group",
"bob (Bob): observer, invited, connected"
]
bob ##> "/ms team"
bob
<### [ "alice (Alice): owner, host, connected",
"bob (Bob): observer, you, connected"
]
bob ##> "#team hi there"
bob <## "#team: you don't have permission to send messages"
alice ##> "/mr #team bob member"
alice <## "#team: you changed the role of bob from observer to member"
bob <## "#team: alice changed your role from observer to member"
bob #> "#team hey now"
alice <# "#team bob> hey now"
testGroupLinkNoContactHostIncognito :: HasCallStack => FilePath -> IO ()
testGroupLinkNoContactHostIncognito =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g i team"
aliceIncognito <- getTermLine alice
alice <## ("group #team is created, your incognito profile for this group is " <> aliceIncognito)
alice <## "to add members use /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ alice <## "#team: bob joined the group",
do
bob <## "#team: joining the group..."
bob <## "#team: you joined the group"
]
threadDelay 100000
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
alice @@@ [("#team", "connected")]
bob @@@ [("#team", "connected")]
alice ##> "/contacts"
bob ##> "/contacts"
alice ?#> "#team hello"
bob <# ("#team " <> aliceIncognito <> "> hello")
bob #> "#team hi there"
alice ?<# "#team bob> hi there"
testGroupLinkNoContactInviteeIncognito :: HasCallStack => FilePath -> IO ()
testGroupLinkNoContactInviteeIncognito =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/c i " <> gLink)
bobIncognito <- getTermLine bob
bob <## "connection request sent incognito!"
alice <## (bobIncognito <> ": accepting request to join group #team...")
concurrentlyN_
[ alice <## ("#team: " <> bobIncognito <> " joined the group"),
do
bob <## "#team: joining the group..."
bob <## ("#team: you joined the group incognito as " <> bobIncognito)
]
threadDelay 100000
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
alice @@@ [("#team", "connected")]
bob @@@ [("#team", "connected")]
alice ##> "/contacts"
bob ##> "/contacts"
alice #> "#team hello"
bob ?<# "#team alice> hello"
bob ?#> "#team hi there"
alice <# ("#team " <> bobIncognito <> "> hi there")
testGroupLinkNoContactHostProfileReceived :: HasCallStack => FilePath -> IO ()
testGroupLinkNoContactHostProfileReceived =
testChat2 aliceProfile bobProfile $
\alice bob -> do
let profileImage = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="
alice ##> ("/set profile image " <> profileImage)
alice <## "profile image updated"
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ alice <## "#team: bob joined the group",
do
bob <## "#team: joining the group..."
bob <## "#team: you joined the group"
]
threadDelay 100000
aliceImage <- getProfilePictureByName bob "alice"
aliceImage `shouldBe` Just profileImage
testGroupLinkNoContactExistingContactMerged :: HasCallStack => FilePath -> IO ()
testGroupLinkNoContactExistingContactMerged =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob_1 (Bob): accepting request to join group #team..."
concurrentlyN_
[ do
alice <## "#team: bob_1 joined the group"
alice <## "contact and member are merged: bob, #team bob_1"
alice <## "use @bob <message> to send messages",
do
bob <## "#team: joining the group..."
bob <## "#team: you joined the group"
bob <## "contact and member are merged: alice, #team alice_1"
bob <## "use @alice <message> to send messages"
]
threadDelay 100000
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
alice <##> bob
alice @@@ [("#team", "connected"), ("@bob", "hey")]
bob @@@ [("#team", "connected"), ("@alice", "hey")]
alice ##> "/contacts"
alice <## "bob (Bob)"
bob ##> "/contacts"
bob <## "alice (Alice)"
alice #> "#team hello"
bob <# "#team alice> hello"
bob #> "#team hi there"
alice <# "#team bob> hi there"
testPlanGroupLinkNoContactKnown :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkNoContactKnown =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: ok to connect"
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
alice <## "bob (Bob): accepting request to join group #team..."
concurrentlyN_
[ alice <## "#team: bob joined the group",
do
bob <## "#team: joining the group..."
bob <## "#team: you joined the group"
]
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
let gLinkSchema2 = linkAnotherSchema gLink
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
bob ##> ("/c " <> gLink)
bob <## "group link: known group #team"
bob <## "use #team <message> to send messages"
testPlanGroupLinkNoContactConnecting :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkNoContactConnecting tmp = do
gLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
alice ##> "/create link #team"
getGroupLink alice "team" GRMember True
withNewTestChat tmp "bob" bobProfile $ \bob -> do
threadDelay 100000
bob ##> ("/c " <> gLink)
bob <## "connection request sent!"
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: connecting, allowed to reconnect"
let gLinkSchema2 = linkAnotherSchema gLink
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
bob <## "group link: connecting, allowed to reconnect"
threadDelay 100000
withTestChat tmp "alice" $ \alice -> do
alice
<### [ "1 group links active",
"#team: group is empty",
"bob (Bob): accepting request to join group #team..."
]
withTestChat tmp "bob" $ \bob -> do
threadDelay 500000
bob <## "#team: joining the group..."
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: connecting to group #team"
let gLinkSchema2 = linkAnotherSchema gLink
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
bob <## "group link: connecting to group #team"
bob ##> ("/c " <> gLink)
bob <## "group link: connecting to group #team"
testGroupMsgDecryptError :: HasCallStack => FilePath -> IO ()
testGroupMsgDecryptError tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
@ -3183,7 +3485,7 @@ testMergeContactMultipleMembers =
testMergeGroupLinkHostMultipleContacts :: HasCallStack => FilePath -> IO ()
testMergeGroupLinkHostMultipleContacts =
testChat2 bobProfile cathProfile $
testChatCfg2 testCfgGroupLinkViaContact bobProfile cathProfile $
\bob cath -> do
connectUsers bob cath
@ -3412,7 +3714,7 @@ testMemberContactInvitedConnectionReplaced tmp = do
testMemberContactIncognito :: HasCallStack => FilePath -> IO ()
testMemberContactIncognito =
testChat3 aliceProfile bobProfile cathProfile $
testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $
\alice bob cath -> do
-- create group, bob joins incognito
alice ##> "/g team"

View File

@ -17,12 +17,14 @@ import Data.List (isPrefixOf, isSuffixOf)
import Data.Maybe (fromMaybe)
import Data.String
import qualified Data.Text as T
import Database.SQLite.Simple (Only (..))
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig)
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Profiles (getUserContactProfiles)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Store.SQLite (withTransaction)
import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Version
import System.Directory (doesFileExist)
@ -433,6 +435,12 @@ getContactProfiles cc = do
profiles <- withTransaction (chatStore $ chatController cc) $ \db -> getUserContactProfiles db user
pure $ map (\Profile {displayName} -> displayName) profiles
getProfilePictureByName :: TestCC -> String -> IO (Maybe String)
getProfilePictureByName cc displayName =
withTransaction (chatStore $ chatController cc) $ \db ->
maybeFirstRow fromOnly $
DB.query db "SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName)
lastItemId :: HasCallStack => TestCC -> IO String
lastItemId cc = do
cc ##> "/last_item_id"

View File

@ -122,7 +122,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
it "x.msg.new chat message with chat version range" $
"{\"v\":\"1-2\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
"{\"v\":\"1-3\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
it "x.msg.new quote" $
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}"
@ -232,13 +232,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
it "x.grp.mem.new with member chat version range" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-2\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-3\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
it "x.grp.mem.intro" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
it "x.grp.mem.intro with member chat version range" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-2\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-3\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
it "x.grp.mem.inv" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
@ -250,7 +250,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq}
it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-2\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-3\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing}
it "x.grp.mem.info" $
"{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"