From 1928256b09401caef5967f0a164c7f6fe0ca7e02 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 20 Sep 2023 00:26:03 +0400 Subject: [PATCH] core: connect existing contacts to new members when profile matches, enable skipping direct connections in groups (#3056) * core: test group members are assigned different LDNs in group when direct connections aren't created * disable test output * core: connect existing contacts to new members when profile matches (#3059) * core: connect existing contacts to new members when profile matches * fix migration * progress * xInfoProbeOk for member * fix tests * add test * fix tests * tests * remove deleteSentProbe * remove deleteContactProfile_ * views * don't check connections in deleteUnusedProfile_ * Revert "don't check connections in deleteUnusedProfile_" This reverts commit 2016a0efded2e66a004ae589e744e41fa89a929a. * fix test * core: update member merge * update saved schema * fix queries and tests * rename tables to original names * remove index, corrections * update schema dump --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 108 ++++-- src/Simplex/Chat/Controller.hs | 1 + .../Migrations/M20230914_member_probes.hs | 169 ++++++++++ src/Simplex/Chat/Migrations/chat_schema.sql | 76 +++-- src/Simplex/Chat/Store/Direct.hs | 29 ++ src/Simplex/Chat/Store/Groups.hs | 252 +++++++++----- src/Simplex/Chat/Store/Migrations.hs | 4 +- src/Simplex/Chat/Types.hs | 19 +- src/Simplex/Chat/View.hs | 3 +- tests/ChatTests.hs | 8 +- tests/ChatTests/Groups.hs | 308 +++++++++++------- tests/SchemaDump.hs | 4 +- 13 files changed, 707 insertions(+), 275 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20230914_member_probes.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index f1b6eb053..77592f756 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -112,6 +112,7 @@ library Simplex.Chat.Migrations.M20230829_connections_chat_vrange Simplex.Chat.Migrations.M20230903_connections_to_subscribe Simplex.Chat.Migrations.M20230913_member_contacts + Simplex.Chat.Migrations.M20230914_member_probes Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2e9844f7e..34981fa56 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3037,7 +3037,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct' sharedMsgId fileConnReq_ fName msgMeta XInfo p -> xInfo ct' p XGrpInv gInv -> processGroupInvitation ct' gInv msg msgMeta - XInfoProbe probe -> xInfoProbe ct' probe + XInfoProbe probe -> xInfoProbe (CGMContact ct') probe XInfoProbeCheck probeHash -> xInfoProbeCheck ct' probeHash XInfoProbeOk probe -> xInfoProbeOk ct' probe XCallInv callId invitation -> xCallInv ct' callId invitation msg msgMeta @@ -3169,7 +3169,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of -- [async agent commands] XGrpMemIntro continuation on receiving INV CFCreateConnGrpMemInv - | isCompatibleRange (fromJVersionRange $ peerChatVRange conn) groupNoDirectVRange -> sendWithDirectCReq -- sendWithoutDirectCReq + | isCompatibleRange (fromJVersionRange $ peerChatVRange conn) groupNoDirectVRange -> sendWithoutDirectCReq | otherwise -> sendWithDirectCReq where sendWithoutDirectCReq = do @@ -3270,12 +3270,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do void $ sendDirectMessage conn (XGrpMemIntro $ memberInfo (reMember intro)) (GroupId groupId) withStore' $ \db -> updateIntroStatus db introId GMIntroSent _ -> do - -- TODO send probe and decide whether to use existing contact connection or the new contact connection -- TODO notify member who forwarded introduction - question - where it is stored? There is via_contact but probably there should be via_member in group_members table withStore' (\db -> getViaGroupContact db user m) >>= \case Nothing -> do notifyMemberConnected gInfo m Nothing - messageWarning "connected member does not have contact" + let connectedIncognito = memberIncognito membership + when (memberCategory m == GCPreMember) $ probeMatchingMemberContact gInfo m connectedIncognito Just ct@Contact {activeConn = Connection {connStatus}} -> when (connStatus == ConnReady) $ do notifyMemberConnected gInfo m $ Just ct @@ -3308,6 +3308,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XGrpDel -> xGrpDel gInfo m' msg msgMeta XGrpInfo p' -> xGrpInfo gInfo m' p' msg msgMeta XGrpDirectInv connReq mContent_ -> canSend m' $ xGrpDirectInv gInfo m' conn' connReq mContent_ msg msgMeta + XInfoProbe probe -> xInfoProbe (CGMGroupMember gInfo m') probe + -- XInfoProbeCheck -- TODO merge members? + -- XInfoProbeOk -- TODO merge members? BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta _ -> messageError $ "unsupported message: " <> T.pack (show event) currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo @@ -3674,19 +3677,42 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do probeMatchingContacts :: Contact -> IncognitoEnabled -> m () probeMatchingContacts ct connectedIncognito = do gVar <- asks idsDrg - (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId ct - void . sendDirectContactMessage ct $ XInfoProbe probe if connectedIncognito - then withStore' $ \db -> deleteSentProbe db userId probeId + then sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) else do + (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId (CGMContact ct) + sendProbe probe cs <- withStore' $ \db -> getMatchingContacts db user ct - let probeHash = ProbeHash $ C.sha256Hash (unProbe probe) - forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchChatError` \_ -> pure () + sendProbeHashes cs probe probeId where - sendProbeHash :: Contact -> ProbeHash -> Int64 -> m () - sendProbeHash c probeHash probeId = do + sendProbe :: Probe -> m () + sendProbe probe = void . sendDirectContactMessage ct $ XInfoProbe probe + + probeMatchingMemberContact :: GroupInfo -> GroupMember -> IncognitoEnabled -> m () + probeMatchingMemberContact _ GroupMember {activeConn = Nothing} _ = pure () + probeMatchingMemberContact g m@GroupMember {groupId, activeConn = Just conn} connectedIncognito = do + gVar <- asks idsDrg + if connectedIncognito + then sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) + else do + (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId $ CGMGroupMember g m + sendProbe probe + cs <- withStore' $ \db -> getMatchingMemberContacts db user m + sendProbeHashes cs probe probeId + where + sendProbe :: Probe -> m () + sendProbe probe = void $ sendDirectMessage conn (XInfoProbe probe) (GroupId groupId) + + -- TODO currently we only send probe hashes to contacts + sendProbeHashes :: [Contact] -> Probe -> Int64 -> m () + sendProbeHashes cs probe probeId = + forM_ cs $ \c -> sendProbeHash c `catchChatError` \_ -> pure () + where + probeHash = ProbeHash $ C.sha256Hash (unProbe probe) + sendProbeHash :: Contact -> m () + sendProbeHash c = do void . sendDirectContactMessage c $ XInfoProbeCheck probeHash - withStore' $ \db -> createSentProbeHash db userId probeId c + withStore' $ \db -> createSentProbeHash db userId probeId $ CGMContact c messageWarning :: Text -> m () messageWarning = toView . CRMessageError user "warning" @@ -4247,35 +4273,48 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do (_, param) = groupFeatureState p createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing - xInfoProbe :: Contact -> Probe -> m () - xInfoProbe c2 probe = + xInfoProbe :: ContactOrGroupMember -> Probe -> m () + xInfoProbe cgm2 probe = -- [incognito] unless connected incognito - unless (contactConnIncognito c2) $ do - r <- withStore' $ \db -> matchReceivedProbe db user c2 probe - forM_ r $ \c1 -> probeMatch c1 c2 probe + unless (contactOrGroupMemberIncognito cgm2) $ do + r <- withStore' $ \db -> matchReceivedProbe db user cgm2 probe + forM_ r $ \case + CGMContact c1 -> probeMatch c1 cgm2 probe + CGMGroupMember _ _ -> messageWarning "xInfoProbe ignored: matched member (no probe hashes sent to members)" + -- TODO currently we send probe hashes only to contacts xInfoProbeCheck :: Contact -> ProbeHash -> m () xInfoProbeCheck c1 probeHash = -- [incognito] unless connected incognito unless (contactConnIncognito c1) $ do - r <- withStore' $ \db -> matchReceivedProbeHash db user c1 probeHash + r <- withStore' $ \db -> matchReceivedProbeHash db user (CGMContact c1) probeHash forM_ r . uncurry $ probeMatch c1 - probeMatch :: Contact -> Contact -> Probe -> m () - probeMatch c1@Contact {contactId = cId1, profile = p1} c2@Contact {contactId = cId2, profile = p2} probe = - if profilesMatch (fromLocalProfile p1) (fromLocalProfile p2) && cId1 /= cId2 - then do - void . sendDirectContactMessage c1 $ XInfoProbeOk probe - mergeContacts c1 c2 - else messageWarning "probeMatch ignored: profiles don't match or same contact id" + probeMatch :: Contact -> ContactOrGroupMember -> Probe -> m () + probeMatch c1@Contact {contactId = cId1, profile = p1} cgm2 probe = + case cgm2 of + CGMContact c2@Contact {contactId = cId2, profile = p2} + | cId1 /= cId2 && profilesMatch p1 p2 -> do + void . sendDirectContactMessage c1 $ XInfoProbeOk probe + mergeContacts c1 c2 + | otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" + CGMGroupMember g m2@GroupMember {memberProfile = p2, memberContactId} + | isNothing memberContactId && profilesMatch p1 p2 -> do + void . sendDirectContactMessage c1 $ XInfoProbeOk probe + connectContactToMember c1 g m2 + | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" + -- TODO currently we send probe hashes only to contacts xInfoProbeOk :: Contact -> Probe -> m () - xInfoProbeOk c1@Contact {contactId = cId1} probe = do - r <- withStore' $ \db -> matchSentProbe db user c1 probe - forM_ r $ \c2@Contact {contactId = cId2} -> - if cId1 /= cId2 - then mergeContacts c1 c2 - else messageWarning "xInfoProbeOk ignored: same contact id" + xInfoProbeOk c1@Contact {contactId = cId1} probe = + withStore' (\db -> matchSentProbe db user (CGMContact c1) probe) >>= \case + Just (CGMContact c2@Contact {contactId = cId2}) + | cId1 /= cId2 -> mergeContacts c1 c2 + | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id" + Just (CGMGroupMember g m2@GroupMember {memberContactId}) + | isNothing memberContactId -> connectContactToMember c1 g m2 + | otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact" + _ -> pure () -- to party accepting call xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> m () @@ -4387,6 +4426,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> mergeContactRecords db userId c1 c2 toView $ CRContactsMerged user c1 c2 + connectContactToMember :: Contact -> GroupInfo -> GroupMember -> m () + connectContactToMember c1 g m2 = do + withStore' $ \db -> updateMemberContact db user c1 m2 + toView $ CRMemberContactConnected user c1 g m2 + saveConnInfo :: Connection -> ConnInfo -> m Connection saveConnInfo activeConn connInfo = do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo @@ -4427,7 +4471,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do directConnIds <- case memberChatVRange of Nothing -> Just <$> createConn subMode Just mcvr - | isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> Just <$> createConn subMode -- pure Nothing + | isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> pure Nothing | otherwise -> Just <$> createConn subMode let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId subMode diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 7b6212650..2c829e4a9 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -560,6 +560,7 @@ data ChatResponse | CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} | CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} | CRNewMemberContactReceivedInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} + | CRMemberContactConnected {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} | CRMemberSubError {user :: User, groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError} | CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]} | CRGroupSubscribed {user :: User, groupInfo :: GroupInfo} diff --git a/src/Simplex/Chat/Migrations/M20230914_member_probes.hs b/src/Simplex/Chat/Migrations/M20230914_member_probes.hs new file mode 100644 index 000000000..8772b6cda --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230914_member_probes.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20230914_member_probes where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20230914_member_probes :: Query +m20230914_member_probes = + [sql| +CREATE TABLE new__sent_probes( + sent_probe_id INTEGER PRIMARY KEY, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE, + probe BLOB NOT NULL, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL), + UNIQUE(user_id, probe) +); + +CREATE TABLE new__sent_probe_hashes( + sent_probe_hash_id INTEGER PRIMARY KEY, + sent_probe_id INTEGER NOT NULL REFERENCES new__sent_probes ON DELETE CASCADE, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL) +); + +CREATE TABLE new__received_probes( + received_probe_id INTEGER PRIMARY KEY, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE, + probe BLOB, + probe_hash BLOB NOT NULL, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL) +); + +INSERT INTO new__sent_probes + (sent_probe_id, contact_id, probe, user_id, created_at, updated_at) +SELECT + sent_probe_id, contact_id, probe, user_id, created_at, updated_at + FROM sent_probes; + +INSERT INTO new__sent_probe_hashes + (sent_probe_hash_id, sent_probe_id, contact_id, user_id, created_at, updated_at) +SELECT + sent_probe_hash_id, sent_probe_id, contact_id, user_id, created_at, updated_at + FROM sent_probe_hashes; + +INSERT INTO new__received_probes + (received_probe_id, contact_id, probe, probe_hash, user_id, created_at, updated_at) +SELECT + received_probe_id, contact_id, probe, probe_hash, user_id, created_at, updated_at + FROM received_probes; + +DROP INDEX idx_sent_probe_hashes_user_id; +DROP INDEX idx_sent_probe_hashes_contact_id; +DROP INDEX idx_received_probes_user_id; +DROP INDEX idx_received_probes_contact_id; + +DROP TABLE sent_probes; +DROP TABLE sent_probe_hashes; +DROP TABLE received_probes; + +ALTER TABLE new__sent_probes RENAME TO sent_probes; +ALTER TABLE new__sent_probe_hashes RENAME TO sent_probe_hashes; +ALTER TABLE new__received_probes RENAME TO received_probes; + +CREATE INDEX idx_sent_probes_user_id ON sent_probes(user_id); +CREATE INDEX idx_sent_probes_contact_id ON sent_probes(contact_id); +CREATE INDEX idx_sent_probes_group_member_id ON sent_probes(group_member_id); + +CREATE INDEX idx_sent_probe_hashes_user_id ON sent_probe_hashes(user_id); +CREATE INDEX idx_sent_probe_hashes_sent_probe_id ON sent_probe_hashes(sent_probe_id); +CREATE INDEX idx_sent_probe_hashes_contact_id ON sent_probe_hashes(contact_id); +CREATE INDEX idx_sent_probe_hashes_group_member_id ON sent_probe_hashes(group_member_id); + +CREATE INDEX idx_received_probes_user_id ON received_probes(user_id); +CREATE INDEX idx_received_probes_contact_id ON received_probes(contact_id); +CREATE INDEX idx_received_probes_probe ON received_probes(probe); +CREATE INDEX idx_received_probes_probe_hash ON received_probes(probe_hash); +|] + +down_m20230914_member_probes :: Query +down_m20230914_member_probes = + [sql| +CREATE TABLE old__sent_probes( + sent_probe_id INTEGER PRIMARY KEY, + contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE, + probe BLOB NOT NULL, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL), + UNIQUE(user_id, probe) +); + +CREATE TABLE old__sent_probe_hashes( + sent_probe_hash_id INTEGER PRIMARY KEY, + sent_probe_id INTEGER NOT NULL REFERENCES old__sent_probes ON DELETE CASCADE, + contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL) +); + +CREATE TABLE old__received_probes( + received_probe_id INTEGER PRIMARY KEY, + contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE, + probe BLOB, + probe_hash BLOB NOT NULL, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL) +); + +DELETE FROM sent_probes WHERE contact_id IS NULL; +DELETE FROM sent_probe_hashes WHERE contact_id IS NULL; +DELETE FROM received_probes WHERE contact_id IS NULL; + +INSERT INTO old__sent_probes + (sent_probe_id, contact_id, probe, user_id, created_at, updated_at) +SELECT + sent_probe_id, contact_id, probe, user_id, created_at, updated_at + FROM sent_probes; + +INSERT INTO old__sent_probe_hashes + (sent_probe_hash_id, sent_probe_id, contact_id, user_id, created_at, updated_at) +SELECT + sent_probe_hash_id, sent_probe_id, contact_id, user_id, created_at, updated_at + FROM sent_probe_hashes; + +INSERT INTO old__received_probes + (received_probe_id, contact_id, probe, probe_hash, user_id, created_at, updated_at) +SELECT + received_probe_id, contact_id, probe, probe_hash, user_id, created_at, updated_at + FROM received_probes; + +DROP INDEX idx_sent_probes_user_id; +DROP INDEX idx_sent_probes_contact_id; +DROP INDEX idx_sent_probes_group_member_id; + +DROP INDEX idx_sent_probe_hashes_user_id; +DROP INDEX idx_sent_probe_hashes_sent_probe_id; +DROP INDEX idx_sent_probe_hashes_contact_id; +DROP INDEX idx_sent_probe_hashes_group_member_id; + +DROP INDEX idx_received_probes_user_id; +DROP INDEX idx_received_probes_contact_id; +DROP INDEX idx_received_probes_probe; +DROP INDEX idx_received_probes_probe_hash; + +DROP TABLE sent_probes; +DROP TABLE sent_probe_hashes; +DROP TABLE received_probes; + +ALTER TABLE old__sent_probes RENAME TO sent_probes; +ALTER TABLE old__sent_probe_hashes RENAME TO sent_probe_hashes; +ALTER TABLE old__received_probes RENAME TO received_probes; + +CREATE INDEX idx_received_probes_user_id ON received_probes(user_id); +CREATE INDEX idx_received_probes_contact_id ON received_probes(contact_id); +CREATE INDEX idx_sent_probe_hashes_user_id ON sent_probe_hashes(user_id); +CREATE INDEX idx_sent_probe_hashes_contact_id ON sent_probe_hashes(contact_id); +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 4cc351aff..141247e59 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -78,34 +78,6 @@ CREATE TABLE contacts( UNIQUE(user_id, local_display_name), UNIQUE(user_id, contact_profile_id) ); -CREATE TABLE sent_probes( - sent_probe_id INTEGER PRIMARY KEY, - contact_id INTEGER NOT NULL UNIQUE REFERENCES contacts ON DELETE CASCADE, - probe BLOB NOT NULL, - user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, - created_at TEXT CHECK(created_at NOT NULL), - updated_at TEXT CHECK(updated_at NOT NULL), - UNIQUE(user_id, probe) -); -CREATE TABLE sent_probe_hashes( - sent_probe_hash_id INTEGER PRIMARY KEY, - sent_probe_id INTEGER NOT NULL REFERENCES sent_probes ON DELETE CASCADE, - contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE, - user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, - created_at TEXT CHECK(created_at NOT NULL), - updated_at TEXT CHECK(updated_at NOT NULL), - UNIQUE(sent_probe_id, contact_id) -); -CREATE TABLE received_probes( - received_probe_id INTEGER PRIMARY KEY, - contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE, - probe BLOB, - probe_hash BLOB NOT NULL, - user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE - , - created_at TEXT CHECK(created_at NOT NULL), - updated_at TEXT CHECK(updated_at NOT NULL) -); CREATE TABLE known_servers( server_id INTEGER PRIMARY KEY, host TEXT NOT NULL, @@ -514,6 +486,35 @@ CREATE TABLE group_snd_item_statuses( created_at TEXT NOT NULL DEFAULT(datetime('now')), updated_at TEXT NOT NULL DEFAULT(datetime('now')) ); +CREATE TABLE IF NOT EXISTS "sent_probes"( + sent_probe_id INTEGER PRIMARY KEY, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE, + probe BLOB NOT NULL, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL), + UNIQUE(user_id, probe) +); +CREATE TABLE IF NOT EXISTS "sent_probe_hashes"( + sent_probe_hash_id INTEGER PRIMARY KEY, + sent_probe_id INTEGER NOT NULL REFERENCES "sent_probes" ON DELETE CASCADE, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL) +); +CREATE TABLE IF NOT EXISTS "received_probes"( + received_probe_id INTEGER PRIMARY KEY, + contact_id INTEGER REFERENCES contacts ON DELETE CASCADE, + group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE, + probe BLOB, + probe_hash BLOB NOT NULL, + user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE, + created_at TEXT CHECK(created_at NOT NULL), + updated_at TEXT CHECK(updated_at NOT NULL) +); CREATE INDEX contact_profiles_index ON contact_profiles( display_name, full_name @@ -627,10 +628,6 @@ CREATE INDEX idx_pending_group_messages_group_member_id ON pending_group_message ); CREATE INDEX idx_rcv_file_chunks_file_id ON rcv_file_chunks(file_id); CREATE INDEX idx_rcv_files_group_member_id ON rcv_files(group_member_id); -CREATE INDEX idx_received_probes_user_id ON received_probes(user_id); -CREATE INDEX idx_received_probes_contact_id ON received_probes(contact_id); -CREATE INDEX idx_sent_probe_hashes_user_id ON sent_probe_hashes(user_id); -CREATE INDEX idx_sent_probe_hashes_contact_id ON sent_probe_hashes(contact_id); CREATE INDEX idx_settings_user_id ON settings(user_id); CREATE INDEX idx_snd_file_chunks_file_id_connection_id ON snd_file_chunks( file_id, @@ -719,3 +716,18 @@ CREATE INDEX idx_connections_to_subscribe ON connections(to_subscribe); CREATE INDEX idx_contacts_contact_group_member_id ON contacts( contact_group_member_id ); +CREATE INDEX idx_sent_probes_user_id ON sent_probes(user_id); +CREATE INDEX idx_sent_probes_contact_id ON sent_probes(contact_id); +CREATE INDEX idx_sent_probes_group_member_id ON sent_probes(group_member_id); +CREATE INDEX idx_sent_probe_hashes_user_id ON sent_probe_hashes(user_id); +CREATE INDEX idx_sent_probe_hashes_sent_probe_id ON sent_probe_hashes( + sent_probe_id +); +CREATE INDEX idx_sent_probe_hashes_contact_id ON sent_probe_hashes(contact_id); +CREATE INDEX idx_sent_probe_hashes_group_member_id ON sent_probe_hashes( + group_member_id +); +CREATE INDEX idx_received_probes_user_id ON received_probes(user_id); +CREATE INDEX idx_received_probes_contact_id ON received_probes(contact_id); +CREATE INDEX idx_received_probes_probe ON received_probes(probe); +CREATE INDEX idx_received_probes_probe_hash ON received_probes(probe_hash); diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 2134981fb..7e8cee0e7 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -15,6 +15,7 @@ module Simplex.Chat.Store.Direct updateContactProfile_, updateContactProfile_', deleteContactProfile_, + deleteUnusedProfile_, -- * Contacts and connections functions getPendingContactConnection, @@ -272,6 +273,34 @@ deleteContactProfile_ db userId contactId = |] (userId, contactId) +deleteUnusedProfile_ :: DB.Connection -> UserId -> ProfileId -> IO () +deleteUnusedProfile_ db userId profileId = + DB.executeNamed + db + [sql| + DELETE FROM contact_profiles + WHERE user_id = :user_id AND contact_profile_id = :profile_id + AND 1 NOT IN ( + SELECT 1 FROM connections + WHERE user_id = :user_id AND custom_user_profile_id = :profile_id LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM contacts + WHERE user_id = :user_id AND contact_profile_id = :profile_id LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM contact_requests + WHERE user_id = :user_id AND contact_profile_id = :profile_id LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM group_members + WHERE user_id = :user_id + AND (member_profile_id = :profile_id OR contact_profile_id = :profile_id) + LIMIT 1 + ) + |] + [":user_id" := userId, ":profile_id" := profileId] + updateContactProfile :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO Contact updateContactProfile db user@User {userId} c p' | displayName == newName = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 61a0cf713..6656208ab 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -77,13 +77,14 @@ module Simplex.Chat.Store.Groups getViaGroupMember, getViaGroupContact, getMatchingContacts, + getMatchingMemberContacts, createSentProbe, createSentProbeHash, - deleteSentProbe, matchReceivedProbe, matchReceivedProbeHash, matchSentProbe, mergeContactRecords, + updateMemberContact, updateGroupSettings, getXGrpMemIntroContDirect, getXGrpMemIntroContGroup, @@ -120,7 +121,7 @@ import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol (SubscriptionMode (..)) -import Simplex.Messaging.Util (eitherToMaybe) +import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>)) import Simplex.Messaging.Version import UnliftIO.STM @@ -1158,109 +1159,136 @@ getActiveMembersByName db user@User {userId} groupMemberName = do getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact] getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do contactIds <- - map fromOnly - <$> DB.query - db - [sql| - SELECT ct.contact_id - FROM contacts ct - JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id - WHERE ct.user_id = ? AND ct.contact_id != ? - AND ct.deleted = 0 - AND p.display_name = ? AND p.full_name = ? - AND ((p.image IS NULL AND ? IS NULL) OR p.image = ?) - |] - (userId, contactId, displayName, fullName, image, image) + map fromOnly <$> case image of + Just img -> DB.query db (q <> " AND p.image = ?") (userId, contactId, displayName, fullName, img) + Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, contactId, displayName, fullName) rights <$> mapM (runExceptT . getContact db user) contactIds + where + -- this query is different from one in getMatchingMemberContacts + -- it checks that it's not the same contact + q = + [sql| + SELECT ct.contact_id + FROM contacts ct + JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id + WHERE ct.user_id = ? AND ct.contact_id != ? + AND ct.deleted = 0 + AND p.display_name = ? AND p.full_name = ? + |] -createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> Contact -> ExceptT StoreError IO (Probe, Int64) -createSentProbe db gVar userId _to@Contact {contactId} = +getMatchingMemberContacts :: DB.Connection -> User -> GroupMember -> IO [Contact] +getMatchingMemberContacts _ _ GroupMember {memberContactId = Just _} = pure [] +getMatchingMemberContacts db user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} = do + contactIds <- + map fromOnly <$> case image of + Just img -> DB.query db (q <> " AND p.image = ?") (userId, displayName, fullName, img) + Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, displayName, fullName) + rights <$> mapM (runExceptT . getContact db user) contactIds + where + q = + [sql| + SELECT ct.contact_id + FROM contacts ct + JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id + WHERE ct.user_id = ? + AND ct.deleted = 0 + AND p.display_name = ? AND p.full_name = ? + |] + +createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> ContactOrGroupMember -> ExceptT StoreError IO (Probe, Int64) +createSentProbe db gVar userId to = createWithRandomBytes 32 gVar $ \probe -> do currentTs <- getCurrentTime + let (ctId, gmId) = contactOrGroupMemberIds to DB.execute db - "INSERT INTO sent_probes (contact_id, probe, user_id, created_at, updated_at) VALUES (?,?,?,?,?)" - (contactId, probe, userId, currentTs, currentTs) - (Probe probe,) <$> insertedRowId db + "INSERT INTO sent_probes (contact_id, group_member_id, probe, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" + (ctId, gmId, probe, userId, currentTs, currentTs) + (Probe probe,) <$> insertedRowId db -createSentProbeHash :: DB.Connection -> UserId -> Int64 -> Contact -> IO () -createSentProbeHash db userId probeId _to@Contact {contactId} = do +createSentProbeHash :: DB.Connection -> UserId -> Int64 -> ContactOrGroupMember -> IO () +createSentProbeHash db userId probeId to = do currentTs <- getCurrentTime + let (ctId, gmId) = contactOrGroupMemberIds to DB.execute db - "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?)" - (probeId, contactId, userId, currentTs, currentTs) + "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, group_member_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" + (probeId, ctId, gmId, userId, currentTs, currentTs) -deleteSentProbe :: DB.Connection -> UserId -> Int64 -> IO () -deleteSentProbe db userId probeId = - DB.execute - db - "DELETE FROM sent_probes WHERE user_id = ? AND sent_probe_id = ?" - (userId, probeId) - -matchReceivedProbe :: DB.Connection -> User -> Contact -> Probe -> IO (Maybe Contact) -matchReceivedProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = do +matchReceivedProbe :: DB.Connection -> User -> ContactOrGroupMember -> Probe -> IO (Maybe ContactOrGroupMember) +matchReceivedProbe db user@User {userId} from (Probe probe) = do let probeHash = C.sha256Hash probe - contactIds <- - map fromOnly - <$> DB.query + cgmIds <- + maybeFirstRow id $ + DB.query db [sql| - SELECT c.contact_id - FROM contacts c - JOIN received_probes r ON r.contact_id = c.contact_id - WHERE c.user_id = ? AND c.deleted = 0 AND r.probe_hash = ? AND r.probe IS NULL + SELECT r.contact_id, g.group_id, r.group_member_id + FROM received_probes r + LEFT JOIN contacts c ON r.contact_id = c.contact_id AND c.deleted = 0 + LEFT JOIN group_members m ON r.group_member_id = m.group_member_id + LEFT JOIN groups g ON g.group_id = m.group_id + WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NULL |] (userId, probeHash) currentTs <- getCurrentTime + let (ctId, gmId) = contactOrGroupMemberIds from DB.execute db - "INSERT INTO received_probes (contact_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" - (contactId, probe, probeHash, userId, currentTs, currentTs) - case contactIds of - [] -> pure Nothing - cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId) + "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) + pure cgmIds $>>= getContactOrGroupMember_ db user -matchReceivedProbeHash :: DB.Connection -> User -> Contact -> ProbeHash -> IO (Maybe (Contact, Probe)) -matchReceivedProbeHash db user@User {userId} _from@Contact {contactId} (ProbeHash probeHash) = do - namesAndProbes <- - DB.query - db - [sql| - SELECT c.contact_id, r.probe - FROM contacts c - JOIN received_probes r ON r.contact_id = c.contact_id - WHERE c.user_id = ? AND c.deleted = 0 AND r.probe_hash = ? AND r.probe IS NOT NULL - |] - (userId, probeHash) - currentTs <- getCurrentTime - DB.execute - db - "INSERT INTO received_probes (contact_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?)" - (contactId, probeHash, userId, currentTs, currentTs) - case namesAndProbes of - [] -> pure Nothing - (cId, probe) : _ -> - either (const Nothing) (Just . (,Probe probe)) - <$> runExceptT (getContact db user cId) - -matchSentProbe :: DB.Connection -> User -> Contact -> Probe -> IO (Maybe Contact) -matchSentProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = do - contactIds <- - map fromOnly - <$> DB.query +matchReceivedProbeHash :: DB.Connection -> User -> ContactOrGroupMember -> ProbeHash -> IO (Maybe (ContactOrGroupMember, Probe)) +matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do + probeIds <- + maybeFirstRow id $ + DB.query db [sql| - SELECT c.contact_id - FROM contacts c - JOIN sent_probes s ON s.contact_id = c.contact_id - JOIN sent_probe_hashes h ON h.sent_probe_id = s.sent_probe_id - WHERE c.user_id = ? AND c.deleted = 0 AND s.probe = ? AND h.contact_id = ? + SELECT r.probe, r.contact_id, g.group_id, r.group_member_id + FROM received_probes r + LEFT JOIN contacts c ON r.contact_id = c.contact_id AND c.deleted = 0 + LEFT JOIN group_members m ON r.group_member_id = m.group_member_id + LEFT JOIN groups g ON g.group_id = m.group_id + WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NOT NULL |] - (userId, probe, contactId) - case contactIds of - [] -> pure Nothing - cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId) + (userId, probeHash) + currentTs <- getCurrentTime + let (ctId, gmId) = contactOrGroupMemberIds from + DB.execute + db + "INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" + (ctId, gmId, probeHash, userId, currentTs, currentTs) + pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrGroupMember_ db user cgmIds + +matchSentProbe :: DB.Connection -> User -> ContactOrGroupMember -> Probe -> IO (Maybe ContactOrGroupMember) +matchSentProbe db user@User {userId} _from (Probe probe) = + cgmIds $>>= getContactOrGroupMember_ db user + where + (ctId, gmId) = contactOrGroupMemberIds _from + cgmIds = + maybeFirstRow id $ + DB.query + db + [sql| + SELECT s.contact_id, g.group_id, s.group_member_id + FROM sent_probes s + LEFT JOIN contacts c ON s.contact_id = c.contact_id AND c.deleted = 0 + LEFT JOIN group_members m ON s.group_member_id = m.group_member_id + LEFT JOIN groups g ON g.group_id = m.group_id + JOIN sent_probe_hashes h ON h.sent_probe_id = s.sent_probe_id + WHERE s.user_id = ? AND s.probe = ? + AND (h.contact_id = ? OR h.group_member_id = ?) + |] + (userId, probe, ctId, gmId) + +getContactOrGroupMember_ :: DB.Connection -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrGroupMember) +getContactOrGroupMember_ db user ids = + fmap eitherToMaybe . runExceptT $ case ids of + (Just ctId, _, _) -> CGMContact <$> getContact db user ctId + (_, Just gId, Just gmId) -> CGMGroupMember <$> getGroupInfo db user gId <*> getGroupMember db user gId gmId + _ -> throwError $ SEInternalError "" mergeContactRecords :: DB.Connection -> UserId -> Contact -> Contact -> IO () mergeContactRecords db userId ct1 ct2 = do @@ -1308,7 +1336,7 @@ mergeContactRecords db userId ct1 ct2 = do ] deleteContactProfile_ db userId fromContactId DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId) - DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId) + deleteUnusedDisplayName_ db userId localDisplayName where toFromContacts :: Contact -> Contact -> (Contact, Contact) toFromContacts c1 c2 @@ -1321,6 +1349,64 @@ mergeContactRecords db userId ct1 ct2 = do d2 = directOrUsed c2 ctCreatedAt Contact {createdAt} = createdAt +updateMemberContact :: DB.Connection -> User -> Contact -> GroupMember -> IO () +updateMemberContact + db + User {userId} + Contact {contactId, localDisplayName, profile = LocalProfile {profileId}} + GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}} = do + -- TODO possibly, we should update profiles and local_display_names of all members linked to the same remote user, + -- once we decide on how we identify it, either based on shared contact_profile_id or on local_display_name + currentTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE group_members + SET contact_id = ?, local_display_name = ?, contact_profile_id = ?, updated_at = ? + WHERE user_id = ? AND group_id = ? AND group_member_id = ? + |] + (contactId, localDisplayName, profileId, currentTs, userId, groupId, groupMemberId) + when (memProfileId /= profileId) $ deleteUnusedProfile_ db userId memProfileId + when (memLDN /= localDisplayName) $ deleteUnusedDisplayName_ db userId memLDN + +deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO () +deleteUnusedDisplayName_ db userId localDisplayName = + DB.executeNamed + db + [sql| + DELETE FROM display_names + WHERE user_id = :user_id AND local_display_name = :local_display_name + AND 1 NOT IN ( + SELECT 1 FROM users + WHERE local_display_name = :local_display_name LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM contacts + WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM groups + WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM group_members + WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM user_contact_links + WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM contact_requests + WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1 + ) + AND 1 NOT IN ( + SELECT 1 FROM contact_requests + WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1 + ) + |] + [":user_id" := userId, ":local_display_name" := localDisplayName] + updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO () updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} = DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId) diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 94b01adab..d8bab817e 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -80,6 +80,7 @@ import Simplex.Chat.Migrations.M20230827_file_encryption import Simplex.Chat.Migrations.M20230829_connections_chat_vrange import Simplex.Chat.Migrations.M20230903_connections_to_subscribe import Simplex.Chat.Migrations.M20230913_member_contacts +import Simplex.Chat.Migrations.M20230914_member_probes import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -159,7 +160,8 @@ schemaMigrations = ("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption), ("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange), ("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe), - ("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts) + ("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts), + ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 0c29be281..ac2c55735 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -218,6 +218,19 @@ data ContactRef = ContactRef instance ToJSON ContactRef where toEncoding = J.genericToEncoding J.defaultOptions +data ContactOrGroupMember = CGMContact Contact | CGMGroupMember GroupInfo GroupMember + deriving (Show) + +contactOrGroupMemberIds :: ContactOrGroupMember -> (Maybe ContactId, Maybe GroupMemberId) +contactOrGroupMemberIds = \case + CGMContact Contact {contactId} -> (Just contactId, Nothing) + CGMGroupMember _ GroupMember {groupMemberId} -> (Nothing, Just groupMemberId) + +contactOrGroupMemberIncognito :: ContactOrGroupMember -> IncognitoEnabled +contactOrGroupMemberIncognito = \case + CGMContact ct -> contactConnIncognito ct + CGMGroupMember _ m -> memberIncognito m + data UserContact = UserContact { userContactLinkId :: Int64, connReqContact :: ConnReqContact, @@ -429,10 +442,10 @@ instance ToJSON Profile where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} -- check if profiles match ignoring preferences -profilesMatch :: Profile -> Profile -> Bool +profilesMatch :: LocalProfile -> LocalProfile -> Bool profilesMatch - Profile {displayName = n1, fullName = fn1, image = i1} - Profile {displayName = n2, fullName = fn2, image = i2} = + LocalProfile {displayName = n1, fullName = fn1, image = i1} + LocalProfile {displayName = n2, fullName = fn2, image = i2} = n1 == n2 && fn1 == fn2 && i1 == i2 data IncognitoProfile = NewIncognito Profile | ExistingIncognito LocalProfile diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index b150dbfa9..3607bbda5 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -231,10 +231,11 @@ 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 <> "..."] - CRNoMemberContactCreating u g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " does not have associated contact, creating contact"] + 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] CRNewMemberContactReceivedInv u ct g m -> ttyUser u [ttyGroup' g <> " " <> ttyMember m <> " is creating direct contact " <> ttyContact' ct <> " with you"] + CRMemberContactConnected u ct g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " is merged into " <> ttyContact' ct] CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e] CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors" CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index ed81853ac..eeb96503e 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -8,7 +8,7 @@ import Test.Hspec chatTests :: SpecWith FilePath chatTests = do - chatDirectTests - chatGroupTests - chatFileTests - chatProfileTests + describe "direct tests" chatDirectTests + describe "group tests" chatGroupTests + describe "file tests" chatFileTests + describe "profile tests" chatProfileTests diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 4f2c61b92..7cdb9a309 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -68,19 +68,12 @@ chatGroupTests = do it "should send delivery receipts in group depending on configuration" testConfigureGroupDeliveryReceipts describe "direct connections in group are not established based on chat protocol version" $ do describe "3 members group" $ do - testNoDirect _0 _0 False -- True - testNoDirect _0 _1 False -- True + testNoDirect _0 _0 True + testNoDirect _0 _1 True testNoDirect _1 _0 False testNoDirect _1 _1 False - describe "4 members group" $ do - testNoDirect4 _0 _0 _0 False False False -- True True True - testNoDirect4 _0 _0 _1 False False False -- True True True - testNoDirect4 _0 _1 _0 False False False -- True True False - testNoDirect4 _0 _1 _1 False False False -- True True False - testNoDirect4 _1 _0 _0 False False False -- False False True - testNoDirect4 _1 _0 _1 False False False -- False False True - testNoDirect4 _1 _1 _0 False False False - testNoDirect4 _1 _1 _1 False False False + it "members have different local display names in different groups" testNoDirectDifferentLDNs + it "member should connect to contact when profile match" testConnectMemberToContact 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 @@ -101,17 +94,6 @@ chatGroupTests = do <> (if noConns then " : 2 3" else " : 2 <##> 3") ) $ testNoGroupDirectConns supportedChatVRange vrMem2 vrMem3 noConns - testNoDirect4 vrMem2 vrMem3 vrMem4 noConns23 noConns24 noConns34 = - it - ( "host " <> vRangeStr supportedChatVRange - <> (", 2nd mem " <> vRangeStr vrMem2) - <> (", 3rd mem " <> vRangeStr vrMem3) - <> (", 4th mem " <> vRangeStr vrMem4) - <> (if noConns23 then " : 2 3" else " : 2 <##> 3") - <> (if noConns24 then " : 2 4" else " : 2 <##> 4") - <> (if noConns34 then " : 3 4" else " : 3 <##> 4") - ) - $ testNoGroupDirectConns4Members supportedChatVRange vrMem2 vrMem3 vrMem4 noConns23 noConns24 noConns34 testGroup :: HasCallStack => FilePath -> IO () testGroup = @@ -240,7 +222,7 @@ testGroupShared alice bob cath checkMessages = do alice `send` "@bob hey" alice <### [ "@bob hey", - "member #team bob does not have associated contact, creating contact", + "member #team bob does not have direct connection, creating", "peer chat protocol version range incompatible" ] when checkMessages $ threadDelay 1000000 @@ -657,7 +639,7 @@ testGroupDeleteInvitedContact = alice `send` "@bob hey" alice <### [ WithTime "@bob hey", - "member #team bob does not have associated contact, creating contact", + "member #team bob does not have direct connection, creating", "contact for member #team bob is created", "sent invitation to connect directly to member #team bob" ] @@ -2658,56 +2640,140 @@ testNoGroupDirectConns hostVRange mem2VRange mem3VRange noDirectConns tmp = createGroup3 "team" alice bob cath if noDirectConns then contactsDontExist bob cath - else bob <##> cath + else contactsExist bob cath where contactsDontExist bob cath = do - bob ##> "@cath hi" - bob <## "no contact cath" - cath ##> "@bob hi" - cath <## "no contact bob" + bob ##> "/contacts" + bob <## "alice (Alice)" + cath ##> "/contacts" + cath <## "alice (Alice)" + contactsExist bob cath = do + bob ##> "/contacts" + bob + <### [ "alice (Alice)", + "cath (Catherine)" + ] + cath ##> "/contacts" + cath + <### [ "alice (Alice)", + "bob (Bob)" + ] + bob <##> cath -testNoGroupDirectConns4Members :: HasCallStack => VersionRange -> VersionRange -> VersionRange -> VersionRange -> Bool -> Bool -> Bool -> FilePath -> IO () -testNoGroupDirectConns4Members hostVRange mem2VRange mem3VRange mem4VRange noConns23 noConns24 noConns34 tmp = - withNewTestChatCfg tmp testCfg {chatVRange = hostVRange} "alice" aliceProfile $ \alice -> do - withNewTestChatCfg tmp testCfg {chatVRange = mem2VRange} "bob" bobProfile $ \bob -> do - withNewTestChatCfg tmp testCfg {chatVRange = mem3VRange} "cath" cathProfile $ \cath -> do - withNewTestChatCfg tmp testCfg {chatVRange = mem4VRange} "dan" danProfile $ \dan -> do - createGroup3 "team" alice bob cath - connectUsers alice dan - addMember "team" alice dan GRMember - dan ##> "/j team" - concurrentlyN_ - [ alice <## "#team: dan joined the group", - do - dan <## "#team: you joined the group" - dan - <### [ "#team: member bob (Bob) is connected", - "#team: member cath (Catherine) is connected" - ], - aliceAddedDan bob, - aliceAddedDan cath - ] - if noConns23 - then contactsDontExist bob cath - else bob <##> cath - if noConns24 - then contactsDontExist bob dan - else bob <##> dan - if noConns34 - then contactsDontExist cath dan - else cath <##> dan +testNoDirectDifferentLDNs :: HasCallStack => FilePath -> IO () +testNoDirectDifferentLDNs = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath + alice ##> "/g club" + alice <## "group #club is created" + alice <## "to add members use /a club or /create link #club" + addMember "club" alice bob GRAdmin + bob ##> "/j club" + concurrently_ + (alice <## "#club: bob joined the group") + (bob <## "#club: you joined the group") + addMember "club" alice cath GRAdmin + cath ##> "/j club" + concurrentlyN_ + [ alice <## "#club: cath joined the group", + do + cath <## "#club: you joined the group" + cath <## "#club: member bob_1 (Bob) is connected", + do + bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)" + bob <## "#club: new member cath_1 is connected" + ] + + testGroupLDNs alice bob cath "team" "bob" "cath" + testGroupLDNs alice bob cath "club" "bob_1" "cath_1" + + alice `hasContactProfiles` ["alice", "bob", "cath"] + bob `hasContactProfiles` ["bob", "alice", "cath", "cath"] + cath `hasContactProfiles` ["cath", "alice", "bob", "bob"] where - aliceAddedDan :: HasCallStack => TestCC -> IO () - aliceAddedDan cc = do - cc <## "#team: alice added dan (Daniel) to the group (connecting...)" - cc <## "#team: new member dan is connected" - contactsDontExist cc1 cc2 = do - name1 <- userName cc1 - name2 <- userName cc2 - cc1 ##> ("@" <> name2 <> " hi") - cc1 <## ("no contact " <> name2) - cc2 ##> ("@" <> name1 <> " hi") - cc2 <## ("no contact " <> name1) + testGroupLDNs alice bob cath gName bobLDN cathLDN = do + alice ##> ("/ms " <> gName) + alice + <### [ "alice (Alice): owner, you, created group", + "bob (Bob): admin, invited, connected", + "cath (Catherine): admin, invited, connected" + ] + + bob ##> ("/ms " <> gName) + bob + <### [ "alice (Alice): owner, host, connected", + "bob (Bob): admin, you, connected", + ConsoleString (cathLDN <> " (Catherine): admin, connected") + ] + + cath ##> ("/ms " <> gName) + cath + <### [ "alice (Alice): owner, host, connected", + ConsoleString (bobLDN <> " (Bob): admin, connected"), + "cath (Catherine): admin, you, connected" + ] + + alice #> ("#" <> gName <> " hello") + concurrentlyN_ + [ bob <# ("#" <> gName <> " alice> hello"), + cath <# ("#" <> gName <> " alice> hello") + ] + bob #> ("#" <> gName <> " hi there") + concurrentlyN_ + [ alice <# ("#" <> gName <> " bob> hi there"), + cath <# ("#" <> gName <> " " <> bobLDN <> "> hi there") + ] + cath #> ("#" <> gName <> " hey") + concurrentlyN_ + [ alice <# ("#" <> gName <> " cath> hey"), + bob <# ("#" <> gName <> " " <> cathLDN <> "> hey") + ] + +testConnectMemberToContact :: HasCallStack => FilePath -> IO () +testConnectMemberToContact = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + connectUsers alice bob + connectUsers alice cath + 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_ + [ do + alice <## "#team: you joined the group" + alice <## "#team: member cath_1 (Catherine) is connected" + alice <## "member #team cath_1 is merged into cath", + do + bob <## "#team: alice joined the group", + do + cath <## "#team: bob added alice_1 (Alice) to the group (connecting...)" + cath <## "#team: new member alice_1 is connected" + cath <## "member #team alice_1 is merged into 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"] testMemberContactMessage :: HasCallStack => FilePath -> IO () testMemberContactMessage = @@ -2715,7 +2781,7 @@ testMemberContactMessage = \alice bob cath -> do createGroup3 "team" alice bob cath - -- TODO here and in following tests there would be no direct contacts initially, after "no direct conns" functionality is uncommented + -- alice and bob delete contacts, connect alice ##> "/d bob" alice <## "bob: contact is deleted" bob ##> "/d alice" @@ -2723,7 +2789,7 @@ testMemberContactMessage = alice ##> "@#team bob hi" alice - <### [ "member #team bob does not have associated contact, creating contact", + <### [ "member #team bob does not have direct connection, creating", "contact for member #team bob is created", "sent invitation to connect directly to member #team bob", WithTime "@bob hi" @@ -2739,29 +2805,44 @@ testMemberContactMessage = bob #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")]) alice <##> bob + -- bob and cath connect + bob ##> "@#team cath hi" + bob + <### [ "member #team cath does not have direct connection, creating", + "contact for member #team cath is created", + "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") + + cath #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")]) + bob <##> cath + testMemberContactNoMessage :: HasCallStack => FilePath -> IO () testMemberContactNoMessage = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath - alice ##> "/d bob" - alice <## "bob: contact is deleted" - bob ##> "/d alice" - bob <## "alice: contact is deleted" + -- bob and cath connect + bob ##> "/_create member contact #1 3" + bob <## "contact for member #team cath is created" - alice ##> "/_create member contact #1 2" - alice <## "contact for member #team bob is created" - - alice ##> "/_invite member contact @4" -- cath is 3, new bob contact is 4 - alice <## "sent invitation to connect directly to member #team bob" - bob <## "#team alice is creating direct contact alice with you" + bob ##> "/_invite member contact @3" + bob <## "sent invitation to connect directly to member #team cath" + cath <## "#team bob is creating direct contact bob with you" concurrently_ - (alice <## "bob (Bob): contact is connected") - (bob <## "alice (Alice): contact is connected") + (bob <## "cath (Catherine): contact is connected") + (cath <## "bob (Bob): contact is connected") - bob #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")]) - alice <##> bob + cath #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")]) + bob <##> cath testMemberContactProhibitedContactExists :: HasCallStack => FilePath -> IO () testMemberContactProhibitedContactExists = @@ -2782,30 +2863,25 @@ testMemberContactProhibitedRepeatInv = \alice bob cath -> do createGroup3 "team" alice bob cath - alice ##> "/d bob" - alice <## "bob: contact is deleted" - bob ##> "/d alice" - bob <## "alice: contact is deleted" + bob ##> "/_create member contact #1 3" + bob <## "contact for member #team cath is created" - alice ##> "/_create member contact #1 2" - alice <## "contact for member #team bob is created" - - alice ##> "/_invite member contact @4 text hi" -- cath is 3, new bob contact is 4 - alice - <### [ "sent invitation to connect directly to member #team bob", - WithTime "@bob hi" - ] - alice ##> "/_invite member contact @4 text hey" - alice <## "bad chat command: x.grp.direct.inv already sent" + bob ##> "/_invite member contact @3 text hi" bob - <### [ "#team alice is creating direct contact alice with you", - WithTime "alice> hi" + <### [ "sent invitation to connect directly to member #team cath", + WithTime "@cath hi" + ] + bob ##> "/_invite member contact @3 text hey" + bob <## "bad chat command: x.grp.direct.inv already sent" + cath + <### [ "#team bob is creating direct contact bob with you", + WithTime "bob> hi" ] concurrently_ - (alice <## "bob (Bob): contact is connected") - (bob <## "alice (Alice): contact is connected") + (bob <## "cath (Catherine): contact is connected") + (cath <## "bob (Bob): contact is connected") - alice <##> bob + bob <##> cath testMemberContactInvitedConnectionReplaced :: HasCallStack => FilePath -> IO () testMemberContactInvitedConnectionReplaced tmp = do @@ -2819,7 +2895,7 @@ testMemberContactInvitedConnectionReplaced tmp = do alice ##> "@#team bob hi" alice - <### [ "member #team bob does not have associated contact, creating contact", + <### [ "member #team bob does not have direct connection, creating", "contact for member #team bob is created", "sent invitation to connect directly to member #team bob", WithTime "@bob hi" @@ -2836,20 +2912,20 @@ testMemberContactInvitedConnectionReplaced tmp = do bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "received invitation to join group team as admin"), (0, "hi"), (0, "security code changed")] <> chatFeatures) withTestChat tmp "bob" $ \bob -> do - subscriptions bob + subscriptions bob 1 checkConnectionsWork alice bob withTestChat tmp "alice" $ \alice -> do - subscriptions alice + subscriptions alice 2 withTestChat tmp "bob" $ \bob -> do - subscriptions bob + subscriptions bob 1 checkConnectionsWork alice bob withTestChat tmp "cath" $ \cath -> do - subscriptions cath + subscriptions cath 1 -- group messages work alice #> "#team hello" @@ -2865,8 +2941,9 @@ testMemberContactInvitedConnectionReplaced tmp = do (alice <# "#team cath> hey team") (bob <# "#team cath> hey team") where - subscriptions cc = do - cc <## "2 contacts connected (use /cs for the list)" + subscriptions :: TestCC -> Int -> IO () + subscriptions cc n = do + cc <## (show n <> " contacts connected (use /cs for the list)") cc <## "#team: connected to server(s)" checkConnectionsWork alice bob = do alice <##> bob @@ -2924,14 +3001,9 @@ testMemberContactIncognito = cath `hasContactProfiles` ["cath", "alice", T.pack bobIncognito, T.pack cathIncognito] -- bob creates member contact with cath - both share incognito profile - bob ##> ("/d " <> cathIncognito) - bob <## (cathIncognito <> ": contact is deleted") - cath ##> ("/d " <> bobIncognito) - cath <## (bobIncognito <> ": contact is deleted") - bob ##> ("@#team " <> cathIncognito <> " hi") bob - <### [ ConsoleString ("member #team " <> cathIncognito <> " does not have associated contact, creating contact"), + <### [ ConsoleString ("member #team " <> cathIncognito <> " does not have direct connection, creating"), ConsoleString ("contact for member #team " <> cathIncognito <> " is created"), ConsoleString ("sent invitation to connect directly to member #team " <> cathIncognito), WithTime ("i @" <> cathIncognito <> " hi") diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index cd493ab34..f4538e4b3 100644 --- a/tests/SchemaDump.hs +++ b/tests/SchemaDump.hs @@ -69,7 +69,9 @@ skipComparisonForDownMigrations = [ -- on down migration msg_delivery_events table moves down to the end of the file "20230504_recreate_msg_delivery_events_cleanup_messages", -- on down migration idx_chat_items_timed_delete_at index moves down to the end of the file - "20230529_indexes" + "20230529_indexes", + -- table and index definitions move down the file, so fields are re-created as not unique + "20230914_member_probes" ] getSchema :: FilePath -> FilePath -> IO String