Merge branch 'master' into master-android

src/Simplex/Chat.hs

@@ -69,6 +69,7 @@ import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Util
+import Simplex.Chat.Util (encryptFile)
 import Simplex.FileTransfer.Client.Main (maxFileSize)
 import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
 import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
@@ -1462,13 +1463,13 @@ processChatCommand = \case
     -- TODO for large groups: no need to load all members to determine if contact is a member
     (group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db user contactId
     assertDirectAllowed user MDSnd contact XGrpInv_
-    let Group gInfo@GroupInfo {membership} members = group
+    let Group gInfo members = group
         Contact {localDisplayName = cName} = contact
     assertUserGroupRole gInfo $ max GRAdmin memRole
     -- [incognito] forbid to invite contact to whom user is connected incognito
     when (contactConnIncognito contact) $ throwChatError CEContactIncognitoCantInvite
     -- [incognito] forbid to invite contacts if user joined the group using an incognito profile
-    when (memberIncognito membership) $ throwChatError CEGroupIncognitoCantInvite
+    when (incognitoMembership gInfo) $ throwChatError CEGroupIncognitoCantInvite
     let sendInvitation = sendGrpInvitation user contact gInfo
     case contactMember contact members of
       Nothing -> do
@@ -1726,22 +1727,15 @@ processChatCommand = \case
       ft' <- if encrypted then encryptLocalFile ft else pure ft
       receiveFile' user ft' rcvInline_ filePath_
     where
-      encryptLocalFile ft@RcvFileTransfer {xftpRcvFile} = case xftpRcvFile of
-        Nothing -> throwChatError $ CEFileInternal "locally encrypted files can't be received via SMP"
-        Just f -> do
-          cfArgs <- liftIO $ CF.randomArgs
-          withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
-          pure ft {xftpRcvFile = Just ((f :: XFTPRcvFile) {cryptoArgs = Just cfArgs})}
+      encryptLocalFile ft = do
+        cfArgs <- liftIO $ CF.randomArgs
+        withStore' $ \db -> setFileCryptoArgs db fileId cfArgs
+        pure (ft :: RcvFileTransfer) {cryptoArgs = Just cfArgs}
   SetFileToReceive fileId encrypted -> withUser $ \_ -> do
     withChatLock "setFileToReceive" . procCmd $ do
-      cfArgs <- if encrypted then fileCryptoArgs else pure Nothing
+      cfArgs <- if encrypted then Just <$> liftIO CF.randomArgs else pure Nothing
       withStore' $ \db -> setRcvFileToReceive db fileId cfArgs
       ok_
-    where
-      fileCryptoArgs = do
-        (_, RcvFileTransfer {xftpRcvFile = f}) <- withStore (`getRcvFileTransferById` fileId)
-        unless (isJust f) $ throwChatError $ CEFileInternal "locally encrypted files can't be received via SMP"
-        liftIO $ Just <$> CF.randomArgs
   CancelFile fileId -> withUser $ \user@User {userId} ->
     withChatLock "cancelFile" . procCmd $
       withStore (\db -> getFileTransfer db user fileId) >>= \case
@@ -2311,7 +2305,7 @@ receiveFile' user ft rcvInline_ filePath_ = do
       e -> throwError e
 
 acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> m AChatItem
-acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
+acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId, cryptoArgs} rcvInline_ filePath_ = do
   unless (fileStatus == RFSNew) $ case fileStatus of
     RFSCancelled _ -> throwChatError $ CEFileCancelled fName
     _ -> throwChatError $ CEFileAlreadyReceiving fName
@@ -2324,7 +2318,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
       filePath <- getRcvFilePath fileId filePath_ fName True
       withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath subMode
     -- XFTP
-    (Just XFTPRcvFile {cryptoArgs}, _) -> do
+    (Just XFTPRcvFile {}, _) -> do
       filePath <- getRcvFilePath fileId filePath_ fName False
       (ci, rfd) <- withStoreCtx (Just "acceptFileReceive, xftpAcceptRcvFT ...") $ \db -> do
         -- marking file as accepted and reading description in the same transaction
@@ -2398,7 +2392,7 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
     asks filesFolder >>= readTVarIO >>= \case
       Nothing -> do
         dir <- (`combine` "Downloads") <$> getHomeDirectory
