Merge branch 'stable'

This commit is contained in:
spaced4ndy 2024-02-22 12:11:23 +04:00
commit b0b249a56a
28 changed files with 325 additions and 1239 deletions

View file

@ -252,12 +252,6 @@ func apiSetFilesFolder(filesFolder: String) throws {
throw r throw r
} }
func setXFTPConfig(_ cfg: XFTPFileConfig?) throws {
let r = chatSendCmdSync(.apiSetXFTPConfig(config: cfg))
if case .cmdOk = r { return }
throw r
}
func apiSetEncryptLocalFiles(_ enable: Bool) throws { func apiSetEncryptLocalFiles(_ enable: Bool) throws {
let r = chatSendCmdSync(.apiSetEncryptLocalFiles(enable: enable)) let r = chatSendCmdSync(.apiSetEncryptLocalFiles(enable: enable))
if case .cmdOk = r { return } if case .cmdOk = r { return }
@ -1249,7 +1243,6 @@ func initializeChat(start: Bool, confirmStart: Bool = false, dbKey: String? = ni
} }
try apiSetTempFolder(tempFolder: getTempFilesDirectory().path) try apiSetTempFolder(tempFolder: getTempFilesDirectory().path)
try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path) try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
try setXFTPConfig(getXFTPCfg())
try apiSetEncryptLocalFiles(privacyEncryptLocalFilesGroupDefault.get()) try apiSetEncryptLocalFiles(privacyEncryptLocalFilesGroupDefault.get())
m.chatInitialized = true m.chatInitialized = true
m.currentUser = try apiGetActiveUser() m.currentUser = try apiGetActiveUser()

View file

@ -42,25 +42,6 @@ struct DeveloperView: View {
} footer: { } footer: {
(developerTools ? Text("Show:") : Text("Hide:")) + Text(" ") + Text("Database IDs and Transport isolation option.") (developerTools ? Text("Show:") : Text("Hide:")) + Text(" ") + Text("Database IDs and Transport isolation option.")
} }
// Section {
// settingsRow("arrow.up.doc") {
// Toggle("Send videos and files via XFTP", isOn: $xftpSendEnabled)
// .onChange(of: xftpSendEnabled) { _ in
// do {
// try setXFTPConfig(getXFTPCfg())
// } catch {
// logger.error("setXFTPConfig: cannot set XFTP config \(responseError(error))")
// }
// }
// }
// } header: {
// Text("Experimental")
// } footer: {
// if xftpSendEnabled {
// Text("v4.6.1+ is required to receive via XFTP.")
// }
// }
} }
} }
} }

View file

