Merge branch 'master' into master-android

This commit is contained in:
spaced4ndy
2023-09-20 16:47:24 +04:00
57 changed files with 8276 additions and 3256 deletions
+1
View File
@@ -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);
|]
+44 -32
View File
@@ -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);
+2 -13
View File
@@ -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 #-}
+29
View File
@@ -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
+12 -6
View File
@@ -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
+182 -99
View File
@@ -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|
+3 -1
View File
@@ -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
+35 -6
View File
@@ -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)
+27 -1
View File
@@ -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
View File
@@ -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]