-        ifM (doesDirectoryExist dir) (pure dir) getTemporaryDirectory
+        ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory
           >>= (`uniqueCombine` fn)
           >>= createEmptyFile
       Just filesFolder ->
@@ -2426,14 +2420,18 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
       pure fPath
     getTmpHandle :: FilePath -> m Handle
     getTmpHandle fPath = openFile fPath AppendMode `catchThrow` (ChatError . CEFileInternal . show)
-    uniqueCombine :: FilePath -> String -> m FilePath
-    uniqueCombine filePath fileName = tryCombine (0 :: Int)
-      where
-        tryCombine n =
-          let (name, ext) = splitExtensions fileName
-              suffix = if n == 0 then "" else "_" <> show n
-              f = filePath `combine` (name <> suffix <> ext)
-           in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
+
+uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
+uniqueCombine filePath fileName = tryCombine (0 :: Int)
+  where
+    tryCombine n =
+      let (name, ext) = splitExtensions fileName
+          suffix = if n == 0 then "" else "_" <> show n
+          f = filePath `combine` (name <> suffix <> ext)
+       in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
+
+getChatTempDirectory :: ChatMonad m => m FilePath
+getChatTempDirectory = chatReadVar tempDirectory >>= maybe getTemporaryDirectory pure
 
 acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
 acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do
@@ -3029,7 +3027,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
@@ -3054,10 +3052,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               -- TODO update member profile
               -- [async agent commands] no continuation needed, but command should be asynchronous for stability
               allowAgentConnectionAsync user conn' confId XOk
-            XOk -> do
-              allowAgentConnectionAsync user conn' confId XOk
-              void $ withStore' $ \db -> resetMemberContactFields db ct
-            _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.ok"
+            XInfo profile -> do
+              ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct)
+              -- [incognito] send incognito profile
+              incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
+              let p = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct')
+              allowAgentConnectionAsync user conn' confId $ XInfo p
+              void $ withStore' $ \db -> resetMemberContactFields db ct'
+            _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info"
         INFO connInfo -> do
           ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
           _conn' <- updatePeerChatVRange conn chatVRange
@@ -3066,9 +3068,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               -- TODO check member ID
               -- TODO update member profile
               pure ()
-            XInfo _profile -> do
-              -- TODO update contact profile
-              pure ()
+            XInfo profile ->
+              void $ processContactProfileUpdate ct profile False
             XOk -> pure ()
             _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok"
         CON ->
@@ -3095,10 +3096,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                       groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
                       withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode
                   _ -> pure ()
-            Just (gInfo@GroupInfo {membership}, m@GroupMember {activeConn}) ->
+            Just (gInfo, m@GroupMember {activeConn}) ->
               when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
                 notifyMemberConnected gInfo m $ Just ct
-                let connectedIncognito = contactConnIncognito ct || memberIncognito membership
+                let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
                 when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito
         SENT msgId -> do
           sentMsgDeliveryEvent conn msgId
@@ -3161,7 +3162,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
@@ -3262,16 +3263,16 @@ 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
-                  let connectedIncognito = contactConnIncognito ct || memberIncognito membership
+                  let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
                   when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito
       MSG msgMeta _msgFlags msgBody -> do
         cmdId <- createAckCmd conn
@@ -3300,6 +3301,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
@@ -3501,12 +3505,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           RcvChunkOk ->
             if B.length chunk /= fromInteger chunkSize
               then badRcvFileChunk ft "incorrect chunk size"
-              else ack $ appendFileChunk ft chunkNo chunk
+              else ack $ appendFileChunk ft chunkNo chunk False
           RcvChunkFinal ->
             if B.length chunk > fromInteger chunkSize
               then badRcvFileChunk ft "incorrect chunk size"
               else do
-                appendFileChunk ft chunkNo chunk
+                appendFileChunk ft chunkNo chunk True
                 ci <- withStore $ \db -> do
                   liftIO $ do
                     updateRcvFileStatus db fileId FSComplete
@@ -3514,7 +3518,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                     deleteRcvFileChunks db ft
                   getChatItemByFileId db user fileId
                 toView $ CRRcvFileComplete user ci