@ -453,7 +453,6 @@ var receiverStarted = false
let startLock = DispatchSemaphore(value: 1) let startLock = DispatchSemaphore(value: 1)
let suspendLock = DispatchSemaphore(value: 1) let suspendLock = DispatchSemaphore(value: 1)
var networkConfig: NetCfg = getNetCfg() var networkConfig: NetCfg = getNetCfg()
let xftpConfig: XFTPFileConfig? = getXFTPCfg()
// startChat uses semaphore startLock to ensure that only one didReceive thread can start chat controller // startChat uses semaphore startLock to ensure that only one didReceive thread can start chat controller
// Subsequent calls to didReceive will be waiting on semaphore and won't start chat again, as it will be .active // Subsequent calls to didReceive will be waiting on semaphore and won't start chat again, as it will be .active
@ -499,7 +498,6 @@ func doStartChat() -> DBMigrationResult? {
try setNetworkConfig(networkConfig) try setNetworkConfig(networkConfig)
try apiSetTempFolder(tempFolder: getTempFilesDirectory().path) try apiSetTempFolder(tempFolder: getTempFilesDirectory().path)
try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path) try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
try setXFTPConfig(xftpConfig)
try apiSetEncryptLocalFiles(privacyEncryptLocalFilesGroupDefault.get()) try apiSetEncryptLocalFiles(privacyEncryptLocalFilesGroupDefault.get())
// prevent suspension while starting chat // prevent suspension while starting chat
suspendLock.wait() suspendLock.wait()
@ -733,12 +731,6 @@ func apiSetFilesFolder(filesFolder: String) throws {
throw r throw r
} }
func setXFTPConfig(_ cfg: XFTPFileConfig?) throws {
let r = sendSimpleXCmd(.apiSetXFTPConfig(config: cfg))
if case .cmdOk = r { return }
throw r
}
func apiSetEncryptLocalFiles(_ enable: Bool) throws { func apiSetEncryptLocalFiles(_ enable: Bool) throws {
let r = sendSimpleXCmd(.apiSetEncryptLocalFiles(enable: enable)) let r = sendSimpleXCmd(.apiSetEncryptLocalFiles(enable: enable))
if case .cmdOk = r { return } if case .cmdOk = r { return }

View file

@ -31,7 +31,6 @@ public enum ChatCommand {
case apiSuspendChat(timeoutMicroseconds: Int) case apiSuspendChat(timeoutMicroseconds: Int)
case setTempFolder(tempFolder: String) case setTempFolder(tempFolder: String)
case setFilesFolder(filesFolder: String) case setFilesFolder(filesFolder: String)
case apiSetXFTPConfig(config: XFTPFileConfig?)
case apiSetEncryptLocalFiles(enable: Bool) case apiSetEncryptLocalFiles(enable: Bool)
case apiExportArchive(config: ArchiveConfig) case apiExportArchive(config: ArchiveConfig)
case apiImportArchive(config: ArchiveConfig) case apiImportArchive(config: ArchiveConfig)
@ -162,11 +161,6 @@ public enum ChatCommand {
case let .apiSuspendChat(timeoutMicroseconds): return "/_app suspend \(timeoutMicroseconds)" case let .apiSuspendChat(timeoutMicroseconds): return "/_app suspend \(timeoutMicroseconds)"
case let .setTempFolder(tempFolder): return "/_temp_folder \(tempFolder)" case let .setTempFolder(tempFolder): return "/_temp_folder \(tempFolder)"
case let .setFilesFolder(filesFolder): return "/_files_folder \(filesFolder)" case let .setFilesFolder(filesFolder): return "/_files_folder \(filesFolder)"
case let .apiSetXFTPConfig(cfg): if let cfg = cfg {
return "/_xftp on \(encodeJSON(cfg))"
} else {
return "/_xftp off"
}
case let .apiSetEncryptLocalFiles(enable): return "/_files_encrypt \(onOff(enable))" case let .apiSetEncryptLocalFiles(enable): return "/_files_encrypt \(onOff(enable))"
case let .apiExportArchive(cfg): return "/_db export \(encodeJSON(cfg))" case let .apiExportArchive(cfg): return "/_db export \(encodeJSON(cfg))"
case let .apiImportArchive(cfg): return "/_db import \(encodeJSON(cfg))" case let .apiImportArchive(cfg): return "/_db import \(encodeJSON(cfg))"
@ -311,7 +305,6 @@ public enum ChatCommand {
case .apiSuspendChat: return "apiSuspendChat" case .apiSuspendChat: return "apiSuspendChat"
case .setTempFolder: return "setTempFolder" case .setTempFolder: return "setTempFolder"
case .setFilesFolder: return "setFilesFolder" case .setFilesFolder: return "setFilesFolder"
case .apiSetXFTPConfig: return "apiSetXFTPConfig"
case .apiSetEncryptLocalFiles: return "apiSetEncryptLocalFiles" case .apiSetEncryptLocalFiles: return "apiSetEncryptLocalFiles"
case .apiExportArchive: return "apiExportArchive" case .apiExportArchive: return "apiExportArchive"
case .apiImportArchive: return "apiImportArchive" case .apiImportArchive: return "apiImportArchive"
@ -1005,10 +998,6 @@ struct ComposedMessage: Encodable {
var msgContent: MsgContent var msgContent: MsgContent
} }
public struct XFTPFileConfig: Encodable {
var minFileSize: Int64
}
public struct ArchiveConfig: Encodable { public struct ArchiveConfig: Encodable {
var archivePath: String var archivePath: String
var disableCompression: Bool? var disableCompression: Bool?

View file

@ -265,10 +265,6 @@ public class Default<T> {
} }
} }
public func getXFTPCfg() -> XFTPFileConfig {
return XFTPFileConfig(minFileSize: 0)
}
public func getNetCfg() -> NetCfg { public func getNetCfg() -> NetCfg {
let onionHosts = networkUseOnionHostsGroupDefault.get() let onionHosts = networkUseOnionHostsGroupDefault.get()
let (hostMode, requiredHostMode) = onionHosts.hostMode let (hostMode, requiredHostMode) = onionHosts.hostMode

View file

@ -631,12 +631,6 @@ object ChatController {
throw Error("failed to set remote hosts folder: ${r.responseType} ${r.details}") throw Error("failed to set remote hosts folder: ${r.responseType} ${r.details}")
} }
suspend fun apiSetXFTPConfig(cfg: XFTPFileConfig?) {
val r = sendCmd(null, CC.ApiSetXFTPConfig(cfg))
if (r is CR.CmdOk) return
throw Error("apiSetXFTPConfig bad response: ${r.responseType} ${r.details}")
}
suspend fun apiSetEncryptLocalFiles(enable: Boolean) = sendCommandOkResp(null, CC.ApiSetEncryptLocalFiles(enable)) suspend fun apiSetEncryptLocalFiles(enable: Boolean) = sendCommandOkResp(null, CC.ApiSetEncryptLocalFiles(enable))
suspend fun apiExportArchive(config: ArchiveConfig) { suspend fun apiExportArchive(config: ArchiveConfig) {
@ -2171,10 +2165,6 @@ object ChatController {
} }
} }
fun getXFTPCfg(): XFTPFileConfig {
return XFTPFileConfig(minFileSize = 0)
}
fun getNetCfg(): NetCfg { fun getNetCfg(): NetCfg {
val useSocksProxy = appPrefs.networkUseSocksProxy.get() val useSocksProxy = appPrefs.networkUseSocksProxy.get()
val proxyHostPort = appPrefs.networkProxyHostPort.get() val proxyHostPort = appPrefs.networkProxyHostPort.get()
@ -2283,7 +2273,6 @@ sealed class CC {
class SetTempFolder(val tempFolder: String): CC() class SetTempFolder(val tempFolder: String): CC()
class SetFilesFolder(val filesFolder: String): CC() class SetFilesFolder(val filesFolder: String): CC()
class SetRemoteHostsFolder(val remoteHostsFolder: String): CC() class SetRemoteHostsFolder(val remoteHostsFolder: String): CC()
class ApiSetXFTPConfig(val config: XFTPFileConfig?): CC()
class ApiSetEncryptLocalFiles(val enable: Boolean): CC() class ApiSetEncryptLocalFiles(val enable: Boolean): CC()
class ApiExportArchive(val config: ArchiveConfig): CC() class ApiExportArchive(val config: ArchiveConfig): CC()
class ApiImportArchive(val config: ArchiveConfig): CC() class ApiImportArchive(val config: ArchiveConfig): CC()
@ -2413,7 +2402,6 @@ sealed class CC {
is SetTempFolder -> "/_temp_folder $tempFolder" is SetTempFolder -> "/_temp_folder $tempFolder"
is SetFilesFolder -> "/_files_folder $filesFolder" is SetFilesFolder -> "/_files_folder $filesFolder"
is SetRemoteHostsFolder -> "/remote_hosts_folder $remoteHostsFolder" is SetRemoteHostsFolder -> "/remote_hosts_folder $remoteHostsFolder"
is ApiSetXFTPConfig -> if (config != null) "/_xftp on ${json.encodeToString(config)}" else "/_xftp off"
is ApiSetEncryptLocalFiles -> "/_files_encrypt ${onOff(enable)}" is ApiSetEncryptLocalFiles -> "/_files_encrypt ${onOff(enable)}"
is ApiExportArchive -> "/_db export ${json.encodeToString(config)}" is ApiExportArchive -> "/_db export ${json.encodeToString(config)}"
is ApiImportArchive -> "/_db import ${json.encodeToString(config)}" is ApiImportArchive -> "/_db import ${json.encodeToString(config)}"
@ -2548,7 +2536,6 @@ sealed class CC {
is SetTempFolder -> "setTempFolder" is SetTempFolder -> "setTempFolder"
is SetFilesFolder -> "setFilesFolder" is SetFilesFolder -> "setFilesFolder"
is SetRemoteHostsFolder -> "setRemoteHostsFolder" is SetRemoteHostsFolder -> "setRemoteHostsFolder"
is ApiSetXFTPConfig -> "apiSetXFTPConfig"
is ApiSetEncryptLocalFiles -> "apiSetEncryptLocalFiles" is ApiSetEncryptLocalFiles -> "apiSetEncryptLocalFiles"
is ApiExportArchive -> "apiExportArchive" is ApiExportArchive -> "apiExportArchive"
is ApiImportArchive -> "apiImportArchive" is ApiImportArchive -> "apiImportArchive"
@ -2714,9 +2701,6 @@ sealed class ChatPagination {
@Serializable @Serializable
class ComposedMessage(val fileSource: CryptoFile?, val quotedItemId: Long?, val msgContent: MsgContent) class ComposedMessage(val fileSource: CryptoFile?, val quotedItemId: Long?, val msgContent: MsgContent)
@Serializable
class XFTPFileConfig(val minFileSize: Long)
@Serializable @Serializable
class ArchiveConfig(val archivePath: String, val disableCompression: Boolean? = null, val parentTempDirectory: String? = null) class ArchiveConfig(val archivePath: String, val disableCompression: Boolean? = null, val parentTempDirectory: String? = null)

View file

@ -91,7 +91,6 @@ suspend fun initChatController(useKey: String? = null, confirmMigrations: Migrat
if (appPlatform.isDesktop) { if (appPlatform.isDesktop) {
controller.apiSetRemoteHostsFolder(remoteHostsDir.absolutePath) controller.apiSetRemoteHostsFolder(remoteHostsDir.absolutePath)
} }
controller.apiSetXFTPConfig(controller.getXFTPCfg())
controller.apiSetEncryptLocalFiles(controller.appPrefs.privacyEncryptLocalFiles.get()) controller.apiSetEncryptLocalFiles(controller.appPrefs.privacyEncryptLocalFiles.get())
// If we migrated successfully means previous re-encryption process on database level finished successfully too // If we migrated successfully means previous re-encryption process on database level finished successfully too
if (appPreferences.encryptionStartedAt.get() != null) appPreferences.encryptionStartedAt.set(null) if (appPreferences.encryptionStartedAt.get() != null) appPreferences.encryptionStartedAt.set(null)

View file

@ -25,11 +25,11 @@ android.nonTransitiveRClass=true
android.enableJetifier=true android.enableJetifier=true
kotlin.mpp.androidSourceSetLayoutVersion=2 kotlin.mpp.androidSourceSetLayoutVersion=2
android.version_name=5.5.4 android.version_name=5.5.5
android.version_code=183 android.version_code=185
desktop.version_name=5.5.4 desktop.version_name=5.5.5
desktop.version_code=30 desktop.version_code=31
kotlin.version=1.8.20 kotlin.version=1.8.20
gradle.plugin.version=7.4.2 gradle.plugin.version=7.4.2

View file

@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package source-repository-package
type: git type: git
location: https://github.com/simplex-chat/simplexmq.git location: https://github.com/simplex-chat/simplexmq.git
tag: caeeb2df9ccca29a6bb504886736502d081fba0e tag: 0d843ea4ce1b26a25b55756bf86d1007629896c5
source-repository-package source-repository-package
type: git type: git

View file

@ -1,5 +1,5 @@
name: simplex-chat name: simplex-chat
version: 5.5.3.0 version: 5.5.5.0
#synopsis: #synopsis:
#description: #description:
homepage: https://github.com/simplex-chat/simplex-chat#readme homepage: https://github.com/simplex-chat/simplex-chat#readme

View file

@ -12,7 +12,6 @@ export type ChatCommand =
| APIStopChat | APIStopChat
| SetTempFolder | SetTempFolder
| SetFilesFolder | SetFilesFolder
| APISetXFTPConfig
| SetIncognito | SetIncognito
| APIExportArchive | APIExportArchive
| APIImportArchive | APIImportArchive
@ -112,7 +111,6 @@ type ChatCommandTag =
| "apiStopChat" | "apiStopChat"
| "setTempFolder" | "setTempFolder"
| "setFilesFolder" | "setFilesFolder"
| "apiSetXFTPConfig"
| "setIncognito" | "setIncognito"
| "apiExportArchive" | "apiExportArchive"
| "apiImportArchive" | "apiImportArchive"
@ -242,15 +240,6 @@ export interface SetFilesFolder extends IChatCommand {
filePath: string filePath: string
} }
export interface APISetXFTPConfig extends IChatCommand {
type: "apiSetXFTPConfig"
config?: XFTPFileConfig
}
export interface XFTPFileConfig {
minFileSize: number
}
export interface SetIncognito extends IChatCommand { export interface SetIncognito extends IChatCommand {
type: "setIncognito" type: "setIncognito"
incognito: boolean incognito: boolean
@ -707,8 +696,6 @@ export function cmdString(cmd: ChatCommand): string {
return `/_temp_folder ${cmd.tempFolder}` return `/_temp_folder ${cmd.tempFolder}`
case "setFilesFolder": case "setFilesFolder":
return `/_files_folder ${cmd.filePath}` return `/_files_folder ${cmd.filePath}`
case "apiSetXFTPConfig":
return `/_xftp ${onOff(cmd.config)}${maybeJSON(cmd.config)}`
case "setIncognito": case "setIncognito":
return `/incognito ${onOff(cmd.incognito)}` return `/incognito ${onOff(cmd.incognito)}`
case "apiExportArchive": case "apiExportArchive":

View file

@ -1,5 +1,5 @@
{ {
"https://github.com/simplex-chat/simplexmq.git"."caeeb2df9ccca29a6bb504886736502d081fba0e" = "187avx8h014fhik76qv1l0nifv6db6nrg9kjk2azqia21n4s2m38"; "https://github.com/simplex-chat/simplexmq.git"."0d843ea4ce1b26a25b55756bf86d1007629896c5" = "0p3mw5kpqhxsjhairx7qaacv33hm11wmbax6jzv2w49nwkcpnbal";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

View file

@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
name: simplex-chat name: simplex-chat
version: 5.5.3.0 version: 5.5.5.0
category: Web, System, Services, Cryptography category: Web, System, Services, Cryptography
homepage: https://github.com/simplex-chat/simplex-chat#readme homepage: https://github.com/simplex-chat/simplex-chat#readme
author: simplex.chat author: simplex.chat

View file

@ -82,7 +82,7 @@ import Simplex.Chat.Types.Util
import Simplex.Chat.Util (encryptFile, shuffle) import Simplex.Chat.Util (encryptFile, shuffle)
import Simplex.FileTransfer.Client.Main (maxFileSize) import Simplex.FileTransfer.Client.Main (maxFileSize)
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescription, gb, kb, mb) import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescription)
import qualified Simplex.FileTransfer.Description as FD import qualified Simplex.FileTransfer.Description as FD
import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI) import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
import Simplex.Messaging.Agent as Agent import Simplex.Messaging.Agent as Agent
@ -145,8 +145,6 @@ defaultChatConfig =
xftpDescrPartSize = 14000, xftpDescrPartSize = 14000,
inlineFiles = defaultInlineFilesConfig, inlineFiles = defaultInlineFilesConfig,
autoAcceptFileSize = 0, autoAcceptFileSize = 0,
xftpFileConfig = Just defaultXFTPFileConfig,
tempDir = Nothing,
showReactions = False, showReactions = False,
showReceipts = False, showReceipts = False,
logLevel = CLLImportant, logLevel = CLLImportant,
@ -207,7 +205,7 @@ newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Boo
newChatController newChatController
ChatDatabase {chatStore, agentStore} ChatDatabase {chatStore, agentStore}
user user
cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir, deviceNameForRemote} cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, deviceNameForRemote}
ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize}
backgroundMode = do backgroundMode = do
let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
@ -242,8 +240,7 @@ newChatController
chatActivated <- newTVarIO True chatActivated <- newTVarIO True
showLiveItems <- newTVarIO False showLiveItems <- newTVarIO False
encryptLocalFiles <- newTVarIO False encryptLocalFiles <- newTVarIO False
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg tempDirectory <- newTVarIO Nothing
tempDirectory <- newTVarIO tempDir
contactMergeEnabled <- newTVarIO True contactMergeEnabled <- newTVarIO True
pure pure
ChatController ChatController
@ -278,7 +275,6 @@ newChatController
chatActivated, chatActivated,
showLiveItems, showLiveItems,
encryptLocalFiles, encryptLocalFiles,
userXFTPFileConfig,
tempDirectory, tempDirectory,
logFilePath = logFile, logFilePath = logFile,
contactMergeEnabled contactMergeEnabled
@ -588,9 +584,6 @@ processChatCommand' vr = \case
createDirectoryIfMissing True rf createDirectoryIfMissing True rf
chatWriteVar remoteHostsFolder $ Just rf chatWriteVar remoteHostsFolder $ Just rf
ok_ ok_
APISetXFTPConfig cfg -> do
asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
ok_
APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_ APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_
SetContactMergeEnabled onOff -> do SetContactMergeEnabled onOff -> do
asks contactMergeEnabled >>= atomically . (`writeTVar` onOff) asks contactMergeEnabled >>= atomically . (`writeTVar` onOff)
@ -652,7 +645,7 @@ processChatCommand' vr = \case
memStatuses -> pure $ Just $ map (uncurry MemberDeliveryStatus) memStatuses memStatuses -> pure $ Just $ map (uncurry MemberDeliveryStatus) memStatuses
_ -> pure Nothing _ -> pure Nothing
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses} pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses}
APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user -> withChatLock "sendMessage" $ case cType of
CTDirect -> do CTDirect -> do
ct@Contact {contactId, contactUsed} <- withStore $ \db -> getContact db user chatId ct@Contact {contactId, contactUsed} <- withStore $ \db -> getContact db user chatId
assertDirectAllowed user MDSnd ct XMsgNew_ assertDirectAllowed user MDSnd ct XMsgNew_
@ -660,45 +653,19 @@ processChatCommand' vr = \case
if isVoice mc && not (featureAllowed SCFVoice forUser ct) if isVoice mc && not (featureAllowed SCFVoice forUser ct)
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFVoice)) then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFVoice))
else do else do
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct (fInv_, ciFile_) <- L.unzip <$> setupSndFileTransfer ct
timed_ <- sndContactCITimed live ct itemTTL timed_ <- sndContactCITimed live ct itemTTL
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_
(msg@SndMessage {sharedMsgId}, _) <- sendDirectContactMessage ct (XMsgNew msgContainer) (msg, _) <- sendDirectContactMessage ct (XMsgNew msgContainer)
ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
case ft_ of
Just ft@FileTransferMeta {fileInline = Just IFMSent} ->
sendDirectFileInline ct ft sharedMsgId
_ -> pure ()
forM_ (timed_ >>= timedDeleteAt') $ forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci)
pure $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) pure $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
where where
setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd))
setupSndFileTransfer ct = forM file_ $ \file -> do setupSndFileTransfer ct = forM file_ $ \file -> do
(fileSize, fileMode) <- checkSndFile mc file 1 fileSize <- checkSndFile file
case fileMode of xftpSndFileTransfer user file fileSize 1 $ CGContact ct
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
SendFileXFTP -> xftpSndFileTransfer user file fileSize 1 $ CGContact ct
where
smpSndFileTransfer :: CryptoFile -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer (CryptoFile _ (Just _)) _ _ = throwChatError $ CEFileInternal "locally encrypted files can't be sent via SMP" -- can only happen if XFTP is disabled
smpSndFileTransfer (CryptoFile file Nothing) fileSize fileInline = do
subMode <- chatReadVar subscriptionMode
(agentConnId_, fileConnReq) <-
if isJust fileInline
then pure (Nothing, Nothing)
else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode)
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
chSize <- asks $ fileChunkSize . config
withStore $ \db -> do
ft@FileTransferMeta {fileId} <- liftIO $ createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize subMode
fileStatus <- case fileInline of
Just IFMSent -> createSndDirectInlineFT db ct ft $> CIFSSndTransfer 0 1
_ -> pure CIFSSndStored
let fileSource = Just $ CF.plain file
ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol = FPSMP}
pure (fileInvitation, ciFile, ft)
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect)) prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
prepareMsg fInv_ timed_ = case quotedItemId_ of prepareMsg fInv_ timed_ = case quotedItemId_ of
Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing) Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
@ -725,53 +692,27 @@ processChatCommand' vr = \case
| isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice | isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
| not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles | not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
| otherwise = do | otherwise = do
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms) (fInv_, ciFile_) <- L.unzip <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo itemTTL timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ timed_ live (msgContainer, quotedItem_) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ timed_ live
(msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer) (msg, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
withStore' $ \db -> withStore' $ \db ->
forM_ sentToMembers $ \GroupMember {groupMemberId} -> forM_ sentToMembers $ \GroupMember {groupMemberId} ->
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
forM_ (timed_ >>= timedDeleteAt') $ forM_ (timed_ >>= timedDeleteAt') $
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f)) notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f))
setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd))
setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do setupSndFileTransfer g n = forM file_ $ \file -> do
(fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n fileSize <- checkSndFile file
case fileMode of xftpSndFileTransfer user file fileSize n $ CGGroup g
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup g
where
smpSndFileTransfer :: CryptoFile -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer (CryptoFile _ (Just _)) _ _ = throwChatError $ CEFileInternal "locally encrypted files can't be sent via SMP" -- can only happen if XFTP is disabled
smpSndFileTransfer (CryptoFile file Nothing) fileSize fileInline = do
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline, fileDescr = Nothing}
fileStatus = if fileInline == Just IFMSent then CIFSSndTransfer 0 1 else CIFSSndStored
chSize <- asks $ fileChunkSize . config
withStore' $ \db -> do
ft@FileTransferMeta {fileId} <- createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
let fileSource = Just $ CF.plain file
ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol = FPSMP}
pure (fileInvitation, ciFile, ft)
sendGroupFileInline :: [GroupMember] -> SharedMsgId -> FileTransferMeta -> m ()
sendGroupFileInline ms sharedMsgId ft@FileTransferMeta {fileInline} =
when (fileInline == Just IFMSent) . forM_ ms $ \m ->
processMember m `catchChatError` (toView . CRChatError (Just user))
where
processMember m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
when (connStatus == ConnReady || connStatus == ConnSndReady) $ do
void . withStore' $ \db -> createSndGroupInlineFT db m conn ft
sendMemberFileInline m conn ft sharedMsgId
processMember _ = pure ()
CTLocal -> pure $ chatCmdError (Just user) "not supported" CTLocal -> pure $ chatCmdError (Just user) "not supported"
CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
where where
xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta) xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd)
xftpSndFileTransfer user file fileSize n contactOrGroup = do xftpSndFileTransfer user file fileSize n contactOrGroup = do
(fInv, ciFile, ft) <- xftpSndFileTransfer_ user file fileSize n $ Just contactOrGroup (fInv, ciFile, ft) <- xftpSndFileTransfer_ user file fileSize n $ Just contactOrGroup
case contactOrGroup of case contactOrGroup of
@ -785,10 +726,7 @@ processChatCommand' vr = \case
withStore' $ withStore' $
\db -> createSndFTDescrXFTP db user (Just m) conn ft dummyFileDescr \db -> createSndFTDescrXFTP db user (Just m) conn ft dummyFileDescr
saveMemberFD _ = pure () saveMemberFD _ = pure ()
pure (fInv, ciFile, ft) pure (fInv, ciFile)
unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c)
unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c)
unzipMaybe3 _ = (Nothing, Nothing, Nothing)
APICreateChatItem folderId (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user -> do APICreateChatItem folderId (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user -> do
forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported" forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported"
nf <- withStore $ \db -> getNoteFolder db user folderId nf <- withStore $ \db -> getNoteFolder db user folderId
@ -1006,7 +944,7 @@ processChatCommand' vr = \case
-- functions below are called in separate transactions to prevent crashes on android -- functions below are called in separate transactions to prevent crashes on android
-- (possibly, race condition on integrity check?) -- (possibly, race condition on integrity check?)
withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct
withStore' $ \db -> deleteContact db user ct withStore $ \db -> deleteContact db user ct
pure $ CRContactDeleted user ct pure $ CRContactDeleted user ct
CTContactConnection -> withChatLock "deleteChat contactConnection" . procCmd $ do CTContactConnection -> withChatLock "deleteChat contactConnection" . procCmd $ do
conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId
@ -1047,7 +985,7 @@ processChatCommand' vr = \case
Just _ -> pure [] Just _ -> pure []
Nothing -> do Nothing -> do
conns <- withStore' $ \db -> getContactConnections db userId ct conns <- withStore' $ \db -> getContactConnections db userId ct
withStore' (\db -> setContactDeleted db user ct) withStore (\db -> setContactDeleted db user ct)
`catchChatError` (toView . CRChatError (Just user)) `catchChatError` (toView . CRChatError (Just user))
pure $ map aConnId conns pure $ map aConnId conns
CTLocal -> pure $ chatCmdError (Just user) "not supported" CTLocal -> pure $ chatCmdError (Just user) "not supported"
@ -2209,27 +2147,13 @@ processChatCommand' vr = \case
contactMember Contact {contactId} = contactMember Contact {contactId} =
find $ \GroupMember {memberContactId = cId, memberStatus = s} -> find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft
checkSndFile :: MsgContent -> CryptoFile -> Integer -> m (Integer, SendFileMode) checkSndFile :: CryptoFile -> m Integer
checkSndFile mc (CryptoFile f cfArgs) n = do checkSndFile (CryptoFile f cfArgs) = do
fsFilePath <- toFSFilePath f fsFilePath <- toFSFilePath f
unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f
ChatConfig {fileChunkSize, inlineFiles} <- asks config
xftpCfg <- readTVarIO =<< asks userXFTPFileConfig
fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs
when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f
let chunks = -((-fileSize) `div` fileChunkSize) pure fileSize
fileInline = inlineFileMode mc inlineFiles chunks n
fileMode = case xftpCfg of
Just cfg
| isJust cfArgs -> SendFileXFTP
| fileInline == Just IFMSent || fileSize < minFileSize cfg || n <= 0 -> SendFileSMP fileInline
| otherwise -> SendFileXFTP
_ -> SendFileSMP fileInline
pure (fileSize, fileMode)
inlineFileMode mc InlineFilesConfig {offerChunks, sendChunks, totalSendChunks} chunks n
| chunks > offerChunks = Nothing
| chunks <= sendChunks && chunks * n <= totalSendChunks && isVoice mc = Just IFMSent
| otherwise = Just IFMOffer
updateProfile :: User -> Profile -> m ChatResponse updateProfile :: User -> Profile -> m ChatResponse
updateProfile user p' = updateProfile_ user p' $ withStore $ \db -> updateUserProfile db user p' updateProfile user p' = updateProfile_ user p' $ withStore $ \db -> updateUserProfile db user p'
updateProfile_ :: User -> Profile -> m User -> m ChatResponse updateProfile_ :: User -> Profile -> m User -> m ChatResponse
@ -3152,7 +3076,7 @@ cleanupManager = do
cleanupDeletedContacts user = do cleanupDeletedContacts user = do
contacts <- withStore' (`getDeletedContacts` user) contacts <- withStore' (`getDeletedContacts` user)
forM_ contacts $ \ct -> forM_ contacts $ \ct ->
withStore' (\db -> deleteContactWithoutGroups db user ct) withStore (\db -> deleteContactWithoutGroups db user ct)
`catchChatError` (toView . CRChatError (Just user)) `catchChatError` (toView . CRChatError (Just user))
cleanupMessages = do cleanupMessages = do
ts <- liftIO getCurrentTime ts <- liftIO getCurrentTime
@ -4944,7 +4868,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
else do else do
contactConns <- withStore' $ \db -> getContactConnections db userId c contactConns <- withStore' $ \db -> getContactConnections db userId c
deleteAgentConnectionsAsync user $ map aConnId contactConns deleteAgentConnectionsAsync user $ map aConnId contactConns
withStore' $ \db -> deleteContact db user c withStore $ \db -> deleteContact db user c
where where
brokerTs = metaBrokerTs msgMeta brokerTs = metaBrokerTs msgMeta
@ -6534,8 +6458,6 @@ chatCommandP =
"/_temp_folder " *> (SetTempFolder <$> filePath), "/_temp_folder " *> (SetTempFolder <$> filePath),
("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath), ("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath),
"/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath), "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath),
"/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
"/xftp " *> (APISetXFTPConfig <$> ("on" *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
"/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP), "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP),
"/contact_merge " *> (SetContactMergeEnabled <$> onOffP), "/contact_merge " *> (SetContactMergeEnabled <$> onOffP),
"/_db export " *> (APIExportArchive <$> jsonP), "/_db export " *> (APIExportArchive <$> jsonP),
@ -6911,14 +6833,6 @@ chatCommandP =
logErrors <- " log=" *> onOffP <|> pure False logErrors <- " log=" *> onOffP <|> pure False
let tcpTimeout = 1000000 * fromMaybe (maybe 5 (const 10) socksProxy) t_ let tcpTimeout = 1000000 * fromMaybe (maybe 5 (const 10) socksProxy) t_
pure $ fullNetworkConfig socksProxy tcpTimeout logErrors pure $ fullNetworkConfig socksProxy tcpTimeout logErrors
xftpCfgP = XFTPFileConfig <$> (" size=" *> fileSizeP <|> pure 0)
fileSizeP =
A.choice
[ gb <$> A.decimal <* "gb",
mb <$> A.decimal <* "mb",
kb <$> A.decimal <* "kb",
A.decimal
]
dbKeyP = nonEmptyKey <$?> strP dbKeyP = nonEmptyKey <$?> strP
nonEmptyKey k@(DBEncryptionKey s) = if BA.null s then Left "empty key" else Right k nonEmptyKey k@(DBEncryptionKey s) = if BA.null s then Left "empty key" else Right k
dbEncryptionConfig currentKey newKey = DBEncryptionConfig {currentKey, newKey, keepKey = Just False} dbEncryptionConfig currentKey newKey = DBEncryptionConfig {currentKey, newKey, keepKey = Just False}

View file

@ -129,8 +129,6 @@ data ChatConfig = ChatConfig
xftpDescrPartSize :: Int, xftpDescrPartSize :: Int,
inlineFiles :: InlineFilesConfig, inlineFiles :: InlineFilesConfig,
autoAcceptFileSize :: Integer, autoAcceptFileSize :: Integer,
xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled
tempDir :: Maybe FilePath,
showReactions :: Bool, showReactions :: Bool,
showReceipts :: Bool, showReceipts :: Bool,
subscriptionEvents :: Bool, subscriptionEvents :: Bool,
@ -205,7 +203,6 @@ data ChatController = ChatController
timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))), timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))),
showLiveItems :: TVar Bool, showLiveItems :: TVar Bool,
encryptLocalFiles :: TVar Bool, encryptLocalFiles :: TVar Bool,
userXFTPFileConfig :: TVar (Maybe XFTPFileConfig),
tempDirectory :: TVar (Maybe FilePath), tempDirectory :: TVar (Maybe FilePath),
logFilePath :: Maybe FilePath, logFilePath :: Maybe FilePath,
contactMergeEnabled :: TVar Bool contactMergeEnabled :: TVar Bool
@ -243,7 +240,6 @@ data ChatCommand
| SetTempFolder FilePath | SetTempFolder FilePath
| SetFilesFolder FilePath | SetFilesFolder FilePath
| SetRemoteHostsFolder FilePath | SetRemoteHostsFolder FilePath
| APISetXFTPConfig (Maybe XFTPFileConfig)
| APISetEncryptLocalFiles Bool | APISetEncryptLocalFiles Bool
| SetContactMergeEnabled Bool | SetContactMergeEnabled Bool
| APIExportArchive ArchiveConfig | APIExportArchive ArchiveConfig
@ -477,7 +473,6 @@ allowRemoteCommand = \case
SetTempFolder _ -> False SetTempFolder _ -> False
SetFilesFolder _ -> False SetFilesFolder _ -> False
SetRemoteHostsFolder _ -> False SetRemoteHostsFolder _ -> False
APISetXFTPConfig _ -> False
APISetEncryptLocalFiles _ -> False APISetEncryptLocalFiles _ -> False
APIExportArchive _ -> False APIExportArchive _ -> False
APIImportArchive _ -> False APIImportArchive _ -> False
@ -943,14 +938,6 @@ instance FromJSON ComposedMessage where
parseJSON invalid = parseJSON invalid =
JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid) JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid)
data XFTPFileConfig = XFTPFileConfig
{ minFileSize :: Integer
}
deriving (Show)
defaultXFTPFileConfig :: XFTPFileConfig
defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0}
data NtfMsgInfo = NtfMsgInfo {msgId :: Text, msgTs :: UTCTime} data NtfMsgInfo = NtfMsgInfo {msgId :: Text, msgTs :: UTCTime}
deriving (Show) deriving (Show)
@ -1010,11 +997,6 @@ data CoreVersionInfo = CoreVersionInfo
} }
deriving (Show) deriving (Show)
data SendFileMode
= SendFileSMP (Maybe InlineFileMode)
| SendFileXFTP
deriving (Show)
data SlowSQLQuery = SlowSQLQuery data SlowSQLQuery = SlowSQLQuery
{ query :: Text, { query :: Text,
queryStats :: SlowQueryStats queryStats :: SlowQueryStats
@ -1418,6 +1400,4 @@ $(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
$(JQ.deriveFromJSON defaultJSON ''DBEncryptionConfig) $(JQ.deriveFromJSON defaultJSON ''DBEncryptionConfig)
$(JQ.deriveJSON defaultJSON ''XFTPFileConfig)
$(JQ.deriveToJSON defaultJSON ''ComposedMessage) $(JQ.deriveToJSON defaultJSON ''ComposedMessage)

View file

@ -229,37 +229,45 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do
(userId, contactId) (userId, contactId)
DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId) DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId)
deleteContact :: DB.Connection -> User -> Contact -> IO () deleteContact :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContact db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do deleteContact db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId) assertNotUser db user ct
ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId) liftIO $ do
if isNothing ctMember DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
then do ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
deleteContactProfile_ db userId contactId if isNothing ctMember
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) then do
else do deleteContactProfile_ db userId contactId
currentTs <- getCurrentTime -- user's local display name already checked in assertNotUser
DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId) DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId) else do
forM_ activeConn $ \Connection {customUserProfileId} -> currentTs <- getCurrentTime
forM_ customUserProfileId $ \profileId -> DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
deleteUnusedIncognitoProfileById_ db user profileId DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
forM_ activeConn $ \Connection {customUserProfileId} ->
forM_ customUserProfileId $ \profileId ->
deleteUnusedIncognitoProfileById_ db user profileId
-- should only be used if contact is not member of any groups -- should only be used if contact is not member of any groups
deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> IO () deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId) assertNotUser db user ct
deleteContactProfile_ db userId contactId liftIO $ do
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId) deleteContactProfile_ db userId contactId
forM_ activeConn $ \Connection {customUserProfileId} -> -- user's local display name already checked in assertNotUser
forM_ customUserProfileId $ \profileId -> DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
deleteUnusedIncognitoProfileById_ db user profileId DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
forM_ activeConn $ \Connection {customUserProfileId} ->
forM_ customUserProfileId $ \profileId ->
deleteUnusedIncognitoProfileById_ db user profileId
setContactDeleted :: DB.Connection -> User -> Contact -> IO () setContactDeleted :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
setContactDeleted db User {userId} Contact {contactId} = do setContactDeleted db user@User {userId} ct@Contact {contactId} = do
currentTs <- getCurrentTime assertNotUser db user ct
DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId) liftIO $ do
currentTs <- getCurrentTime
DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
getDeletedContacts :: DB.Connection -> User -> IO [Contact] getDeletedContacts :: DB.Connection -> User -> IO [Contact]
getDeletedContacts db user@User {userId} = do getDeletedContacts db user@User {userId} = do
@ -320,7 +328,7 @@ updateContactProfile db user@User {userId} c p'
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs updateContactProfile_' db userId profileId p' currentTs
updateContactLDN_ db userId contactId localDisplayName ldn currentTs updateContactLDN_ db user contactId localDisplayName ldn currentTs
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences} pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
where where
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
@ -491,8 +499,8 @@ updateMemberContactProfile_' db userId profileId Profile {displayName, fullName,
|] |]
(displayName, fullName, image, updatedAt, userId, profileId) (displayName, fullName, image, updatedAt, userId, profileId)
updateContactLDN_ :: DB.Connection -> UserId -> Int64 -> ContactName -> ContactName -> UTCTime -> IO () updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
updateContactLDN_ db userId contactId displayName newName updatedAt = do updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do
DB.execute DB.execute
db db
"UPDATE contacts SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" "UPDATE contacts SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
@ -501,7 +509,7 @@ updateContactLDN_ db userId contactId displayName newName updatedAt = do
db db
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" "UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
(newName, updatedAt, userId, contactId) (newName, updatedAt, userId, contactId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId) safeDeleteLDN db user displayName
getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact
getContactByName db user localDisplayName = do getContactByName db user localDisplayName = do
@ -614,7 +622,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
WHERE user_id = ? AND contact_request_id = ? WHERE user_id = ? AND contact_request_id = ?
|] |]
(invId, minV, maxV, ldn, currentTs, userId, cReqId) (invId, minV, maxV, ldn, currentTs, userId, cReqId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (oldLdn, userId) safeDeleteLDN db user oldLdn
where where
updateProfile currentTs = updateProfile currentTs =
DB.execute DB.execute
@ -684,8 +692,9 @@ deleteContactRequest db User {userId} contactRequestId = do
SELECT local_display_name FROM contact_requests SELECT local_display_name FROM contact_requests
WHERE user_id = ? AND contact_request_id = ? WHERE user_id = ? AND contact_request_id = ?
) )
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
|] |]
(userId, userId, contactRequestId) (userId, userId, contactRequestId, userId)
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> Bool -> IO Contact createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> Bool -> IO Contact

