mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-11 13:15:05 +00:00
Merge branch 'master' into master-android
This commit is contained in:
@@ -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}
|
||||
|
||||
@@ -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);
|
||||
|]
|
||||
@@ -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);
|
||||
|
||||
@@ -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 #-}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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 #-}
|
||||
|
||||
+16
-16
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user