-                closeFileHandle fileId rcvFiles
                 forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn)
           RcvChunkDuplicate -> ack $ pure ()
           RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
@@ -3556,8 +3559,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                         ct <- acceptContactRequestAsync user cReq incognitoProfile
                         toView $ CRAcceptingContactRequest user ct
                       Just groupId -> do
-                        gInfo@GroupInfo {membership = membership@GroupMember {memberProfile}} <- withStore $ \db -> getGroupInfo db user groupId
-                        let profileMode = if memberIncognito membership then Just $ ExistingIncognito memberProfile else Nothing
+                        gInfo <- withStore $ \db -> getGroupInfo db user groupId
+                        let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
                         ct <- acceptContactRequestAsync user cReq profileMode
                         toView $ CRAcceptingGroupJoinRequest user gInfo ct
                     _ -> do
@@ -3665,19 +3668,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"
@@ -3737,14 +3763,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     processFDMessage fileId fileDescr = do
       ft <- withStore $ \db -> getRcvFileTransfer db user fileId
       unless (rcvFileCompleteOrCancelled ft) $ do
-        (rfd, RcvFileTransfer {fileStatus, xftpRcvFile}) <- withStore $ \db -> do
+        (rfd, RcvFileTransfer {fileStatus, xftpRcvFile, cryptoArgs}) <- withStore $ \db -> do
           rfd <- appendRcvFD db userId fileId fileDescr
           -- reading second time in the same transaction as appending description
           -- to prevent race condition with accept
           ft' <- getRcvFileTransfer db user fileId
           pure (rfd, ft')
         case (fileStatus, xftpRcvFile) of
-          (RFSAccepted _, Just XFTPRcvFile {cryptoArgs}) -> receiveViaCompleteFD user fileId rfd cryptoArgs
+          (RFSAccepted _, Just XFTPRcvFile {}) -> receiveViaCompleteFD user fileId rfd cryptoArgs
           _ -> pure ()
 
     cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
@@ -4201,15 +4227,22 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       MsgError e -> createInternalChatItem user cd (CIRcvIntegrityError e) (Just brokerTs)
 
     xInfo :: Contact -> Profile -> m ()
-    xInfo c@Contact {profile = p} p' = unless (fromLocalProfile p == p') $ do
-      c' <- withStore $ \db ->
-        if userTTL == rcvTTL
-          then updateContactProfile db user c p'
-          else do
-            c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
-            updateContactProfile db user c' p'
-      when (directOrUsed c') $ createRcvFeatureItems user c c'
-      toView $ CRContactUpdated user c c'
+    xInfo c p' = void $ processContactProfileUpdate c p' True
+
+    processContactProfileUpdate :: Contact -> Profile -> Bool -> m Contact
+    processContactProfileUpdate c@Contact {profile = p} p' createItems
+      | fromLocalProfile p /= p' = do
+        c' <- withStore $ \db ->
+          if userTTL == rcvTTL
+            then updateContactProfile db user c p'
+            else do
+              c' <- liftIO $ updateContactUserPreferences db user c ctUserPrefs'
+              updateContactProfile db user c' p'
+        when (directOrUsed c' && createItems) $ createRcvFeatureItems user c c'
+        toView $ CRContactUpdated user c c'
+        pure c'
+      | otherwise =
+        pure c
       where
         Contact {userPreferences = ctUserPrefs@Preferences {timedMessages = ctUserTMPref}} = c
         userTTL = prefParam $ getPreference SCFTimedMessages ctUserPrefs
@@ -4238,35 +4271,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 ()
@@ -4378,6 +4424,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
@@ -4404,7 +4455,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
             toView $ CRJoinedGroupMemberConnecting user gInfo m newMember
 
     xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m ()
-    xGrpMemIntro gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do
+    xGrpMemIntro gInfo@GroupInfo {chatSettings = ChatSettings {enableNtfs}} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do
       case memberCategory m of
         GCHostMember -> do
           members <- withStore' $ \db -> getGroupMembers db user gInfo
@@ -4418,9 +4469,9 @@ 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 = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing
+              let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
               void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId subMode
         _ -> messageError "x.grp.mem.intro can be only sent by host member"
       where
@@ -4464,7 +4515,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
       -- [async agent commands] no continuation needed, but commands should be asynchronous for stability
       groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode
       directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr dm subMode
-      let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing
+      let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
           mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange
       withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode
 
@@ -4589,7 +4640,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           (mCt', m') <- withStore' $ \db -> createMemberContactInvited db user connIds g m mConn subMode
           createItems mCt' m'
         joinConn subMode = do
-          dm <- directMessage XOk
+          -- [incognito] send membership incognito profile
+          let p = userProfileToSend user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing
+          dm <- directMessage $ XInfo p
           joinAgentConnectionAsync user True connReq dm subMode
         createItems mCt' m' = do
           checkIntegrityCreateItem (CDGroupRcv g m') msgMeta
@@ -4733,8 +4786,8 @@ readFileChunk SndFileTransfer {fileId, filePath, chunkSize} chunkNo = do
 parseFileChunk :: ChatMonad m => ByteString -> m FileChunk
 parseFileChunk = liftEither . first (ChatError . CEFileRcvChunk) . smpDecode
 
-appendFileChunk :: ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> m ()
-appendFileChunk ft@RcvFileTransfer {fileId, fileStatus} chunkNo chunk =
+appendFileChunk :: forall m. ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> Bool -> m ()
+appendFileChunk ft@RcvFileTransfer {fileId, fileInvitation, fileStatus, cryptoArgs} chunkNo chunk final =
   case fileStatus of
     RFSConnected RcvFileInfo {filePath} -> append_ filePath
     -- sometimes update of file transfer status to FSConnected
@@ -4743,11 +4796,27 @@ appendFileChunk ft@RcvFileTransfer {fileId, fileStatus} chunkNo chunk =
     RFSCancelled _ -> pure ()
     _ -> throwChatError $ CEFileInternal "receiving file transfer not in progress"
   where
+    append_ :: FilePath -> m ()
     append_ filePath = do
       fsFilePath <- toFSFilePath filePath
       h <- getFileHandle fileId fsFilePath rcvFiles AppendMode
-      liftIO (B.hPut h chunk >> hFlush h) `catchThrow` (ChatError . CEFileWrite filePath . show)
+      liftIO (B.hPut h chunk >> hFlush h) `catchThrow` (fileErr  . show)
       withStore' $ \db -> updatedRcvFileChunkStored db ft chunkNo
+      when final $ do
+        closeFileHandle fileId rcvFiles
+        forM_ cryptoArgs $ \cfArgs -> do
+          tmpFile <- getChatTempDirectory >>= (`uniqueCombine` fileName (fileInvitation :: FileInvitation))
+          tryChatError (liftError encryptErr $ encryptFile fsFilePath tmpFile cfArgs) >>= \case
+            Right () -> do
+              removeFile fsFilePath `catchChatError` \_ -> pure ()
+              renameFile tmpFile fsFilePath
+            Left e -> do
+              toView $ CRChatError Nothing e
+              removeFile tmpFile `catchChatError` \_ -> pure ()
+              withStore' (`removeFileCryptoArgs` fileId)
+      where
+        encryptErr e = fileErr $ e <> ", received file not encrypted"
+        fileErr = ChatError . CEFileWrite filePath
 
 getFileHandle :: ChatMonad m => Int64 -> FilePath -> (ChatController -> TVar (Map Int64 Handle)) -> IOMode -> m Handle
 getFileHandle fileId filePath files ioMode = do

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}

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

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

src/Simplex/Chat/Mobile/File.hs

@@ -32,6 +32,7 @@ import Foreign.Ptr
 import Foreign.Storable (poke)
 import GHC.Generics (Generic)
 import Simplex.Chat.Mobile.Shared
+import Simplex.Chat.Util (chunkSize, encryptFile)
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..), CryptoFileHandle, FTCryptoError (..))
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
@@ -103,16 +104,8 @@ chatEncryptFile fromPath toPath =
   where
     encrypt = do
       cfArgs <- liftIO $ CF.randomArgs