View file

@ -14,7 +14,6 @@ module Simplex.Chat.Store.Files
( getLiveSndFileTransfers, ( getLiveSndFileTransfers,
getLiveRcvFileTransfers, getLiveRcvFileTransfers,
getPendingSndChunks, getPendingSndChunks,
createSndDirectFileTransfer,
createSndDirectFTConnection, createSndDirectFTConnection,
createSndGroupFileTransfer, createSndGroupFileTransfer,
createSndGroupFileTransferConnection, createSndGroupFileTransferConnection,
@ -174,23 +173,6 @@ getPendingSndChunks db fileId connId =
|] |]
(fileId, connId) (fileId, connId)
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> SubscriptionMode -> IO FileTransferMeta
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize subMode = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
((userId, contactId, fileName, filePath, fileSize, chunkSize) :. (fileInline, CIFSSndStored, FPSMP, currentTs, currentTs))
fileId <- insertedRowId db
forM_ acId_ $ \acId -> do
Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode
let fileStatus = FSNew
DB.execute
db
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(fileId, fileStatus, fileInline, connId, currentTs, currentTs)
pure FileTransferMeta {fileId, xftpSndFile = Nothing, xftpRedirectFor = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO () createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) subMode = do createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) subMode = do
currentTs <- getCurrentTime currentTs <- getCurrentTime

