progress

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

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;
 |]

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);

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

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)

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