core: relax contact probing: don't send probe hashes to new contacts except group link hosts; still send probe hashes to group members (#3180)
This commit is contained in:
spaced4ndy
GitHub
parent
c738c6c522
commit
ab46cbc5dd
@ -39,7 +39,6 @@ import Data.Fixed (div')
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
import Data.List (find, foldl', isSuffixOf, partition, sortOn)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
@ -3106,7 +3105,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
setActive $ ActiveC c
|
||||
showToast (c <> "> ") "connected"
|
||||
when (contactConnInitiated conn) $ do
|
||||
probeMatchingContactsAndMembers ct (contactConnIncognito ct)
|
||||
let Connection {groupLinkId} = conn
|
||||
doProbeContacts = isJust groupLinkId
|
||||
probeMatchingContactsAndMembers ct (contactConnIncognito ct) doProbeContacts
|
||||
withStore' $ \db -> resetContactConnInitiated db user conn
|
||||
forM_ viaUserContactLink $ \userContactLinkId ->
|
||||
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
|
||||
@ -3125,7 +3126,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
|
||||
notifyMemberConnected gInfo m $ Just ct
|
||||
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
|
||||
SENT msgId -> do
|
||||
sentMsgDeliveryEvent conn msgId
|
||||
checkSndInlineFTComplete conn msgId
|
||||
@ -3143,8 +3144,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
withStore' $ \db -> setConnectionVerified db user connId Nothing
|
||||
let ct' = ct {activeConn = conn {connectionCode = Nothing}} :: Contact
|
||||
ratchetSyncEventItem ct'
|
||||
toView $ CRContactVerificationReset user ct'
|
||||
createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent RCEVerificationCodeReset) Nothing
|
||||
securityCodeChanged ct'
|
||||
_ -> ratchetSyncEventItem ct
|
||||
where
|
||||
processErr cryptoErr = do
|
||||
@ -3298,7 +3298,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
when (connStatus == ConnReady) $ do
|
||||
notifyMemberConnected gInfo m $ Just ct
|
||||
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
|
||||
MSG msgMeta _msgFlags msgBody -> do
|
||||
cmdId <- createAckCmd conn
|
||||
withAckMessage agentConnId cmdId msgMeta $ do
|
||||
@ -3691,8 +3691,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
setActive $ ActiveG g
|
||||
showToast ("#" <> g) $ "member " <> c <> " is connected"
|
||||
|
||||
probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> m ()
|
||||
probeMatchingContactsAndMembers ct connectedIncognito = do
|
||||
probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m ()
|
||||
probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do
|
||||
gVar <- asks idsDrg
|
||||
contactMerge <- readTVarIO =<< asks contactMergeEnabled
|
||||
if contactMerge && not connectedIncognito
|
||||
@ -3703,7 +3703,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- sendProbe -> sendProbeHashes (currently)
|
||||
-- sendProbeHashes -> sendProbe (reversed - change order in code, may add delay)
|
||||
sendProbe probe
|
||||
cs <- map COMContact <$> withStore' (\db -> getMatchingContacts db user ct)
|
||||
cs <- if doProbeContacts
|
||||
then map COMContact <$> withStore' (\db -> getMatchingContacts db user ct)
|
||||
else pure []
|
||||
ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db user ct)
|
||||
sendProbeHashes (cs <> ms) probe probeId
|
||||
else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
|
||||
@ -4363,32 +4365,18 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
COMContact <$$> mergeContacts c1 c2
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing
|
||||
COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId}
|
||||
| profilesMatch p1 p2 -> case memberContactId of
|
||||
Nothing -> do
|
||||
void . sendDirectContactMessage c1 $ XInfoProbeOk probe
|
||||
COMContact <$$> associateMemberAndContact c1 m2
|
||||
Just mCtId
|
||||
| mCtId /= cId1 -> do
|
||||
void . sendDirectContactMessage c1 $ XInfoProbeOk probe
|
||||
mCt <- withStore $ \db -> getContact db user mCtId
|
||||
COMContact <$$> mergeContacts c1 mCt
|
||||
| otherwise -> messageWarning "probeMatch ignored: same contact id" >> pure Nothing
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match" >> pure Nothing
|
||||
| isNothing memberContactId && profilesMatch p1 p2 -> do
|
||||
void . sendDirectContactMessage c1 $ XInfoProbeOk probe
|
||||
COMContact <$$> associateMemberAndContact c1 m2
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing
|
||||
COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing
|
||||
COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} ->
|
||||
case cgm2 of
|
||||
COMContact c2@Contact {contactId = cId2, profile = p2}
|
||||
| memberCurrent m1 && profilesMatch p1 p2 -> case memberContactId of
|
||||
Nothing -> do
|
||||
void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
|
||||
COMContact <$$> associateMemberAndContact c2 m1
|
||||
Just mCtId
|
||||
| mCtId /= cId2 -> do
|
||||
void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
|
||||
mCt <- withStore $ \db -> getContact db user mCtId
|
||||
COMContact <$$> mergeContacts c2 mCt
|
||||
| otherwise -> messageWarning "probeMatch ignored: same contact id" >> pure Nothing
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member not current" >> pure Nothing
|
||||
COMContact c2@Contact {profile = p2}
|
||||
| memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do
|
||||
void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
|
||||
COMContact <$$> associateMemberAndContact c2 m1
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing
|
||||
COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing
|
||||
|
||||
xInfoProbeOk :: ContactOrMember -> Probe -> m ()
|
||||
@ -4400,24 +4388,15 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
Just (COMContact c2@Contact {contactId = cId2})
|
||||
| cId1 /= cId2 -> void $ mergeContacts c1 c2
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
|
||||
Just (COMGroupMember m2@GroupMember {memberContactId}) ->
|
||||
case memberContactId of
|
||||
Nothing -> void $ associateMemberAndContact c1 m2
|
||||
Just mCtId
|
||||
| mCtId /= cId1 -> do
|
||||
mCt <- withStore $ \db -> getContact db user mCtId
|
||||
void $ mergeContacts c1 mCt
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
|
||||
Just (COMGroupMember m2@GroupMember {memberContactId})
|
||||
| isNothing memberContactId -> void $ associateMemberAndContact c1 m2
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
|
||||
_ -> pure ()
|
||||
COMGroupMember m1@GroupMember {memberContactId} ->
|
||||
case cgm2 of
|
||||
Just (COMContact c2@Contact {contactId = cId2}) -> case memberContactId of
|
||||
Nothing -> void $ associateMemberAndContact c2 m1
|
||||
Just mCtId
|
||||
| mCtId /= cId2 -> do
|
||||
mCt <- withStore $ \db -> getContact db user mCtId
|
||||
void $ mergeContacts c2 mCt
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
|
||||
Just (COMContact c2)
|
||||
| isNothing memberContactId -> void $ associateMemberAndContact c2 m1
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
|
||||
Just (COMGroupMember _) -> messageWarning "xInfoProbeOk ignored: members are not matched with members"
|
||||
_ -> pure ()
|
||||
|
||||
@ -4540,7 +4519,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
merge c1' c2' = do
|
||||
c2'' <- withStore $ \db -> mergeContactRecords db user c1' c2'
|
||||
toView $ CRContactsMerged user c1' c2' c2''
|
||||
when (directOrUsed c2'') $ showSecurityCodeChanged c2''
|
||||
pure $ Just c2''
|
||||
where
|
||||
showSecurityCodeChanged mergedCt = do
|
||||
let sc1_ = contactSecurityCode c1'
|
||||
sc2_ = contactSecurityCode c2'
|
||||
scMerged_ = contactSecurityCode mergedCt
|
||||
case (sc1_, sc2_) of
|
||||
(Just sc1, Nothing)
|
||||
| scMerged_ /= Just sc1 -> securityCodeChanged mergedCt
|
||||
| otherwise -> pure ()
|
||||
(Nothing, Just sc2)
|
||||
| scMerged_ /= Just sc2 -> securityCodeChanged mergedCt
|
||||
| otherwise -> pure ()
|
||||
_ -> pure ()
|
||||
|
||||
associateMemberAndContact :: Contact -> GroupMember -> m (Maybe Contact)
|
||||
associateMemberAndContact c m = do
|
||||
@ -4796,9 +4789,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
forM_ mContent_ $ \mc -> do
|
||||
ci <- saveRcvChatItem user (CDDirectRcv mCt') msg msgMeta (CIRcvMsgContent mc)
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat mCt') ci)
|
||||
securityCodeChanged ct = do
|
||||
toView $ CRContactVerificationReset user ct
|
||||
createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
|
||||
|
||||
securityCodeChanged :: Contact -> m ()
|
||||
securityCodeChanged ct = do
|
||||
toView $ CRContactVerificationReset user ct
|
||||
createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
|
||||
|
||||
directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
|
||||
directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
|
||||
|
||||
@ -159,7 +159,7 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
JOIN connections c ON c.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.deleted = 0
|
||||
ORDER BY c.connection_id DESC
|
||||
ORDER BY c.created_at DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, cReqHash)
|
||||
@ -517,7 +517,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
|
||||
ORDER BY c.connection_id DESC
|
||||
ORDER BY c.created_at DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, xContactId)
|
||||
@ -667,7 +667,7 @@ getContact_ :: DB.Connection -> User -> Int64 -> Bool -> ExceptT StoreError IO C
|
||||
getContact_ db user@User {userId} contactId deleted =
|
||||
ExceptT . fmap join . firstRow (toContactOrError user) (SEContactNotFound contactId) $
|
||||
DB.query
|
||||
db
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
@ -686,10 +686,11 @@ getContact_ db user@User {userId} contactId deleted =
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_connection_id DESC
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
)
|
||||
|
||||
@ -107,7 +107,7 @@ import Control.Monad.IO.Class
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Either (rights)
|
||||
import Data.Int (Int64)
|
||||
import Data.List (sortOn)
|
||||
import Data.List (partition, sortOn)
|
||||
import Data.Maybe (fromMaybe, isNothing, catMaybes, isJust)
|
||||
import Data.Ord (Down (..))
|
||||
import Data.Text (Text)
|
||||
@ -695,31 +695,21 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
|
||||
)
|
||||
|
||||
getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact
|
||||
getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
|
||||
ExceptT $
|
||||
firstRow (toContact user) (SEContactNotFoundByMemberId groupMemberId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, 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, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
|
||||
JOIN connections c ON c.connection_id = (
|
||||
SELECT max(cc.connection_id)
|
||||
FROM connections cc
|
||||
where cc.contact_id = ct.contact_id
|
||||
)
|
||||
JOIN group_members m ON m.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do
|
||||
contactId <-
|
||||
ExceptT $
|
||||
firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT ct.contact_id
|
||||
FROM group_members m
|
||||
JOIN contacts ct ON ct.contact_id = m.contact_id
|
||||
WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
getContact db user contactId
|
||||
|
||||
setNewContactMemberConnRequest :: DB.Connection -> User -> GroupMember -> ConnReqInvitation -> IO ()
|
||||
setNewContactMemberConnRequest db User {userId} GroupMember {groupMemberId} connRequest = do
|
||||
@ -1041,37 +1031,21 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
|
||||
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
|
||||
|
||||
getViaGroupContact :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact)
|
||||
getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
|
||||
maybeFirstRow toContact' $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, 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, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
|
||||
JOIN connections c ON c.connection_id = (
|
||||
SELECT max(cc.connection_id)
|
||||
FROM connections cc
|
||||
where cc.contact_id = ct.contact_id
|
||||
)
|
||||
JOIN groups g ON g.group_id = ct.via_group
|
||||
JOIN group_members m ON m.group_id = g.group_id AND m.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
where
|
||||
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)) :. ConnectionRow -> Contact
|
||||
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
|
||||
activeConn = toConnection connRow
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do
|
||||
contactId_ <-
|
||||
maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT ct.contact_id
|
||||
FROM group_members m
|
||||
JOIN groups g ON g.group_id = m.group_id
|
||||
JOIN contacts ct ON ct.contact_id = m.contact_id AND ct.via_group = g.group_id
|
||||
WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_
|
||||
|
||||
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
|
||||
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences}
|
||||
@ -1258,7 +1232,16 @@ matchReceivedProbe db user@User {userId} from (Probe probe) = do
|
||||
db
|
||||
"INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(ctId, gmId, probe, probeHash, userId, currentTs, currentTs)
|
||||
catMaybes <$> mapM (getContactOrMember_ db user) cgmIds
|
||||
let cgmIds' = filterFirstContactId cgmIds
|
||||
catMaybes <$> mapM (getContactOrMember_ db user) cgmIds'
|
||||
where
|
||||
filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)]
|
||||
filterFirstContactId cgmIds = do
|
||||
let (ctIds, memIds) = partition (\(ctId, _, _) -> isJust ctId) cgmIds
|
||||
ctIds' = case ctIds of
|
||||
[] -> []
|
||||
(x : _) -> [x]
|
||||
ctIds' <> memIds
|
||||
|
||||
matchReceivedProbeHash :: DB.Connection -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
|
||||
matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
|
||||
@ -1284,7 +1267,7 @@ matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
|
||||
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db user cgmIds
|
||||
|
||||
matchSentProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
|
||||
matchSentProbe db user@User {userId} _from (Probe probe) =
|
||||
matchSentProbe db user@User {userId} _from (Probe probe) = do
|
||||
cgmIds $>>= getContactOrMember_ db user
|
||||
where
|
||||
(ctId, gmId) = contactOrMemberIds _from
|
||||
@ -1311,11 +1294,10 @@ getContactOrMember_ db user ids =
|
||||
(_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db user gId gmId
|
||||
_ -> throwError $ SEInternalError ""
|
||||
|
||||
-- connection being verified and connection level 0 have priority over requested merge direction;
|
||||
-- if requested merge direction is overruled, keepLDN is kept
|
||||
-- if requested merge direction is overruled (toFromContacts), keepLDN is kept
|
||||
mergeContactRecords :: DB.Connection -> User -> Contact -> Contact -> ExceptT StoreError IO Contact
|
||||
mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN} from = do
|
||||
let (toCt, fromCt) = checkToFromContacts
|
||||
let (toCt, fromCt) = toFromContacts to from
|
||||
Contact {contactId = toContactId, localDisplayName = toLDN} = toCt
|
||||
Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt
|
||||
liftIO $ do
|
||||
@ -1342,18 +1324,6 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN
|
||||
db
|
||||
"UPDATE chat_items SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
|
||||
(toContactId, currentTs, fromContactId, userId)
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE sent_probes SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
|
||||
(toContactId, currentTs, fromContactId, userId)
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE sent_probe_hashes SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
|
||||
(toContactId, currentTs, fromContactId, userId)
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE received_probes SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
|
||||
(toContactId, currentTs, fromContactId, userId)
|
||||
DB.executeNamed
|
||||
db
|
||||
[sql|
|
||||
@ -1384,16 +1354,16 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN
|
||||
(keepLDN, currentTs, userId, toLDN)
|
||||
getContact db user toContactId
|
||||
where
|
||||
checkToFromContacts :: (Contact, Contact)
|
||||
checkToFromContacts
|
||||
| vrfFrom && not vrfTo = (from, to)
|
||||
| dirFrom && not vrfTo && not dirTo = (from, to)
|
||||
| otherwise = (to, from)
|
||||
toFromContacts :: Contact -> Contact -> (Contact, Contact)
|
||||
toFromContacts c1 c2
|
||||
| d1 && not d2 = (c1, c2)
|
||||
| d2 && not d1 = (c2, c1)
|
||||
| ctCreatedAt c1 <= ctCreatedAt c2 = (c1, c2)
|
||||
| otherwise = (c2, c1)
|
||||
where
|
||||
vrfTo = isJust $ contactSecurityCode to
|
||||
vrfFrom = isJust $ contactSecurityCode from
|
||||
dirTo = let Contact {activeConn = Connection {connLevel = clTo}} = to in clTo == 0
|
||||
dirFrom = let Contact {activeConn = Connection {connLevel = clFrom}} = from in clFrom == 0
|
||||
d1 = directOrUsed c1
|
||||
d2 = directOrUsed c2
|
||||
ctCreatedAt Contact {createdAt} = createdAt
|
||||
|
||||
associateMemberWithContactRecord :: DB.Connection -> User -> Contact -> GroupMember -> IO ()
|
||||
associateMemberWithContactRecord
|
||||
|
||||
@ -517,10 +517,11 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_connection_id DESC
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
)
|
||||
|
||||
@ -41,9 +41,9 @@ chatDirectTests = do
|
||||
it "direct timed message" testDirectTimedMessage
|
||||
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
|
||||
it "should send multiline message" testMultilineMessage
|
||||
describe "contact merge" $ do
|
||||
it "merge duplicate contacts" testContactMerge
|
||||
it "new contact should merge with multiple existing contacts" testMergeContactMultipleContacts
|
||||
describe "duplicate contacts" $ do
|
||||
it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate
|
||||
it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate
|
||||
describe "SMP servers" $ do
|
||||
it "get and set SMP servers" testGetSetSMPServers
|
||||
it "test SMP server connection" testTestSMPServerConnection
|
||||
@ -170,44 +170,13 @@ testAddContact = versionTestMatrix2 runTestAddContact
|
||||
alice #$> ("/_read chat @2", id, "ok")
|
||||
bob #$> ("/_read chat @2", id, "ok")
|
||||
|
||||
testContactMerge :: HasCallStack => FilePath -> IO ()
|
||||
testContactMerge =
|
||||
testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateContactsSeparate =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
|
||||
alice ##> "/c"
|
||||
inv' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv')
|
||||
bob <## "confirmation sent!"
|
||||
concurrentlyN_
|
||||
[ alice
|
||||
<### [ "bob_1 (Bob): contact is connected",
|
||||
"contact bob_1 is merged into bob",
|
||||
"use @bob <message> to send messages"
|
||||
],
|
||||
bob
|
||||
<### [ "alice_1 (Alice): contact is connected",
|
||||
"contact alice_1 is merged into alice",
|
||||
"use @alice <message> to send messages"
|
||||
]
|
||||
]
|
||||
alice <##> bob
|
||||
alice @@@ [("@bob", "hey")]
|
||||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob @@@ [("@alice", "hey")]
|
||||
bob `hasContactProfiles` ["bob", "alice"]
|
||||
|
||||
testMergeContactMultipleContacts :: HasCallStack => FilePath -> IO ()
|
||||
testMergeContactMultipleContacts =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
bob ##> "/contact_merge off"
|
||||
bob <## "ok"
|
||||
|
||||
connectUsers alice bob
|
||||
|
||||
alice ##> "/c"
|
||||
inv' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv')
|
||||
@ -216,42 +185,56 @@ testMergeContactMultipleContacts =
|
||||
(alice <## "bob_1 (Bob): contact is connected")
|
||||
(bob <## "alice_1 (Alice): contact is connected")
|
||||
|
||||
alice <##> bob
|
||||
alice #> "@bob_1 1"
|
||||
bob <# "alice_1> 1"
|
||||
bob #> "@alice_1 2"
|
||||
alice <# "bob_1> 2"
|
||||
|
||||
alice @@@ [("@bob", "hey"), ("@bob_1", "2")]
|
||||
alice `hasContactProfiles` ["alice", "bob", "bob"]
|
||||
bob @@@ [("@alice", "hey"), ("@alice_1", "2")]
|
||||
bob `hasContactProfiles` ["bob", "alice", "alice"]
|
||||
|
||||
threadDelay 500000
|
||||
testDuplicateContactsMultipleSeparate :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateContactsMultipleSeparate =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
|
||||
bob ##> "/contact_merge on"
|
||||
bob <## "ok"
|
||||
alice ##> "/c"
|
||||
inv' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv')
|
||||
bob <## "confirmation sent!"
|
||||
concurrently_
|
||||
(alice <## "bob_1 (Bob): contact is connected")
|
||||
(bob <## "alice_1 (Alice): contact is connected")
|
||||
|
||||
alice ##> "/c"
|
||||
inv'' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv'')
|
||||
bob <## "confirmation sent!"
|
||||
concurrentlyN_
|
||||
[ alice
|
||||
<### [ "bob_2 (Bob): contact is connected",
|
||||
StartsWith "contact bob_2 is merged into bob",
|
||||
StartsWith "use @bob",
|
||||
StartsWith "contact bob_1 is merged into bob",
|
||||
StartsWith "use @bob"
|
||||
],
|
||||
bob
|
||||
<### [ "alice_2 (Alice): contact is connected",
|
||||
StartsWith "contact alice_2 is merged into alice",
|
||||
StartsWith "use @alice",
|
||||
StartsWith "contact alice_1 is merged into alice",
|
||||
StartsWith "use @alice"
|
||||
]
|
||||
]
|
||||
concurrently_
|
||||
(alice <## "bob_2 (Bob): contact is connected")
|
||||
(bob <## "alice_2 (Alice): contact is connected")
|
||||
|
||||
alice <##> bob
|
||||
alice #> "@bob_1 1"
|
||||
bob <# "alice_1> 1"
|
||||
bob #> "@alice_1 2"
|
||||
alice <# "bob_1> 2"
|
||||
alice #> "@bob_2 3"
|
||||
bob <# "alice_2> 3"
|
||||
bob #> "@alice_2 4"
|
||||
alice <# "bob_2> 4"
|
||||
|
||||
alice ##> "/contacts"
|
||||
alice <## "bob (Bob)"
|
||||
alice <### ["bob (Bob)", "bob_1 (Bob)", "bob_2 (Bob)"]
|
||||
bob ##> "/contacts"
|
||||
bob <## "alice (Alice)"
|
||||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["bob", "alice"]
|
||||
bob <### ["alice (Alice)", "alice_1 (Alice)", "alice_2 (Alice)"]
|
||||
alice `hasContactProfiles` ["alice", "bob", "bob", "bob"]
|
||||
bob `hasContactProfiles` ["bob", "alice", "alice", "alice"]
|
||||
|
||||
testContactClear :: HasCallStack => FilePath -> IO ()
|
||||
testContactClear =
|
||||
|
||||
@ -75,12 +75,9 @@ chatGroupTests = do
|
||||
it "members have different local display names in different groups" testNoDirectDifferentLDNs
|
||||
describe "merge members and contacts" $ do
|
||||
it "new member should merge with existing contact" testMergeMemberExistingContact
|
||||
it "new member should merge with multiple existing contacts" testMergeMemberMultipleContacts
|
||||
it "new contact should merge with existing member" testMergeContactExistingMember
|
||||
it "new contact should merge with existing member with associated contact" testMergeContactExistingMemberWithContact
|
||||
it "new contact should merge with multiple existing members" testMergeContactMultipleMembers
|
||||
it "new contact should merge with both existing members and contacts" testMergeContactExistingMembersAndContacts
|
||||
it "new member contact is merged with existing contact" testMergeMemberContact
|
||||
it "new group link host contact should merge with single existing contact out of multiple" testMergeGroupLinkHostMultipleContacts
|
||||
describe "create member contact" $ do
|
||||
it "create contact with group member with invitation message" testMemberContactMessage
|
||||
it "create contact with group member without invitation message" testMemberContactNoMessage
|
||||
@ -2788,76 +2785,6 @@ testMergeMemberExistingContact =
|
||||
alice `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeMemberMultipleContacts :: HasCallStack => FilePath -> IO ()
|
||||
testMergeMemberMultipleContacts =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/contact_merge off"
|
||||
alice <## "ok"
|
||||
|
||||
connectUsers alice bob
|
||||
connectUsers alice cath
|
||||
|
||||
alice ##> "/c"
|
||||
inv' <- getInvitation alice
|
||||
cath ##> ("/c " <> inv')
|
||||
cath <## "confirmation sent!"
|
||||
concurrently_
|
||||
(alice <## "cath_1 (Catherine): contact is connected")
|
||||
(cath <## "alice_1 (Alice): contact is connected")
|
||||
|
||||
alice `hasContactProfiles` ["alice", "bob", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "alice"]
|
||||
|
||||
alice ##> "/contact_merge on"
|
||||
alice <## "ok"
|
||||
|
||||
createGroup2 "team" bob cath
|
||||
bob ##> "/a #team alice"
|
||||
bob <## "invitation to join the group #team sent to alice"
|
||||
alice <## "#team: bob invites you to join the group as member"
|
||||
alice <## "use /j team to accept"
|
||||
alice ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice
|
||||
<### [ "#team: you joined the group",
|
||||
"#team: member cath_2 (Catherine) is connected",
|
||||
StartsWith "contact and member are merged: cath",
|
||||
StartsWith "use @cath",
|
||||
StartsWith "contact cath_",
|
||||
StartsWith "use @cath"
|
||||
],
|
||||
bob <## "#team: alice joined the group",
|
||||
cath
|
||||
<### [ "#team: bob added alice_2 (Alice) to the group (connecting...)",
|
||||
"#team: new member alice_2 is connected",
|
||||
StartsWith "contact and member are merged: alice",
|
||||
StartsWith "use @alice",
|
||||
StartsWith "contact alice_",
|
||||
StartsWith "use @alice"
|
||||
]
|
||||
]
|
||||
alice <##> cath
|
||||
alice #> "#team hello"
|
||||
bob <# "#team alice> hello"
|
||||
cath <# "#team alice> hello"
|
||||
cath #> "#team hello too"
|
||||
bob <# "#team cath> hello too"
|
||||
alice <# "#team cath> hello too"
|
||||
|
||||
alice ##> "/contacts"
|
||||
alice
|
||||
<### [ "bob (Bob)",
|
||||
"cath (Catherine)"
|
||||
]
|
||||
cath ##> "/contacts"
|
||||
cath
|
||||
<### [ "alice (Alice)",
|
||||
"bob (Bob)"
|
||||
]
|
||||
alice `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeContactExistingMember :: HasCallStack => FilePath -> IO ()
|
||||
testMergeContactExistingMember =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
@ -2889,66 +2816,6 @@ testMergeContactExistingMember =
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeContactExistingMemberWithContact :: HasCallStack => FilePath -> IO ()
|
||||
testMergeContactExistingMemberWithContact =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
-- create contact, delete only for bob so he would send probe hash to member
|
||||
bob ##> "/_create member contact #1 3"
|
||||
bob <## "contact for member #team cath is created"
|
||||
|
||||
bob ##> "/_invite member contact @3 text hi"
|
||||
bob
|
||||
<### [ "sent invitation to connect directly to member #team cath",
|
||||
WithTime "@cath hi"
|
||||
]
|
||||
cath
|
||||
<### [ "#team bob is creating direct contact bob with you",
|
||||
WithTime "bob> hi"
|
||||
]
|
||||
concurrently_
|
||||
(bob <## "cath (Catherine): contact is connected")
|
||||
(cath <## "bob (Bob): contact is connected")
|
||||
bob <##> cath
|
||||
|
||||
bob ##> "/_delete @3 notify=off"
|
||||
bob <## "cath: contact is deleted"
|
||||
|
||||
bob ##> "/contacts"
|
||||
bob <### ["alice (Alice)"]
|
||||
cath ##> "/contacts"
|
||||
cath <### ["alice (Alice)", "bob (Bob)"]
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
-- contact connects, member is merged
|
||||
bob ##> "/c"
|
||||
inv' <- getInvitation bob
|
||||
cath ##> ("/c " <> inv')
|
||||
cath <## "confirmation sent!"
|
||||
concurrentlyN_
|
||||
[ bob
|
||||
<### [ "cath_1 (Catherine): contact is connected",
|
||||
"contact and member are merged: cath_1, #team cath",
|
||||
"use @cath <message> to send messages"
|
||||
],
|
||||
cath
|
||||
<### [ "bob_1 (Bob): contact is connected",
|
||||
"contact bob_1 is merged into bob",
|
||||
"use @bob <message> to send messages"
|
||||
]
|
||||
]
|
||||
bob <##> cath
|
||||
|
||||
bob ##> "/contacts"
|
||||
bob <### ["alice (Alice)", "cath (Catherine)"]
|
||||
cath ##> "/contacts"
|
||||
cath <### ["alice (Alice)", "bob (Bob)"]
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeContactMultipleMembers :: HasCallStack => FilePath -> IO ()
|
||||
testMergeContactMultipleMembers =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
@ -2987,70 +2854,11 @@ testMergeContactMultipleMembers =
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeContactExistingMembersAndContacts :: HasCallStack => FilePath -> IO ()
|
||||
testMergeContactExistingMembersAndContacts =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
bob ##> "/contact_merge off"
|
||||
bob <## "ok"
|
||||
|
||||
create2Groups3 "team" "club" alice bob cath
|
||||
|
||||
bob ##> "/c"
|
||||
inv' <- getInvitation bob
|
||||
cath ##> ("/c " <> inv')
|
||||
cath <## "confirmation sent!"
|
||||
concurrently_
|
||||
(bob <## "cath_2 (Catherine): contact is connected")
|
||||
(cath <## "bob_2 (Bob): contact is connected")
|
||||
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob", "bob", "bob"]
|
||||
|
||||
bob ##> "/contact_merge on"
|
||||
bob <## "ok"
|
||||
|
||||
bob ##> "/c"
|
||||
inv'' <- getInvitation bob
|
||||
cath ##> ("/c " <> inv'')
|
||||
cath <## "confirmation sent!"
|
||||
concurrentlyN_
|
||||
[ bob
|
||||
<### [ "cath_3 (Catherine): contact is connected",
|
||||
StartsWith "contact and member are merged: cath",
|
||||
StartsWith "use @cath",
|
||||
StartsWith "contact and member are merged: cath",
|
||||
StartsWith "use @cath",
|
||||
StartsWith "contact cath_3 is merged into cath",
|
||||
StartsWith "use @cath"
|
||||
],
|
||||
cath
|
||||
<### [ "bob_3 (Bob): contact is connected",
|
||||
StartsWith "contact and member are merged: bob",
|
||||
StartsWith "use @bob",
|
||||
StartsWith "contact and member are merged: bob",
|
||||
StartsWith "use @bob",
|
||||
StartsWith "contact bob_3 is merged into bob",
|
||||
StartsWith "use @bob"
|
||||
]
|
||||
]
|
||||
bob <##> cath
|
||||
|
||||
bob ##> "/contacts"
|
||||
bob <### ["alice (Alice)", "cath (Catherine)"]
|
||||
cath ##> "/contacts"
|
||||
cath <### ["alice (Alice)", "bob (Bob)"]
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeMemberContact :: HasCallStack => FilePath -> IO ()
|
||||
testMergeMemberContact =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
bob ##> "/contact_merge off"
|
||||
bob <## "ok"
|
||||
|
||||
createGroup3 "team" alice bob cath
|
||||
testMergeGroupLinkHostMultipleContacts :: HasCallStack => FilePath -> IO ()
|
||||
testMergeGroupLinkHostMultipleContacts =
|
||||
testChat2 bobProfile cathProfile $
|
||||
\bob cath -> do
|
||||
connectUsers bob cath
|
||||
|
||||
bob ##> "/c"
|
||||
inv' <- getInvitation bob
|
||||
@ -3060,61 +2868,40 @@ testMergeMemberContact =
|
||||
(bob <## "cath_1 (Catherine): contact is connected")
|
||||
(cath <## "bob_1 (Bob): contact is connected")
|
||||
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob", "bob"]
|
||||
bob `hasContactProfiles` ["bob", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "bob", "bob"]
|
||||
|
||||
bob ##> "/contact_merge on"
|
||||
bob <## "ok"
|
||||
|
||||
-- bob and cath connect
|
||||
bob ##> "/_create member contact #1 3"
|
||||
bob <## "contact for member #team cath is created"
|
||||
|
||||
bob ##> "/_invite member contact @4 text hi"
|
||||
bob
|
||||
<### [ "sent invitation to connect directly to member #team cath",
|
||||
WithTime "@cath hi"
|
||||
]
|
||||
cath
|
||||
<### [ "#team bob is creating direct contact bob with you",
|
||||
WithTime "bob> hi"
|
||||
]
|
||||
bob ##> "/g party"
|
||||
bob <## "group #party is created"
|
||||
bob <## "to add members use /a party <name> or /create link #party"
|
||||
bob ##> "/create link #party"
|
||||
gLink <- getGroupLink bob "party" GRMember True
|
||||
cath ##> ("/c " <> gLink)
|
||||
cath <## "connection request sent!"
|
||||
bob <## "cath_2 (Catherine): accepting request to join group #party..."
|
||||
concurrentlyN_
|
||||
[ bob
|
||||
<### [ "cath (Catherine): contact is connected",
|
||||
"contact cath_1 is merged into cath",
|
||||
-- StartsWith "use @cath"
|
||||
"use @cath <message> to send messages"
|
||||
<### [ "cath_2 (Catherine): contact is connected",
|
||||
EndsWith "invited to group #party via your group link",
|
||||
EndsWith "joined the group",
|
||||
StartsWith "contact cath_2 is merged into cath",
|
||||
StartsWith "use @cath"
|
||||
],
|
||||
cath
|
||||
<### [ "bob (Bob): contact is connected",
|
||||
"contact bob_1 is merged into bob",
|
||||
-- StartsWith "use @bob"
|
||||
"use @bob <message> to send messages"
|
||||
<### [ "bob_2 (Bob): contact is connected",
|
||||
"#party: you joined the group",
|
||||
StartsWith "contact bob_2 is merged into bob",
|
||||
StartsWith "use @bob"
|
||||
]
|
||||
]
|
||||
bob <##> cath
|
||||
|
||||
bob ##> "/contacts"
|
||||
bob <### ["alice (Alice)", "cath (Catherine)"]
|
||||
bob <### ["cath (Catherine)", "cath_1 (Catherine)"]
|
||||
cath ##> "/contacts"
|
||||
cath <### ["alice (Alice)", "bob (Bob)"]
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
-- group messages work
|
||||
alice #> "#team hello"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello")
|
||||
(cath <# "#team alice> hello")
|
||||
bob #> "#team hi there"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hi there")
|
||||
(cath <# "#team bob> hi there")
|
||||
cath #> "#team hey team"
|
||||
concurrently_
|
||||
(alice <# "#team cath> hey team")
|
||||
(bob <# "#team cath> hey team")
|
||||
cath <### ["bob (Bob)", "bob_1 (Bob)"]
|
||||
bob `hasContactProfiles` ["bob", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "bob", "bob"]
|
||||
|
||||
testMemberContactMessage :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactMessage =
|
||||
|
||||
@ -20,7 +20,6 @@ chatProfileTests = do
|
||||
it "use multiword profile names" testMultiWordProfileNames
|
||||
describe "user contact link" $ do
|
||||
it "create and connect via contact link" testUserContactLink
|
||||
it "merge existing contact when connecting via contact link" testUserContactLinkMerge
|
||||
it "add contact link to profile" testProfileLink
|
||||
it "auto accept contact requests" testUserContactLinkAutoAccept
|
||||
it "deduplicate contact requests" testDeduplicateContactRequests
|
||||
@ -219,39 +218,6 @@ testUserContactLink =
|
||||
alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
|
||||
alice <##> cath
|
||||
|
||||
testUserContactLinkMerge :: HasCallStack => FilePath -> IO ()
|
||||
testUserContactLinkMerge =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
|
||||
alice ##> "/ad"
|
||||
cLink <- getContactLink alice True
|
||||
bob ##> ("/c " <> cLink)
|
||||
bob <## "connection request sent!"
|
||||
alice <## "bob_1 (Bob) wants to connect to you!"
|
||||
alice <## "to accept: /ac bob_1"
|
||||
alice <## "to reject: /rc bob_1 (the sender will NOT be notified)"
|
||||
alice @@@ [("@bob", "hey"), ("<@bob_1", "")]
|
||||
alice ##> "/ac bob_1"
|
||||
alice <## "bob_1 (Bob): accepting contact request..."
|
||||
concurrentlyN_
|
||||
[ alice
|
||||
<### [ "bob_1 (Bob): contact is connected",
|
||||
"contact bob_1 is merged into bob",
|
||||
"use @bob <message> to send messages"
|
||||
],
|
||||
bob
|
||||
<### [ "alice_1 (Alice): contact is connected",
|
||||
"contact alice_1 is merged into alice",
|
||||
"use @alice <message> to send messages"
|
||||
]
|
||||
]
|
||||
threadDelay 100000
|
||||
alice @@@ [("@bob", lastChatFeature)]
|
||||
alice <##> bob
|
||||
|
||||
testProfileLink :: HasCallStack => FilePath -> IO ()
|
||||
testProfileLink =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
|
||||
Loading…
Reference in New Issue
Block a user