View file

@ -225,8 +225,9 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do
JOIN user_contact_links uc USING (user_contact_link_id) JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = ? AND uc.group_id = ? WHERE uc.user_id = ? AND uc.group_id = ?
) )
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
|] |]
(userId, userId, groupId) (userId, userId, groupId, userId)
DB.execute DB.execute
db db
[sql| [sql|
@ -586,7 +587,7 @@ deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroup db user@User {userId} g@GroupInfo {groupId, localDisplayName} = do deleteGroup db user@User {userId} g@GroupInfo {groupId, localDisplayName} = do
deleteGroupProfile_ db userId groupId deleteGroupProfile_ db userId groupId
DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (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) safeDeleteLDN db user localDisplayName
forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO () deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
@ -1044,14 +1045,14 @@ deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, m
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user $ localProfileId memberProfile when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user $ localProfileId memberProfile
cleanupMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO () cleanupMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO ()
cleanupMemberProfileAndName_ db User {userId} GroupMember {groupMemberId, memberContactId, memberContactProfileId, localDisplayName} = cleanupMemberProfileAndName_ db user@User {userId} GroupMember {groupMemberId, memberContactId, memberContactProfileId, localDisplayName} =
-- check record has no memberContactId (contact_id) - it means contact has been deleted and doesn't use profile & ldn -- check record has no memberContactId (contact_id) - it means contact has been deleted and doesn't use profile & ldn
when (isNothing memberContactId) $ do when (isNothing memberContactId) $ do
-- check other group member records don't use profile & ldn -- check other group member records don't use profile & ldn
sameProfileMember :: (Maybe GroupMemberId) <- maybeFirstRow fromOnly $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1" (userId, memberContactProfileId, groupMemberId) sameProfileMember :: (Maybe GroupMemberId) <- maybeFirstRow fromOnly $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1" (userId, memberContactProfileId, groupMemberId)
when (isNothing sameProfileMember) $ do when (isNothing sameProfileMember) $ do
DB.execute db "DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?" (userId, memberContactProfileId) DB.execute db "DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?" (userId, memberContactProfileId)
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) safeDeleteLDN db user localDisplayName
deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO () deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMemberConnection db User {userId} GroupMember {groupMemberId} = deleteGroupMemberConnection db User {userId} GroupMember {groupMemberId} =
@ -1330,7 +1331,7 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_ maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences} updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences}
| displayName == newName = liftIO $ do | displayName == newName = liftIO $ do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateGroupProfile_ currentTs updateGroupProfile_ currentTs
@ -1361,7 +1362,7 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
db db
"UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" "UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_id = ?"
(ldn, currentTs, userId, groupId) (ldn, currentTs, userId, groupId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId) safeDeleteLDN db user localDisplayName
getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo db vr User {userId, userContactId} groupId = getGroupInfo db vr User {userId, userContactId} groupId =
@ -1464,7 +1465,7 @@ getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalPro
FROM contacts ct FROM contacts ct
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
WHERE ct.user_id = ? AND ct.contact_id != ? WHERE ct.user_id = ? AND ct.contact_id != ?
AND ct.contact_status = ? AND ct.deleted = 0 AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0
AND p.display_name = ? AND p.full_name = ? AND p.display_name = ? AND p.full_name = ?
|] |]
@ -1502,7 +1503,7 @@ getMatchingMemberContacts db user@User {userId} GroupMember {memberProfile = Loc
FROM contacts ct FROM contacts ct
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
WHERE ct.user_id = ? WHERE ct.user_id = ?
AND ct.contact_status = ? AND ct.deleted = 0 AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0
AND p.display_name = ? AND p.full_name = ? AND p.display_name = ? AND p.full_name = ?
|] |]
@ -1615,6 +1616,8 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN
let (toCt, fromCt) = toFromContacts to from let (toCt, fromCt) = toFromContacts to from
Contact {contactId = toContactId, localDisplayName = toLDN} = toCt Contact {contactId = toContactId, localDisplayName = toLDN} = toCt
Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt
assertNotUser db user toCt
assertNotUser db user fromCt
liftIO $ do liftIO $ do
currentTs <- getCurrentTime currentTs <- getCurrentTime
-- next query fixes incorrect unused contacts deletion -- next query fixes incorrect unused contacts deletion
@ -2018,7 +2021,7 @@ createMemberContactConn_
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = False, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnJoined, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = False, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnJoined, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile db User {userId} m p' updateMemberProfile db user@User {userId} m p'
| displayName == newName = do | displayName == newName = do
liftIO $ updateMemberContactProfileReset_ db userId profileId p' liftIO $ updateMemberContactProfileReset_ db userId profileId p'
pure m {memberProfile = profile} pure m {memberProfile = profile}
@ -2030,7 +2033,7 @@ updateMemberProfile db User {userId} m p'
db db
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?" "UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?"
(ldn, currentTs, userId, groupMemberId) (ldn, currentTs, userId, groupMemberId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId) safeDeleteLDN db user localDisplayName
pure $ Right m {localDisplayName = ldn, memberProfile = profile} pure $ Right m {localDisplayName = ldn, memberProfile = profile}
where where
GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
@ -2038,7 +2041,7 @@ updateMemberProfile db User {userId} m p'
profile = toLocalProfile profileId p' localAlias profile = toLocalProfile profileId p' localAlias
updateContactMemberProfile :: DB.Connection -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact) updateContactMemberProfile :: DB.Connection -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile db User {userId} m ct@Contact {contactId} p' updateContactMemberProfile db user@User {userId} m ct@Contact {contactId} p'
| displayName == newName = do | displayName == newName = do
liftIO $ updateMemberContactProfile_ db userId profileId p' liftIO $ updateMemberContactProfile_ db userId profileId p'
pure (m {memberProfile = profile}, ct {profile} :: Contact) pure (m {memberProfile = profile}, ct {profile} :: Contact)
@ -2046,7 +2049,7 @@ updateContactMemberProfile db User {userId} m ct@Contact {contactId} p'
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateMemberContactProfile_' db userId profileId p' currentTs updateMemberContactProfile_' db userId profileId p' currentTs
updateContactLDN_ db userId contactId localDisplayName ldn currentTs updateContactLDN_ db user contactId localDisplayName ldn currentTs
pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact) pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact)
where where
GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m