-      let toFile = CryptoFile toPath $ Just cfArgs
-      withExceptT show $
-        withFile fromPath ReadMode $ \r -> CF.withFile toFile WriteMode $ \w -> do
-          encryptChunks r w
-          liftIO $ CF.hPutTag w
+      encryptFile fromPath toPath cfArgs
       pure cfArgs
-    encryptChunks r w = do
-      ch <- liftIO $ LB.hGet r chunkSize
-      unless (LB.null ch) $ liftIO $ CF.hPut w ch
-      unless (LB.length ch < chunkSize) $ encryptChunks r w
 
 cChatDecryptFile :: CString -> CString -> CString -> CString -> IO CString
 cChatDecryptFile cFromPath cKey cNonce cToPath = do
@@ -147,7 +140,3 @@ chatDecryptFile fromPath keyStr nonceStr toPath = fromLeft "" <$> runCatchExcept
 
 runCatchExceptT :: ExceptT String IO a -> IO (Either String a)
 runCatchExceptT action = runExceptT action `catchAll` (pure . Left . show)
-
-chunkSize :: Num a => a
-chunkSize = 65536
-{-# INLINE chunkSize #-}

src/Simplex/Chat/Store/Direct.hs

@@ -12,6 +12,7 @@ module Simplex.Chat.Store.Direct
     updateContactProfile_,
     updateContactProfile_',
     deleteContactProfile_,
+    deleteUnusedProfile_,
 
     -- * Contacts and connections functions
     getPendingContactConnection,
@@ -267,6 +268,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/Files.hs

@@ -57,6 +57,7 @@ module Simplex.Chat.Store.Files
     xftpAcceptRcvFT,
     setRcvFileToReceive,
     setFileCryptoArgs,
+    removeFileCryptoArgs,
     getRcvFilesToReceive,
     setRcvFTAgentDeleted,
     updateRcvFileStatus,
@@ -485,7 +486,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
   rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
   let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
       -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
-      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
+      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
       fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
   fileId <- liftIO $ do
     DB.execute
@@ -498,7 +499,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
       db
       "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
       (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
+  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing}
 
 createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
 createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
@@ -506,7 +507,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
   rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
   let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
       -- cryptoArgs = Nothing here, the decision to encrypt is made when receiving it
-      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False, cryptoArgs = Nothing}) <$> rfd_
+      xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
       fileProtocol = if isJust rfd_ then FPXFTP else FPSMP
   fileId <- liftIO $ do
     DB.execute
