mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-14 08:15:24 +00:00
Merge branch 'master' into master-android
This commit is contained in:
spaced4ndy
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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|
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user