View file

@ -267,7 +267,7 @@ updateUserProfile db user p'
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)" "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs) (newName, newName, userId, currentTs, currentTs)
updateContactProfile_' db userId profileId p' currentTs updateContactProfile_' db userId profileId p' currentTs
updateContactLDN_ db userId userContactId localDisplayName newName currentTs updateContactLDN_ db user userContactId localDisplayName newName currentTs
pure user {localDisplayName = newName, profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'} pure user {localDisplayName = newName, profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
where where
updateUserMemberProfileUpdatedAt_ currentTs updateUserMemberProfileUpdatedAt_ currentTs
@ -388,6 +388,7 @@ deleteUserAddress db user@User {userId} = do
JOIN user_contact_links uc USING (user_contact_link_id) JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
) )
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = :user_id)
|] |]
[":user_id" := userId] [":user_id" := userId]
DB.executeNamed DB.executeNamed

View file

@ -111,6 +111,7 @@ data StoreError
| SERemoteHostDuplicateCA | SERemoteHostDuplicateCA
| SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId} | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
| SERemoteCtrlDuplicateCA | SERemoteCtrlDuplicateCA
| SEProhibitedDeleteUser {userId :: UserId, contactId :: ContactId}
deriving (Show, Exception) deriving (Show, Exception)
$(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError) $(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
@ -402,3 +403,33 @@ createWithRandomBytes' size gVar create = tryCreate 3
encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar
assertNotUser :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
assertNotUser db User {userId} Contact {contactId, localDisplayName} = do
r :: (Maybe Int64) <-
-- This query checks that the foreign keys in the users table
-- are not referencing the contact about to be deleted.
-- With the current schema it would cause cascade delete of user,
-- with mofified schema (in v5.6.0-beta.0) it would cause foreign key violation error.
liftIO . maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT 1 FROM users
WHERE (user_id = ? AND local_display_name = ?)
OR contact_id = ?
LIMIT 1
|]
(userId, localDisplayName, contactId)
when (isJust r) $ throwError $ SEProhibitedDeleteUser userId contactId
safeDeleteLDN :: DB.Connection -> User -> ContactName -> IO ()
safeDeleteLDN db User {userId} localDisplayName = do
DB.execute
db
[sql|
DELETE FROM display_names
WHERE user_id = ? AND local_display_name = ?
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
|]
(userId, localDisplayName, userId)