@@ -519,7 +520,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
       db
       "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
       (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs)
-  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
+  pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId, cryptoArgs = Nothing}
 
 createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
 createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
@@ -637,8 +638,8 @@ getRcvFileTransfer db User {userId} fileId = do
         ft senderDisplayName fileStatus =
           let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
               cryptoArgs = CFArgs <$> fileKey <*> fileNonce
-              xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, cryptoArgs}) <$> rfd_
-           in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
+              xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted}) <$> rfd_
+           in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs}
         rfi = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_
         rfi_ = case (filePath_, connId_, agentConnId_) of
           (Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
@@ -707,6 +708,11 @@ setFileCryptoArgs_ db fileId (CFArgs key nonce) currentTs =
     "UPDATE files SET file_crypto_key = ?, file_crypto_nonce = ?, updated_at = ? WHERE file_id = ?"
     (key, nonce, currentTs, fileId)
 
+removeFileCryptoArgs :: DB.Connection -> FileTransferId -> IO ()
+removeFileCryptoArgs db fileId = do
+  currentTs <- getCurrentTime
+  DB.execute db "UPDATE files SET file_crypto_key = NULL, file_crypto_nonce = NULL, updated_at = ? WHERE file_id = ?" (currentTs, fileId)
+
 getRcvFilesToReceive :: DB.Connection -> User -> IO [RcvFileTransfer]
 getRcvFilesToReceive db user@User {userId} = do
   cutoffTs <- addUTCTime (- (2 * nominalDay)) <$> getCurrentTime

src/Simplex/Chat/Store/Groups.hs

@@ -74,13 +74,14 @@ module Simplex.Chat.Store.Groups
     getViaGroupMember,
     getViaGroupContact,
     getMatchingContacts,
+    getMatchingMemberContacts,
     createSentProbe,
     createSentProbeHash,
-    deleteSentProbe,
     matchReceivedProbe,
     matchReceivedProbeHash,
     matchSentProbe,
     mergeContactRecords,
+    updateMemberContact,
     updateGroupSettings,
     getXGrpMemIntroContDirect,
     getXGrpMemIntroContGroup,
@@ -115,7 +116,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
 
@@ -415,13 +416,12 @@ deleteGroupConnectionsAndFiles db User {userId} GroupInfo {groupId} members = do
   DB.execute db "DELETE FROM files WHERE user_id = ? AND group_id = ?" (userId, groupId)
 
 deleteGroupItemsAndMembers :: DB.Connection -> User -> GroupInfo -> [GroupMember] -> IO ()
-deleteGroupItemsAndMembers db user@User {userId} GroupInfo {groupId} members = do
+deleteGroupItemsAndMembers db user@User {userId} g@GroupInfo {groupId} members = do
   DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId)
   void $ runExceptT cleanupHostGroupLinkConn_ -- to allow repeat connection via the same group link if one was used
   DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId)
