From 416c274d7f1972b35bb2740e730503c71ad7b40b Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sat, 16 Sep 2023 13:26:43 +0100 Subject: [PATCH] progress --- src/Simplex/Chat.hs | 116 +++++++---- .../Migrations/M20230914_member_probes.hs | 43 +--- src/Simplex/Chat/Migrations/chat_schema.sql | 25 +-- src/Simplex/Chat/Store/Direct.hs | 35 ++++ src/Simplex/Chat/Store/Groups.hs | 197 ++++++++++++++---- src/Simplex/Chat/Types.hs | 8 +- 6 files changed, 293 insertions(+), 131 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 5fbb9fc7b1..9b9d4a4930 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3196,26 +3196,24 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do _ -> 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 - ct_ <- withStore' (\db -> getViaGroupContact db user m) - notifyMemberConnected gInfo m ct_ - case ct_ of + withStore' (\db -> getViaGroupContact db user m) >>= \case Nothing -> do + notifyMemberConnected gInfo m Nothing let connectedIncognito = memberIncognito membership - when (memberCategory m == GCPreMember) $ probeMatchingMemberContact m connectedIncognito - Just ct -> do - let connectedIncognito = contactConnIncognito ct || memberIncognito membership - when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito - -- >>= \case + probeMatchingMemberContact m connectedIncognito + Just ct@Contact {activeConn = Connection {connStatus}} -> + when (connStatus == ConnReady) $ do + notifyMemberConnected gInfo m $ Just ct + let connectedIncognito = contactConnIncognito ct || memberIncognito membership + when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito + -- notifyMemberConnected gInfo m ct_ + -- case ct_ of -- Nothing -> do - -- notifyMemberConnected gInfo m Nothing -- let connectedIncognito = memberIncognito membership - -- probeMatchingMemberContact m connectedIncognito - -- messageWarning "connected member does not have contact" - -- Just ct@Contact {activeConn = Connection {connStatus}} -> - -- when (connStatus == ConnReady) $ do - -- notifyMemberConnected gInfo m $ Just ct - -- let connectedIncognito = contactConnIncognito ct || memberIncognito membership - -- when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito + -- when (memberCategory m == GCPreMember) $ probeMatchingMemberContact m connectedIncognito + -- Just ct -> do + -- let connectedIncognito = contactConnIncognito ct || memberIncognito membership + -- when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito MSG msgMeta _msgFlags msgBody -> do cmdId <- createAckCmd conn withAckMessage agentConnId cmdId msgMeta $ do @@ -3242,6 +3240,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XGrpLeave -> xGrpLeave gInfo m' msg msgMeta XGrpDel -> xGrpDel gInfo m' msg msgMeta XGrpInfo p' -> xGrpInfo gInfo m' p' msg msgMeta + XInfoProbe probe -> xInfoProbeMember gInfo m' probe BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta _ -> messageError $ "unsupported message: " <> T.pack (show event) currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo @@ -3607,23 +3606,41 @@ 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 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 - void . sendDirectContactMessage c $ XInfoProbeCheck probeHash - withStore' $ \db -> createSentProbeHash db userId probeId c + sendProbe :: Probe -> m () + sendProbe probe = void . sendDirectContactMessage ct $ XInfoProbe probe probeMatchingMemberContact :: GroupMember -> IncognitoEnabled -> m () - probeMatchingMemberContact m connectedIncognito = do - pure () + probeMatchingMemberContact GroupMember {activeConn = Nothing} _ = pure () + probeMatchingMemberContact 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 -> createSentMemberProbe db gVar userId 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) + + 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 messageWarning :: Text -> m () messageWarning = toView . CRMessageError user "warning" @@ -4189,7 +4206,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- [incognito] unless connected incognito unless (contactConnIncognito c2) $ do r <- withStore' $ \db -> matchReceivedProbe db user c2 probe - forM_ r $ \c1 -> probeMatch c1 c2 probe + forM_ r $ \c1 -> probeMatch c1 (CGMContact c2) probe + + xInfoProbeMember :: GroupInfo -> GroupMember -> Probe -> m () + xInfoProbeMember GroupInfo {membership} m2 probe = + -- [incognito] unless connected incognito + unless (memberIncognito m2) $ do + r <- withStore' $ \db -> matchReceivedMemberProbe db user m2 probe + forM_ r $ \c1 -> probeMatch c1 (CGMGroupMember m2) probe xInfoProbeCheck :: Contact -> ProbeHash -> m () xInfoProbeCheck c1 probeHash = @@ -4198,21 +4222,28 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do r <- withStore' $ \db -> matchReceivedProbeHash db user 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 m2@GroupMember {groupMemberId = mId2, memberProfile = p2, memberContactId} + | isNothing memberContactId && profilesMatch p1 p2 -> do + void . sendDirectContactMessage c1 $ XInfoProbeOk probe + connectContactToMember c1 m2 + | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" 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" + withStore' (\db -> matchSentProbe db user c1 probe) >>= \case + Just (CGMContact c2@Contact {contactId = cId2}) + | cId1 /= cId2 -> mergeContacts c1 c2 + | otherwise -> messageWarning "xInfoProbeOk ignored: same contact id" + Just (CGMGroupMember _m2) -> pure () + _ -> pure () -- to party accepting call xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> m () @@ -4324,6 +4355,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> mergeContactRecords db userId c1 c2 toView $ CRContactsMerged user c1 c2 + connectContactToMember :: Contact -> GroupMember -> m () + connectContactToMember c1 m2 = do + withStore' $ \db -> updateMemberContact db user c1 m2 + -- TODO a new event that possibly already exists in member-contact branch + saveConnInfo :: Connection -> ConnInfo -> m Connection saveConnInfo activeConn connInfo = do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo diff --git a/src/Simplex/Chat/Migrations/M20230914_member_probes.hs b/src/Simplex/Chat/Migrations/M20230914_member_probes.hs index e8f28d40d9..efc4137df1 100644 --- a/src/Simplex/Chat/Migrations/M20230914_member_probes.hs +++ b/src/Simplex/Chat/Migrations/M20230914_member_probes.hs @@ -8,48 +8,25 @@ import Database.SQLite.Simple.QQ (sql) m20230914_member_probes :: Query m20230914_member_probes = [sql| --- sent_probes -ALTER TABLE sent_probes ADD COLUMN probe_contact_id INTEGER REFERENCES contacts(contact_id) ON DELETE CASCADE; -ALTER TABLE sent_probes ADD COLUMN probe_group_member_id INTEGER REFERENCES group_members(group_member_id) ON DELETE CASCADE; -UPDATE sent_probes SET probe_contact_id = contact_id; +ALTER TABLE group_members ADD COLUMN sent_probe BLOB; +ALTER TABLE group_members ADD COLUMN received_probe BLOB; +ALTER TABLE group_members ADD COLUMN received_probe_hash BLOB; --- ALTER TABLE sent_probes DROP COLUMN contact_id; - -CREATE INDEX idx_sent_probes_user_id ON sent_probes(user_id); -CREATE UNIQUE INDEX idx_sent_probes_probe_contact_id ON sent_probes(probe_contact_id); -CREATE UNIQUE INDEX idx_sent_probes_probe_group_member_id ON sent_probes(probe_group_member_id); +CREATE INDEX idx_group_members_sent_probe ON group_members(sent_probe); +CREATE INDEX idx_group_members_received_probe_hash ON group_members(received_probe_hash); CREATE INDEX idx_sent_probes_probe ON sent_probes(probe); - --- received_probes -ALTER TABLE received_probes ADD COLUMN probe_contact_id INTEGER REFERENCES contacts(contact_id) ON DELETE CASCADE; -ALTER TABLE received_probes ADD COLUMN probe_group_member_id INTEGER REFERENCES group_members(group_member_id) ON DELETE CASCADE; -UPDATE received_probes SET probe_contact_id = contact_id; - -DROP INDEX idx_received_probes_contact_id; --- ALTER TABLE received_probes DROP COLUMN contact_id; - -CREATE UNIQUE INDEX idx_received_probes_probe_contact_id ON received_probes(probe_contact_id); -CREATE UNIQUE INDEX idx_received_probes_probe_group_member_id ON received_probes(probe_group_member_id); CREATE INDEX idx_received_probes_probe_hash ON received_probes(probe_hash); |] down_m20230914_member_probes :: Query down_m20230914_member_probes = [sql| -DROP INDEX idx_sent_probes_user_id; -DROP INDEX idx_sent_probes_probe_contact_id; -DROP INDEX idx_sent_probes_probe_group_member_id; +DROP INDEX idx_group_members_sent_probe; +DROP INDEX idx_group_members_received_probe_hash; DROP INDEX idx_sent_probes_probe; - -DROP INDEX idx_received_probes_probe_contact_id; -DROP INDEX idx_received_probes_probe_group_member_id; DROP INDEX idx_received_probes_probe_hash; -DELETE FROM sent_probes WHERE probe_contact_id IS NULL; -DELETE FROM received_probes WHERE probe_contact_id IS NULL; - --- ALTER TABLE sent_probes RENAME COLUMN probe_contact_id TO contact_id; --- ALTER TABLE received_probes RENAME COLUMN probe_contact_id TO contact_id; - -CREATE INDEX idx_received_probes_contact_id ON received_probes(contact_id); +ALTER TABLE group_members DROP COLUMN sent_probe; +ALTER TABLE group_members DROP COLUMN received_probe; +ALTER TABLE group_members DROP COLUMN received_probe_hash; |] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 79ac6ea7ee..d9c889e42f 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -82,8 +82,6 @@ CREATE TABLE sent_probes( 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), - probe_contact_id INTEGER REFERENCES contacts(contact_id) ON DELETE CASCADE, - probe_group_member_id INTEGER REFERENCES group_members(group_member_id) ON DELETE CASCADE, UNIQUE(user_id, probe) ); CREATE TABLE sent_probe_hashes( @@ -103,9 +101,7 @@ CREATE TABLE received_probes( 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), - probe_contact_id INTEGER REFERENCES contacts(contact_id) ON DELETE CASCADE, - probe_group_member_id INTEGER REFERENCES group_members(group_member_id) ON DELETE CASCADE + updated_at TEXT CHECK(updated_at NOT NULL) ); CREATE TABLE known_servers( server_id INTEGER PRIMARY KEY, @@ -172,6 +168,9 @@ CREATE TABLE group_members( created_at TEXT CHECK(created_at NOT NULL), updated_at TEXT CHECK(updated_at NOT NULL), member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL, + sent_probe BLOB, + received_probe BLOB, + received_probe_hash BLOB, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -629,6 +628,7 @@ 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); @@ -716,18 +716,9 @@ CREATE INDEX idx_chat_items_user_id_item_status ON chat_items( item_status ); CREATE INDEX idx_connections_to_subscribe ON connections(to_subscribe); -CREATE INDEX idx_sent_probes_user_id ON sent_probes(user_id); -CREATE UNIQUE INDEX idx_sent_probes_probe_contact_id ON sent_probes( - probe_contact_id -); -CREATE UNIQUE INDEX idx_sent_probes_probe_group_member_id ON sent_probes( - probe_group_member_id +CREATE INDEX idx_group_members_sent_probe ON group_members(sent_probe); +CREATE INDEX idx_group_members_received_probe_hash ON group_members( + received_probe_hash ); CREATE INDEX idx_sent_probes_probe ON sent_probes(probe); -CREATE UNIQUE INDEX idx_received_probes_probe_contact_id ON received_probes( - probe_contact_id -); -CREATE UNIQUE INDEX idx_received_probes_probe_group_member_id ON received_probes( - probe_group_member_id -); 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 609da128a7..4c3046c190 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -12,6 +12,7 @@ module Simplex.Chat.Store.Direct updateContactProfile_, updateContactProfile_', deleteContactProfile_, + deleteUnusedProfile_, -- * Contacts and connections functions getPendingContactConnection, @@ -253,6 +254,12 @@ getDeletedContacts db user@User {userId} = do getDeletedContact :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Contact getDeletedContact db user contactId = getContact_ db user contactId True +-- deleteContactProfile_ :: DB.Connection -> UserId -> Contact -> IO () +-- deleteContactProfile_ db userId Contact {contactId} = do +-- -- TODO not quite clear why there is more than one profile in this case +-- profileIds <- map fromOnly <$> DB.query db "SELECT contact_profile_id FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId) +-- mapM_ (deleteUnusedProfile_ db userId) profileIds + deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO () deleteContactProfile_ db userId contactId = DB.execute @@ -267,6 +274,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 89499e4486..6e0059cfa0 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -73,13 +73,17 @@ module Simplex.Chat.Store.Groups getViaGroupMember, getViaGroupContact, getMatchingContacts, + getMatchingMemberContacts, createSentProbe, + createSentMemberProbe, createSentProbeHash, deleteSentProbe, matchReceivedProbe, + matchReceivedMemberProbe, matchReceivedProbeHash, matchSentProbe, mergeContactRecords, + updateMemberContact, updateGroupSettings, getXGrpMemIntroContDirect, getXGrpMemIntroContGroup, @@ -89,6 +93,7 @@ where import Control.Monad.Except import Crypto.Random (ChaChaDRG) +import Data.ByteString.Char8 (ByteString) import Data.Either (rights) import Data.Int (Int64) import Data.Maybe (fromMaybe, isNothing) @@ -1124,20 +1129,39 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName = 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 + 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 = ? + |] + +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 -> Contact -> ExceptT StoreError IO (Probe, Int64) createSentProbe db gVar userId _to@Contact {contactId} = @@ -1149,6 +1173,16 @@ createSentProbe db gVar userId _to@Contact {contactId} = (contactId, probe, userId, currentTs, currentTs) (Probe probe,) <$> insertedRowId db +createSentMemberProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> GroupMember -> ExceptT StoreError IO (Probe, Int64) +createSentMemberProbe db gVar userId _to@GroupMember {groupMemberId} = + createWithRandomBytes 32 gVar $ \probe -> do + currentTs <- getCurrentTime + DB.execute + db + "UPDATE group_members SET sent_probe = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?" + (probe, currentTs, userId, groupMemberId) + (Probe probe,) <$> insertedRowId db + createSentProbeHash :: DB.Connection -> UserId -> Int64 -> Contact -> IO () createSentProbeHash db userId probeId _to@Contact {contactId} = do currentTs <- getCurrentTime @@ -1165,7 +1199,16 @@ deleteSentProbe db userId probeId = (userId, probeId) matchReceivedProbe :: DB.Connection -> User -> Contact -> Probe -> IO (Maybe Contact) -matchReceivedProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = do +matchReceivedProbe db user@User {userId} _from@(Contact {contactId}) p@(Probe probe) = + matchReceivedProbe_ db user p $ \probeHash -> do + currentTs <- getCurrentTime + 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) + +matchReceivedProbe_ :: DB.Connection -> User -> Probe -> (ByteString -> IO ()) -> IO (Maybe Contact) +matchReceivedProbe_ db user@User {userId} (Probe probe) addProbe = do let probeHash = C.sha256Hash probe contactIds <- map fromOnly @@ -1178,39 +1221,60 @@ matchReceivedProbe db user@User {userId} _from@Contact {contactId} (Probe probe) WHERE c.user_id = ? AND c.deleted = 0 AND r.probe_hash = ? AND r.probe IS NULL |] (userId, probeHash) - currentTs <- getCurrentTime - 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) + addProbe probeHash case contactIds of [] -> pure Nothing cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId) -matchReceivedProbeHash :: DB.Connection -> User -> Contact -> ProbeHash -> IO (Maybe (Contact, Probe)) -matchReceivedProbeHash db user@User {userId} _from@Contact {contactId} (ProbeHash probeHash) = do - namesAndProbes <- - DB.query +matchReceivedMemberProbe :: DB.Connection -> User -> GroupMember -> Probe -> IO (Maybe Contact) +matchReceivedMemberProbe db user@User {userId} _from@(GroupMember {groupMemberId}) p@(Probe probe) = + matchReceivedProbe_ db user p $ \probeHash -> do + currentTs <- getCurrentTime + DB.execute 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) + "UPDATE group_members SET received_probe = ?, received_probe_hash = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?" + (probe, probeHash, currentTs, userId, groupMemberId) + +matchReceivedProbeHash :: DB.Connection -> User -> Contact -> ProbeHash -> IO (Maybe (ContactOrGroupMember, Probe)) +matchReceivedProbeHash db user@User {userId} _from@Contact {contactId} (ProbeHash probeHash) = do + r <- getContacts >>= \case + [] -> + getMembers >>= \case + [] -> pure Nothing + (gId, mId, probe) : _ -> get CGMGroupMember probe $ getGroupMember db user gId mId + (cId, probe) : _ -> get CGMContact probe $ getContact db user cId 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) + pure r + where + getContacts :: IO [(ContactId, ByteString)] + getContacts = + 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) + getMembers :: IO [(ContactId, GroupMemberId, ByteString)] + getMembers = + DB.query + db + [sql| + SELECT group_id, group_member_id, received_probe + FROM group_members + WHERE user_id = ? AND received_probe_hash = ? AND received_probe IS NOT NULL + |] + (userId, probeHash) + get :: (a -> ContactOrGroupMember) -> ByteString -> ExceptT StoreError IO a -> IO (Maybe (ContactOrGroupMember, Probe)) + get cgm probe a = either (const Nothing) (Just . (,Probe probe) . cgm) <$> runExceptT a -matchSentProbe :: DB.Connection -> User -> Contact -> Probe -> IO (Maybe Contact) +matchSentProbe :: DB.Connection -> User -> Contact -> Probe -> IO (Maybe ContactOrGroupMember) matchSentProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = do contactIds <- map fromOnly @@ -1226,7 +1290,7 @@ matchSentProbe db user@User {userId} _from@Contact {contactId} (Probe probe) = d (userId, probe, contactId) case contactIds of [] -> pure Nothing - cId : _ -> eitherToMaybe <$> runExceptT (getContact db user cId) + cId : _ -> eitherToMaybe <$> runExceptT (CGMContact <$> getContact db user cId) mergeContactRecords :: DB.Connection -> UserId -> Contact -> Contact -> IO () mergeContactRecords db userId ct1 ct2 = do @@ -1274,7 +1338,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 @@ -1287,6 +1351,63 @@ 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 + 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, 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/Types.hs b/src/Simplex/Chat/Types.hs index 319142c08c..98757ce7cf 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -214,6 +214,8 @@ data ContactRef = ContactRef instance ToJSON ContactRef where toEncoding = J.genericToEncoding J.defaultOptions +data ContactOrGroupMember = CGMContact Contact | CGMGroupMember GroupMember + data UserContact = UserContact { userContactLinkId :: Int64, connReqContact :: ConnReqContact, @@ -425,10 +427,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