View file

@ -15,6 +15,7 @@ import Control.Concurrent.STM
import Control.Exception (bracket, bracket_) import Control.Exception (bracket, bracket_)
import Control.Monad import Control.Monad
import Control.Monad.Except import Control.Monad.Except
import Control.Monad.Reader
import Data.ByteArray (ScrubbedBytes) import Data.ByteArray (ScrubbedBytes)
import Data.Functor (($>)) import Data.Functor (($>))
import Data.List (dropWhileEnd, find) import Data.List (dropWhileEnd, find)
@ -22,7 +23,7 @@ import Data.Maybe (isNothing)
import qualified Data.Text as T import qualified Data.Text as T
import Network.Socket import Network.Socket
import Simplex.Chat import Simplex.Chat
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..)) import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..))
import Simplex.Chat.Core import Simplex.Chat.Core
import Simplex.Chat.Options import Simplex.Chat.Options
import Simplex.Chat.Store import Simplex.Chat.Store
@ -129,8 +130,7 @@ testCfg =
{ agentConfig = testAgentCfg, { agentConfig = testAgentCfg,
showReceipts = False, showReceipts = False,
testView = True, testView = True,
tbqSize = 16, tbqSize = 16
xftpFileConfig = Nothing
} }
testAgentCfgVPrev :: AgentConfig testAgentCfgVPrev :: AgentConfig
@ -209,6 +209,7 @@ startTestChat_ db cfg opts user = do
t <- withVirtualTerminal termSettings pure t <- withVirtualTerminal termSettings pure
ct <- newChatTerminal t opts ct <- newChatTerminal t opts
cc <- newChatController db (Just user) cfg opts False cc <- newChatController db (Just user) cfg opts False
void $ execChatCommand' (SetTempFolder "tests/tmp/tmp") `runReaderT` cc
chatAsync <- async . runSimplexChat opts user cc $ \_u cc' -> runChatTerminal ct cc' opts chatAsync <- async . runSimplexChat opts user cc $ \_u cc' -> runChatTerminal ct cc' opts
atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry
termQ <- newTQueueIO termQ <- newTQueueIO