-  forM_ members $ \m@GroupMember {memberProfile = LocalProfile {profileId}} -> do
-    cleanupMemberProfileAndName_ db user m
-    when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user profileId
+  forM_ members $ cleanupMemberProfileAndName_ db user
+  forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
   where
     cleanupHostGroupLinkConn_ = do
       hostId <- getHostMemberId_ db user groupId
@@ -439,11 +439,11 @@ deleteGroupItemsAndMembers db user@User {userId} GroupInfo {groupId} members = d
           (userId, userId, hostId)
 
 deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
-deleteGroup db user@User {userId} GroupInfo {groupId, localDisplayName, membership = membership@GroupMember {memberProfile = LocalProfile {profileId}}} = do
+deleteGroup db user@User {userId} g@GroupInfo {groupId, localDisplayName} = do
   deleteGroupProfile_ db userId groupId
   DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
   DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
-  when (memberIncognito membership) $ deleteUnusedIncognitoProfileById_ db user profileId
+  forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
 
 deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
 deleteGroupProfile_ db userId groupId =
@@ -810,12 +810,12 @@ checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} =
   maybeFirstRow fromOnly $ DB.query db "SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ? LIMIT 1" (userId, groupId, groupMemberId)
 
 deleteGroupMember :: DB.Connection -> User -> GroupMember -> IO ()
-deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, memberProfile = LocalProfile {profileId}} = do
+deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, memberProfile} = do
   deleteGroupMemberConnection db user m
   DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ? AND group_member_id = ?" (userId, groupId, groupMemberId)
   DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId)
   cleanupMemberProfileAndName_ db user m
-  when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user profileId
+  when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user $ localProfileId memberProfile
 
 cleanupMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO ()
 cleanupMemberProfileAndName_ db User {userId} GroupMember {groupMemberId, memberContactId, memberContactProfileId, localDisplayName} =
@@ -1154,109 +1154,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
@@ -1304,7 +1331,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
@@ -1317,6 +1344,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)
@@ -1393,12 +1478,12 @@ createMemberContact
   user@User {userId, profile = LocalProfile {preferences}}
   acId
   cReq
-  GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
+  gInfo
   GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId}
   Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
   subMode = do
     currentTs <- getCurrentTime
-    let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
+    let incognitoProfile = incognitoMembershipProfile gInfo
         customUserProfileId = localProfileId <$> incognitoProfile
         userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
     DB.execute
@@ -1459,13 +1544,12 @@ createMemberContactInvited
   db
   user@User {userId, profile = LocalProfile {preferences}}
   connIds
-  gInfo@GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
+  gInfo
   m@GroupMember {groupMemberId, localDisplayName = memberLDN, memberProfile, memberContactProfileId}
   mConn
   subMode = do
     currentTs <- liftIO getCurrentTime
-    let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
-        userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
+    let userPreferences = fromMaybe emptyChatPrefs $ incognitoMembershipProfile gInfo >> preferences
     contactId <- createContactUpdateMember currentTs userPreferences
     ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
     let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
@@ -1518,13 +1602,12 @@ createMemberContactConn_
   db
   user@User {userId}
   (cmdId, acId)
-  GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
+  gInfo
   _memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
   contactId
   subMode = do
     currentTs <- liftIO getCurrentTime