View file

@ -1067,7 +1067,7 @@ testChatWorking alice bob = do
alice <# "bob> hello too" alice <# "bob> hello too"
testMaintenanceModeWithFiles :: HasCallStack => FilePath -> IO () testMaintenanceModeWithFiles :: HasCallStack => FilePath -> IO ()
testMaintenanceModeWithFiles tmp = do testMaintenanceModeWithFiles tmp = withXFTPServer $ do
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChatOpts tmp testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do withNewTestChatOpts tmp testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do
alice ##> "/_start" alice ##> "/_start"
@ -1075,12 +1075,26 @@ testMaintenanceModeWithFiles tmp = do
alice ##> "/_files_folder ./tests/tmp/alice_files" alice ##> "/_files_folder ./tests/tmp/alice_files"
alice <## "ok" alice <## "ok"
connectUsers alice bob connectUsers alice bob
startFileTransferWithDest' bob alice "test.jpg" "136.5 KiB / 139737 bytes" Nothing
bob <## "completed sending file 1 (test.jpg) to alice" bob #> "/f @alice ./tests/fixtures/test.jpg"
bob <## "use /fc 1 to cancel sending"
alice <# "bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob <## "completed uploading file 1 (test.jpg) for alice"
alice ##> "/fr 1"
alice
<### [ "saving file 1 from bob to test.jpg",
"started receiving file 1 (test.jpg) from bob"
]
alice <## "completed receiving file 1 (test.jpg) from bob" alice <## "completed receiving file 1 (test.jpg) from bob"
src <- B.readFile "./tests/fixtures/test.jpg" src <- B.readFile "./tests/fixtures/test.jpg"
B.readFile "./tests/tmp/alice_files/test.jpg" `shouldReturn` src dest <- B.readFile "./tests/tmp/alice_files/test.jpg"
dest `shouldBe` src
threadDelay 500000 threadDelay 500000
alice ##> "/_stop" alice ##> "/_stop"
alice <## "chat stopped" alice <## "chat stopped"
alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}" alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"

File diff suppressed because it is too large Load diff

View file

@ -11,7 +11,7 @@ import Control.Monad (void, when)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import Data.List (isInfixOf) import Data.List (isInfixOf)
import qualified Data.Text as T import qualified Data.Text as T
import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..)) import Simplex.Chat.Controller (ChatConfig (..))
import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Protocol (supportedChatVRange)
import Simplex.Chat.Store (agentStoreFile, chatStoreFile) import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
import Simplex.Chat.Types (GroupMemberRole (..)) import Simplex.Chat.Types (GroupMemberRole (..))
@ -4321,7 +4321,7 @@ testGroupMsgForwardDeletion =
testGroupMsgForwardFile :: HasCallStack => FilePath -> IO () testGroupMsgForwardFile :: HasCallStack => FilePath -> IO ()
testGroupMsgForwardFile = testGroupMsgForwardFile =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
setupGroupForwarding3 "team" alice bob cath setupGroupForwarding3 "team" alice bob cath
@ -4343,8 +4343,6 @@ testGroupMsgForwardFile =
src <- B.readFile "./tests/fixtures/test.jpg" src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg" dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src dest `shouldBe` src
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
testGroupMsgForwardChangeRole :: HasCallStack => FilePath -> IO () testGroupMsgForwardChangeRole :: HasCallStack => FilePath -> IO ()
testGroupMsgForwardChangeRole = testGroupMsgForwardChangeRole =
@ -4577,7 +4575,7 @@ testGroupHistoryPreferenceOff =
testGroupHistoryHostFile :: HasCallStack => FilePath -> IO () testGroupHistoryHostFile :: HasCallStack => FilePath -> IO ()
testGroupHistoryHostFile = testGroupHistoryHostFile =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
createGroup2 "team" alice bob createGroup2 "team" alice bob
@ -4613,12 +4611,10 @@ testGroupHistoryHostFile =
src <- B.readFile "./tests/fixtures/test.jpg" src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg" dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src dest `shouldBe` src
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
testGroupHistoryMemberFile :: HasCallStack => FilePath -> IO () testGroupHistoryMemberFile :: HasCallStack => FilePath -> IO ()
testGroupHistoryMemberFile = testGroupHistoryMemberFile =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
createGroup2 "team" alice bob createGroup2 "team" alice bob
@ -4654,8 +4650,6 @@ testGroupHistoryMemberFile =
src <- B.readFile "./tests/fixtures/test.jpg" src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg" dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src dest `shouldBe` src
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
testGroupHistoryLargeFile :: HasCallStack => FilePath -> IO () testGroupHistoryLargeFile :: HasCallStack => FilePath -> IO ()
testGroupHistoryLargeFile = testGroupHistoryLargeFile =
@ -4713,11 +4707,11 @@ testGroupHistoryLargeFile =
destCath <- B.readFile "./tests/tmp/testfile_2" destCath <- B.readFile "./tests/tmp/testfile_2"
destCath `shouldBe` src destCath `shouldBe` src
where where
cfg = testCfg {xftpDescrPartSize = 200, xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} cfg = testCfg {xftpDescrPartSize = 200}
testGroupHistoryMultipleFiles :: HasCallStack => FilePath -> IO () testGroupHistoryMultipleFiles :: HasCallStack => FilePath -> IO ()
testGroupHistoryMultipleFiles = testGroupHistoryMultipleFiles =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
@ -4794,12 +4788,10 @@ testGroupHistoryMultipleFiles =
`shouldContain` [ ((0, "hi alice"), Just "./tests/tmp/testfile_bob_1"), `shouldContain` [ ((0, "hi alice"), Just "./tests/tmp/testfile_bob_1"),
((0, "hey bob"), Just "./tests/tmp/testfile_alice_1") ((0, "hey bob"), Just "./tests/tmp/testfile_alice_1")
] ]
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
testGroupHistoryFileCancel :: HasCallStack => FilePath -> IO () testGroupHistoryFileCancel :: HasCallStack => FilePath -> IO ()
testGroupHistoryFileCancel = testGroupHistoryFileCancel =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
@ -4851,12 +4843,10 @@ testGroupHistoryFileCancel =
bob <## "#team: alice added cath (Catherine) to the group (connecting...)" bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
bob <## "#team: new member cath is connected" bob <## "#team: new member cath is connected"
] ]
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
testGroupHistoryFileCancelNoText :: HasCallStack => FilePath -> IO () testGroupHistoryFileCancelNoText :: HasCallStack => FilePath -> IO ()
testGroupHistoryFileCancelNoText = testGroupHistoryFileCancelNoText =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
@ -4912,8 +4902,6 @@ testGroupHistoryFileCancelNoText =
bob <## "#team: alice added cath (Catherine) to the group (connecting...)" bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
bob <## "#team: new member cath is connected" bob <## "#team: new member cath is connected"
] ]
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
testGroupHistoryQuotes :: HasCallStack => FilePath -> IO () testGroupHistoryQuotes :: HasCallStack => FilePath -> IO ()
testGroupHistoryQuotes = testGroupHistoryQuotes =

View file

@ -12,7 +12,6 @@ import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), default
import System.Directory (copyFile, doesFileExist) import System.Directory (copyFile, doesFileExist)
import System.FilePath ((</>)) import System.FilePath ((</>))
import Test.Hspec hiding (it) import Test.Hspec hiding (it)
import UnliftIO.Async (concurrently_)
chatLocalChatsTests :: SpecWith FilePath chatLocalChatsTests :: SpecWith FilePath
chatLocalChatsTests = do chatLocalChatsTests = do
@ -158,24 +157,24 @@ testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testOtherFiles :: FilePath -> IO () testOtherFiles :: FilePath -> IO ()
testOtherFiles = testOtherFiles =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob connectUsers alice bob
createCCNoteFolder bob createCCNoteFolder bob
bob ##> "/_files_folder ./tests/tmp/" bob ##> "/_files_folder ./tests/tmp/"
bob <## "ok" bob <## "ok"
alice ##> "/_send @2 json {\"msgContent\":{\"type\":\"voice\", \"duration\":10, \"text\":\"\"}, \"filePath\":\"./tests/fixtures/test.jpg\"}"
alice <# "@bob voice message (00:10)" alice #> "/f @bob ./tests/fixtures/test.jpg"
alice <# "/f @bob ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending"
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
bob <# "alice> voice message (00:10)"
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
-- below is not shown in "sent" mode bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
-- bob <## "use /fr 1 [<dir>/ | <path>] to receive it" alice <## "completed uploading file 1 (test.jpg) for bob"
bob <## "started receiving file 1 (test.jpg) from alice"
concurrently_ bob ##> "/fr 1"
(alice <## "completed sending file 1 (test.jpg) to bob") bob
(bob <## "completed receiving file 1 (test.jpg) from alice") <### [ "saving file 1 from alice to test.jpg",
"started receiving file 1 (test.jpg) from alice"
]
bob <## "completed receiving file 1 (test.jpg) from alice"
bob /* "test" bob /* "test"
bob ##> "/tail *" bob ##> "/tail *"

View file

@ -1493,7 +1493,7 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $
testSetContactPrefs :: HasCallStack => FilePath -> IO () testSetContactPrefs :: HasCallStack => FilePath -> IO ()
testSetContactPrefs = testChat2 aliceProfile bobProfile $ testSetContactPrefs = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> withXFTPServer $ do
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok") alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok")
bob #$> ("/_files_folder ./tests/tmp/bob", id, "ok") bob #$> ("/_files_folder ./tests/tmp/bob", id, "ok")
createDirectoryIfMissing True "./tests/tmp/alice" createDirectoryIfMissing True "./tests/tmp/alice"
@ -1528,15 +1528,24 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you")]) bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you")])
alice ##> sendVoice alice ##> sendVoice
alice <## voiceNotAllowed alice <## voiceNotAllowed
-- sending voice message allowed
bob ##> sendVoice bob ##> sendVoice
bob <# "@alice voice message (00:10)" bob <# "@alice voice message (00:10)"
bob <# "/f @alice test.txt" bob <# "/f @alice test.txt"
bob <## "completed sending file 1 (test.txt) to alice" bob <## "use /fc 1 to cancel sending"
alice <# "bob> voice message (00:10)" alice <# "bob> voice message (00:10)"
alice <# "bob> sends file test.txt (11 bytes / 11 bytes)" alice <# "bob> sends file test.txt (11 bytes / 11 bytes)"
alice <## "started receiving file 1 (test.txt) from bob" alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob <## "completed uploading file 1 (test.txt) for alice"
alice ##> "/fr 1"
alice
<### [ "saving file 1 from bob to test_1.txt",
"started receiving file 1 (test.txt) from bob"
]
alice <## "completed receiving file 1 (test.txt) from bob" alice <## "completed receiving file 1 (test.txt) from bob"
(bob </) (bob </)
-- alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"Alice\", \"preferences\": {\"voice\": {\"allow\": \"no\"}}}" -- alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"Alice\", \"preferences\": {\"voice\": {\"allow\": \"no\"}}}"
alice ##> "/set voice no" alice ##> "/set voice no"
alice <## "updated preferences:" alice <## "updated preferences:"

View file

@ -19,7 +19,7 @@ import Data.Maybe (fromMaybe)
import Data.String import Data.String
import qualified Data.Text as T import qualified Data.Text as T
import Database.SQLite.Simple (Only (..)) import Database.SQLite.Simple (Only (..))
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..))
import Simplex.Chat.Protocol import Simplex.Chat.Protocol
import Simplex.Chat.Store.NoteFolders (createNoteFolder) import Simplex.Chat.Store.NoteFolders (createNoteFolder)
import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Store.Profiles (getUserContactProfiles)
@ -32,7 +32,6 @@ import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Version import Simplex.Messaging.Version
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import System.Environment (lookupEnv, withArgs) import System.Environment (lookupEnv, withArgs)
import System.FilePath ((</>))
import System.IO.Silently (capture_) import System.IO.Silently (capture_)
import System.Info (os) import System.Info (os)
import Test.Hspec hiding (it) import Test.Hspec hiding (it)
@ -96,29 +95,6 @@ versionTestMatrix3 runTest = do
it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest
it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest
inlineCfg :: Integer -> ChatConfig
inlineCfg n = testCfg {inlineFiles = defaultInlineFilesConfig {sendChunks = 0, offerChunks = n, receiveChunks = n}}
fileTestMatrix2 :: (HasCallStack => TestCC -> TestCC -> IO ()) -> SpecWith FilePath
fileTestMatrix2 runTest = do
it "via connection" $ runTestCfg2 viaConn viaConn runTest
it "inline (accepting)" $ runTestCfg2 inline inline runTest
it "via connection (inline offered)" $ runTestCfg2 inline viaConn runTest
it "via connection (inline supported)" $ runTestCfg2 viaConn inline runTest
where
inline = inlineCfg 100
viaConn = inlineCfg 0
fileTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath
fileTestMatrix3 runTest = do
it "via connection" $ runTestCfg3 viaConn viaConn viaConn runTest
it "inline" $ runTestCfg3 inline inline inline runTest
it "via connection (inline offered)" $ runTestCfg3 inline viaConn viaConn runTest
it "via connection (inline supported)" $ runTestCfg3 viaConn inline inline runTest
where
inline = inlineCfg 100
viaConn = inlineCfg 0
runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO () runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
runTestCfg2 aliceCfg bobCfg runTest tmp = runTestCfg2 aliceCfg bobCfg runTest tmp =
withNewTestChatCfg tmp aliceCfg "alice" aliceProfile $ \alice -> withNewTestChatCfg tmp aliceCfg "alice" aliceProfile $ \alice ->
@ -595,20 +571,6 @@ checkActionDeletesFile file action = do
fileExistsAfter <- doesFileExist file fileExistsAfter <- doesFileExist file
fileExistsAfter `shouldBe` False fileExistsAfter `shouldBe` False
startFileTransferWithDest' :: HasCallStack => TestCC -> TestCC -> String -> String -> Maybe String -> IO ()
startFileTransferWithDest' cc1 cc2 fileName fileSize fileDest_ = do
name1 <- userName cc1
name2 <- userName cc2
cc1 #> ("/f @" <> name2 <> " ./tests/fixtures/" <> fileName)
cc1 <## "use /fc 1 to cancel sending"
cc2 <# (name1 <> "> sends file " <> fileName <> " (" <> fileSize <> ")")
cc2 <## "use /fr 1 [<dir>/ | <path>] to receive it"
cc2 ##> ("/fr 1" <> maybe "" (" " <>) fileDest_)
cc2 <## ("saving file 1 from " <> name1 <> " to " <> maybe id (</>) fileDest_ fileName)
concurrently_
(cc2 <## ("started receiving file 1 (" <> fileName <> ") from " <> name1))
(cc1 <## ("started sending file 1 (" <> fileName <> ") to " <> name2))
currentChatVRangeInfo :: String currentChatVRangeInfo :: String
currentChatVRangeInfo = currentChatVRangeInfo =
"peer chat protocol version range: " <> vRangeStr supportedChatVRange "peer chat protocol version range: " <> vRangeStr supportedChatVRange

View file

@ -13,7 +13,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as LB import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Simplex.Chat.Archive (archiveFilesFolder) import Simplex.Chat.Archive (archiveFilesFolder)
import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..), versionNumber) import Simplex.Chat.Controller (versionNumber)
import qualified Simplex.Chat.Controller as Controller import qualified Simplex.Chat.Controller as Controller
import Simplex.Chat.Mobile.File import Simplex.Chat.Mobile.File
import Simplex.Chat.Remote.Types import Simplex.Chat.Remote.Types
@ -194,7 +194,7 @@ remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
remoteStoreFileTest :: HasCallStack => FilePath -> IO () remoteStoreFileTest :: HasCallStack => FilePath -> IO ()
remoteStoreFileTest = remoteStoreFileTest =
testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob ->
withXFTPServer $ do withXFTPServer $ do
let mobileFiles = "./tests/tmp/mobile_files" let mobileFiles = "./tests/tmp/mobile_files"
mobile ##> ("/_files_folder " <> mobileFiles) mobile ##> ("/_files_folder " <> mobileFiles)
@ -317,15 +317,13 @@ remoteStoreFileTest =
stopMobile mobile desktop stopMobile mobile desktop
where where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp/tmp"}
hostError cc err = do hostError cc err = do
r <- getTermLine cc r <- getTermLine cc
r `shouldStartWith` "remote host 1 error" r `shouldStartWith` "remote host 1 error"
r `shouldContain` err r `shouldContain` err
remoteCLIFileTest :: HasCallStack => FilePath -> IO () remoteCLIFileTest :: HasCallStack => FilePath -> IO ()
remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do
createDirectoryIfMissing True "./tests/tmp/tmp/"
let mobileFiles = "./tests/tmp/mobile_files" let mobileFiles = "./tests/tmp/mobile_files"
mobile ##> ("/_files_folder " <> mobileFiles) mobile ##> ("/_files_folder " <> mobileFiles)
mobile <## "ok" mobile <## "ok"
@ -392,8 +390,6 @@ remoteCLIFileTest = testChatCfg3 cfg aliceProfile aliceDesktopProfile bobProfile
B.readFile (bobFiles </> "test.jpg") `shouldReturn` src' B.readFile (bobFiles </> "test.jpg") `shouldReturn` src'
stopMobile mobile desktop stopMobile mobile desktop
where
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp/tmp"}
switchRemoteHostTest :: FilePath -> IO () switchRemoteHostTest :: FilePath -> IO ()
switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do