-    let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
-        customUserProfileId = localProfileId <$> incognitoProfile
+    let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo
     DB.execute
       db
       [sql|

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

src/Simplex/Chat/Types.hs

@@ -216,6 +216,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,
@@ -427,10 +440,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
@@ -588,8 +601,13 @@ data GroupMember = GroupMember
     memberStatus :: GroupMemberStatus,
     invitedBy :: InvitedBy,
     localDisplayName :: ContactName,
+    -- for membership, memberProfile can be either user's profile or incognito profile, based on memberIncognito test.
+    -- for other members it's whatever profile the local user can see (there is no info about whether it's main or incognito profile for remote users).
     memberProfile :: LocalProfile,
+    -- this is the ID of the associated contact (it will be used to send direct messages to the member)
     memberContactId :: Maybe ContactId,
+    -- for membership it would always point to user's contact
+    -- it is used to test for incognito status by comparing with ID in memberProfile
     memberContactProfileId :: ProfileId,
     activeConn :: Maybe Connection
   }
@@ -620,6 +638,15 @@ groupMemberId' GroupMember {groupMemberId} = groupMemberId
 memberIncognito :: GroupMember -> IncognitoEnabled
 memberIncognito GroupMember {memberProfile, memberContactProfileId} = localProfileId memberProfile /= memberContactProfileId
 
+incognitoMembership :: GroupInfo -> IncognitoEnabled
+incognitoMembership GroupInfo {membership} = memberIncognito membership
+
+-- returns profile when membership is incognito, otherwise Nothing
+incognitoMembershipProfile :: GroupInfo -> Maybe LocalProfile
+incognitoMembershipProfile GroupInfo {membership = m@GroupMember {memberProfile}}
+  | memberIncognito m = Just memberProfile
+  | otherwise = Nothing
+
 memberSecurityCode :: GroupMember -> Maybe SecurityCode
 memberSecurityCode GroupMember {activeConn} = connectionCode =<< activeConn
 
@@ -957,7 +984,10 @@ data RcvFileTransfer = RcvFileTransfer
     senderDisplayName :: ContactName,
     chunkSize :: Integer,
     cancelled :: Bool,
-    grpMemberId :: Maybe Int64
+    grpMemberId :: Maybe Int64,
+    -- XFTP files are encrypted as they are received, they are never stored unecrypted
+    -- SMP files are encrypted after all chunks are received
+    cryptoArgs :: Maybe CryptoFileArgs
   }
   deriving (Eq, Show, Generic)
 
@@ -966,8 +996,7 @@ instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.default
 data XFTPRcvFile = XFTPRcvFile
   { rcvFileDescription :: RcvFileDescr,
     agentRcvFileId :: Maybe AgentRcvFileId,
-    agentRcvFileDeleted :: Bool,
-    cryptoArgs :: Maybe CryptoFileArgs
+    agentRcvFileDeleted :: Bool
   }
   deriving (Eq, Show, Generic)
 

src/Simplex/Chat/Util.hs

@@ -1,6 +1,32 @@
-module Simplex.Chat.Util (week) where
+module Simplex.Chat.Util (week, encryptFile, chunkSize) where
 
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.IO.Class
+import qualified Data.ByteString.Lazy as LB
 import Data.Time (NominalDiffTime)
+import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
+import qualified Simplex.Messaging.Crypto.File as CF
+import UnliftIO.IO (IOMode (..), withFile)
 
 week :: NominalDiffTime
 week = 7 * 86400
+
+encryptFile :: FilePath -> FilePath -> CryptoFileArgs -> ExceptT String IO ()
+encryptFile fromPath toPath cfArgs = do
+  let toFile = CryptoFile toPath $ Just cfArgs
+  -- uncomment to test encryption error in runTestFileTransferEncrypted
+  -- throwError "test error"
+  withExceptT show $
+    withFile fromPath ReadMode $ \r -> CF.withFile toFile WriteMode $ \w -> do
+      encryptChunks r w
+      liftIO $ CF.hPutTag w
+  where
+    encryptChunks r w = do
+      ch <- liftIO $ LB.hGet r chunkSize
+      unless (LB.null ch) $ liftIO $ CF.hPut w ch
+      unless (LB.length ch < chunkSize) $ encryptChunks r w
+
+chunkSize :: Num a => a
+chunkSize = 65536
+{-# INLINE chunkSize #-}

src/Simplex/Chat/View.hs

@@ -230,10 +230,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
@@ -772,21 +773,21 @@ viewDirectMessagesProhibited MDSnd c = ["direct messages to indirect contact " <
 viewDirectMessagesProhibited MDRcv c = ["received prohibited direct message from indirect contact " <> ttyContact' c <> " (discarded)"]
 
 viewUserJoinedGroup :: GroupInfo -> [StyledString]
-viewUserJoinedGroup g@GroupInfo {membership = membership@GroupMember {memberProfile}} =
-  if memberIncognito membership
-    then [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile memberProfile)]
-    else [ttyGroup' g <> ": you joined the group"]
+viewUserJoinedGroup g =
+  case incognitoMembershipProfile g of
+    Just mp -> [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile mp)]
+    Nothing -> [ttyGroup' g <> ": you joined the group"]
 
 viewJoinedGroupMember :: GroupInfo -> GroupMember -> [StyledString]
 viewJoinedGroupMember g m =
   [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
 
 viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString]
-viewReceivedGroupInvitation g@GroupInfo {membership = membership@GroupMember {memberProfile}} c role =
+viewReceivedGroupInvitation g c role =
   ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role) :
-  if memberIncognito membership
-    then ["use " <> highlight ("/j " <> groupName' g) <> " to join incognito as " <> incognitoProfile' (fromLocalProfile memberProfile)]
-    else ["use " <> highlight ("/j " <> groupName' g) <> " to accept"]
+  case incognitoMembershipProfile g of
+    Just mp -> ["use " <> highlight ("/j " <> groupName' g) <> " to join incognito as " <> incognitoProfile' (fromLocalProfile mp)]
+    Nothing -> ["use " <> highlight ("/j " <> groupName' g) <> " to accept"]
 
 groupPreserved :: GroupInfo -> [StyledString]
 groupPreserved g = ["use " <> highlight ("/d #" <> groupName' g) <> " to delete the group"]
@@ -874,7 +875,7 @@ viewGroupsList gs = map groupSS $ sortOn ldn_ gs
         memberCount = sShow currentMembers <> " member" <> if currentMembers == 1 then "" else "s"
 
 groupInvitation' :: GroupInfo -> StyledString
-groupInvitation' GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership = membership@GroupMember {memberProfile}} =
+groupInvitation' g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} =
   highlight ("#" <> ldn)
     <> optFullName ldn fullName
     <> " - you are invited ("
@@ -883,10 +884,9 @@ groupInvitation' GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile
     <> highlight ("/d #" <> ldn)
     <> " to delete invitation)"
   where
-    joinText =
-      if memberIncognito membership
-        then " to join as " <> incognitoProfile' (fromLocalProfile memberProfile) <> ", "
-        else " to join, "
+    joinText = case incognitoMembershipProfile g of
+      Just mp -> " to join as " <> incognitoProfile' (fromLocalProfile mp) <> ", "
+      Nothing -> " to join, "
 
 viewContactsMerged :: Contact -> Contact -> [StyledString]
 viewContactsMerged _into@Contact {localDisplayName = c1} _merged@Contact {localDisplayName = c2} =
@@ -1586,8 +1586,8 @@ viewChatError logLevel = \case
     CEFileCancelled f -> ["file cancelled: " <> plain f]
     CEFileCancel fileId e -> ["error cancelling file " <> sShow fileId <> ": " <> sShow e]
     CEFileAlreadyExists f -> ["file already exists: " <> plain f]
-    CEFileRead f e -> ["cannot read file " <> plain f, sShow e]
-    CEFileWrite f e -> ["cannot write file " <> plain f, sShow e]
+    CEFileRead f e -> ["cannot read file " <> plain f <> ": " <> plain e]
+    CEFileWrite f e -> ["cannot write file " <> plain f <> ": " <> plain e]
     CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
     CEFileRcvChunk e -> ["error receiving file: " <> plain e]
     CEFileInternal e -> ["file error: " <> plain e]