mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-25 12:04:22 +00:00
Merge pull request #1998 from simplex-chat/xftp
core: transfer files via XFTP
This commit is contained in:
Evgeny Poberezkin
@@ -1714,15 +1714,15 @@ class CIFile(
|
||||
val fileStatus: CIFileStatus
|
||||
) {
|
||||
val loaded: Boolean = when (fileStatus) {
|
||||
CIFileStatus.SndStored -> true
|
||||
CIFileStatus.SndTransfer -> true
|
||||
CIFileStatus.SndComplete -> true
|
||||
CIFileStatus.SndCancelled -> true
|
||||
CIFileStatus.RcvInvitation -> false
|
||||
CIFileStatus.RcvAccepted -> false
|
||||
CIFileStatus.RcvTransfer -> false
|
||||
CIFileStatus.RcvCancelled -> false
|
||||
CIFileStatus.RcvComplete -> true
|
||||
is CIFileStatus.SndStored -> true
|
||||
is CIFileStatus.SndTransfer -> true
|
||||
is CIFileStatus.SndComplete -> true
|
||||
is CIFileStatus.SndCancelled -> true
|
||||
is CIFileStatus.RcvInvitation -> false
|
||||
is CIFileStatus.RcvAccepted -> false
|
||||
is CIFileStatus.RcvTransfer -> false
|
||||
is CIFileStatus.RcvCancelled -> false
|
||||
is CIFileStatus.RcvComplete -> true
|
||||
}
|
||||
|
||||
companion object {
|
||||
@@ -1738,16 +1738,16 @@ class CIFile(
|
||||
}
|
||||
|
||||
@Serializable
|
||||
enum class CIFileStatus {
|
||||
@SerialName("snd_stored") SndStored,
|
||||
@SerialName("snd_transfer") SndTransfer,
|
||||
@SerialName("snd_complete") SndComplete,
|
||||
@SerialName("snd_cancelled") SndCancelled,
|
||||
@SerialName("rcv_invitation") RcvInvitation,
|
||||
@SerialName("rcv_accepted") RcvAccepted,
|
||||
@SerialName("rcv_transfer") RcvTransfer,
|
||||
@SerialName("rcv_complete") RcvComplete,
|
||||
@SerialName("rcv_cancelled") RcvCancelled;
|
||||
sealed class CIFileStatus {
|
||||
@Serializable @SerialName("sndStored") object SndStored: CIFileStatus()
|
||||
@Serializable @SerialName("sndTransfer") class SndTransfer(val sndProgress: Int, val sndTotal: Int): CIFileStatus()
|
||||
@Serializable @SerialName("sndComplete") object SndComplete: CIFileStatus()
|
||||
@Serializable @SerialName("sndCancelled") object SndCancelled: CIFileStatus()
|
||||
@Serializable @SerialName("rcvInvitation") object RcvInvitation: CIFileStatus()
|
||||
@Serializable @SerialName("rcvAccepted") object RcvAccepted: CIFileStatus()
|
||||
@Serializable @SerialName("rcvTransfer") class RcvTransfer(val rcvProgress: Int, val rcvTotal: Int): CIFileStatus()
|
||||
@Serializable @SerialName("rcvComplete") object RcvComplete: CIFileStatus()
|
||||
@Serializable @SerialName("rcvCancelled") object RcvCancelled: CIFileStatus()
|
||||
}
|
||||
|
||||
@Suppress("SERIALIZER_TYPE_INCOMPATIBLE")
|
||||
|
||||
@@ -148,6 +148,8 @@ class AppPreferences(val context: Context) {
|
||||
|
||||
val whatsNewVersion = mkStrPreference(SHARED_PREFS_WHATS_NEW_VERSION, null)
|
||||
|
||||
val xftpSendEnabled = mkBoolPreference(SHARED_PREFS_XFTP_SEND_ENABLED, false)
|
||||
|
||||
private fun mkIntPreference(prefName: String, default: Int) =
|
||||
SharedPreference(
|
||||
get = fun() = sharedPreferences.getInt(prefName, default),
|
||||
@@ -245,6 +247,7 @@ class AppPreferences(val context: Context) {
|
||||
private const val SHARED_PREFS_CURRENT_THEME = "CurrentTheme"
|
||||
private const val SHARED_PREFS_PRIMARY_COLOR = "PrimaryColor"
|
||||
private const val SHARED_PREFS_WHATS_NEW_VERSION = "WhatsNewVersion"
|
||||
private const val SHARED_PREFS_XFTP_SEND_ENABLED = "XFTPSendEnabled"
|
||||
}
|
||||
}
|
||||
|
||||
@@ -280,6 +283,9 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
|
||||
try {
|
||||
if (chatModel.chatRunning.value == true) return
|
||||
apiSetNetworkConfig(getNetCfg())
|
||||
apiSetTempFolder(getTempFilesDirectory(appContext))
|
||||
apiSetFilesFolder(getAppFilesDirectory(appContext))
|
||||
apiSetXFTPConfig(getXFTPCfg())
|
||||
val justStarted = apiStartChat()
|
||||
val users = listUsers()
|
||||
chatModel.users.clear()
|
||||
@@ -287,7 +293,6 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
|
||||
if (justStarted) {
|
||||
chatModel.currentUser.value = user
|
||||
chatModel.userCreated.value = true
|
||||
apiSetFilesFolder(getAppFilesDirectory(appContext))
|
||||
apiSetIncognito(chatModel.incognito.value)
|
||||
getUserChatData()
|
||||
chatModel.onboardingStage.value = OnboardingStage.OnboardingComplete
|
||||
@@ -471,12 +476,24 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
|
||||
}
|
||||
}
|
||||
|
||||
private suspend fun apiSetTempFolder(tempFolder: String) {
|
||||
val r = sendCmd(CC.SetTempFolder(tempFolder))
|
||||
if (r is CR.CmdOk) return
|
||||
throw Error("failed to set temp folder: ${r.responseType} ${r.details}")
|
||||
}
|
||||
|
||||
private suspend fun apiSetFilesFolder(filesFolder: String) {
|
||||
val r = sendCmd(CC.SetFilesFolder(filesFolder))
|
||||
if (r is CR.CmdOk) return
|
||||
throw Error("failed to set files folder: ${r.responseType} ${r.details}")
|
||||
}
|
||||
|
||||
suspend fun apiSetXFTPConfig(cfg: XFTPFileConfig?) {
|
||||
val r = sendCmd(CC.ApiSetXFTPConfig(cfg))
|
||||
if (r is CR.CmdOk) return
|
||||
throw Error("apiSetXFTPConfig bad response: ${r.responseType} ${r.details}")
|
||||
}
|
||||
|
||||
suspend fun apiSetIncognito(incognito: Boolean) {
|
||||
val r = sendCmd(CC.SetIncognito(incognito))
|
||||
if (r is CR.CmdOk) return
|
||||
@@ -1695,6 +1712,11 @@ open class ChatController(var ctrl: ChatCtrl?, val ntfManager: NtfManager, val a
|
||||
}
|
||||
}
|
||||
|
||||
fun getXFTPCfg(): XFTPFileConfig? {
|
||||
val prefXFTPSendEnabled = appPrefs.xftpSendEnabled.get()
|
||||
return if (prefXFTPSendEnabled) XFTPFileConfig(minFileSize = 0) else null
|
||||
}
|
||||
|
||||
fun getNetCfg(): NetCfg {
|
||||
val useSocksProxy = appPrefs.networkUseSocksProxy.get()
|
||||
val socksProxy = if (useSocksProxy) ":9050" else null
|
||||
@@ -1774,7 +1796,9 @@ sealed class CC {
|
||||
class ApiDeleteUser(val userId: Long, val delSMPQueues: Boolean, val viewPwd: String?): CC()
|
||||
class StartChat(val expire: Boolean): CC()
|
||||
class ApiStopChat: CC()
|
||||
class SetTempFolder(val tempFolder: String): CC()
|
||||
class SetFilesFolder(val filesFolder: String): CC()
|
||||
class ApiSetXFTPConfig(val config: XFTPFileConfig?): CC()
|
||||
class SetIncognito(val incognito: Boolean): CC()
|
||||
class ApiExportArchive(val config: ArchiveConfig): CC()
|
||||
class ApiImportArchive(val config: ArchiveConfig): CC()
|
||||
@@ -1855,7 +1879,9 @@ sealed class CC {
|
||||
is ApiDeleteUser -> "/_delete user $userId del_smp=${onOff(delSMPQueues)}${maybePwd(viewPwd)}"
|
||||
is StartChat -> "/_start subscribe=on expire=${onOff(expire)}"
|
||||
is ApiStopChat -> "/_stop"
|
||||
is SetTempFolder -> "/_temp_folder $tempFolder"
|
||||
is SetFilesFolder -> "/_files_folder $filesFolder"
|
||||
is ApiSetXFTPConfig -> if (config != null) "/_xftp on ${json.encodeToString(config)}" else "/_xftp off"
|
||||
is SetIncognito -> "/incognito ${onOff(incognito)}"
|
||||
is ApiExportArchive -> "/_db export ${json.encodeToString(config)}"
|
||||
is ApiImportArchive -> "/_db import ${json.encodeToString(config)}"
|
||||
@@ -1937,7 +1963,9 @@ sealed class CC {
|
||||
is ApiDeleteUser -> "apiDeleteUser"
|
||||
is StartChat -> "startChat"
|
||||
is ApiStopChat -> "apiStopChat"
|
||||
is SetTempFolder -> "setTempFolder"
|
||||
is SetFilesFolder -> "setFilesFolder"
|
||||
is ApiSetXFTPConfig -> "apiSetXFTPConfig"
|
||||
is SetIncognito -> "setIncognito"
|
||||
is ApiExportArchive -> "apiExportArchive"
|
||||
is ApiImportArchive -> "apiImportArchive"
|
||||
@@ -2066,6 +2094,9 @@ sealed class ChatPagination {
|
||||
@Serializable
|
||||
class ComposedMessage(val filePath: String?, val quotedItemId: Long?, val msgContent: MsgContent)
|
||||
|
||||
@Serializable
|
||||
class XFTPFileConfig(val minFileSize: Long)
|
||||
|
||||
@Serializable
|
||||
class ArchiveConfig(val archivePath: String, val disableCompression: Boolean? = null, val parentTempDirectory: String? = null)
|
||||
|
||||
|
||||
@@ -72,7 +72,7 @@ fun CIFileView(
|
||||
fun fileAction() {
|
||||
if (file != null) {
|
||||
when (file.fileStatus) {
|
||||
CIFileStatus.RcvInvitation -> {
|
||||
is CIFileStatus.RcvInvitation -> {
|
||||
if (fileSizeValid()) {
|
||||
receiveFile(file.fileId)
|
||||
} else {
|
||||
@@ -82,12 +82,12 @@ fun CIFileView(
|
||||
)
|
||||
}
|
||||
}
|
||||
CIFileStatus.RcvAccepted ->
|
||||
is CIFileStatus.RcvAccepted ->
|
||||
AlertManager.shared.showAlertMsg(
|
||||
generalGetString(R.string.waiting_for_file),
|
||||
String.format(generalGetString(R.string.file_will_be_received_when_contact_is_online), MAX_FILE_SIZE)
|
||||
)
|
||||
CIFileStatus.RcvComplete -> {
|
||||
is CIFileStatus.RcvComplete -> {
|
||||
val filePath = getLoadedFilePath(context, file)
|
||||
if (filePath != null) {
|
||||
saveFileLauncher.launch(file.fileName)
|
||||
@@ -120,19 +120,19 @@ fun CIFileView(
|
||||
) {
|
||||
if (file != null) {
|
||||
when (file.fileStatus) {
|
||||
CIFileStatus.SndStored -> fileIcon()
|
||||
CIFileStatus.SndTransfer -> progressIndicator()
|
||||
CIFileStatus.SndComplete -> fileIcon(innerIcon = Icons.Filled.Check)
|
||||
CIFileStatus.SndCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
|
||||
CIFileStatus.RcvInvitation ->
|
||||
is CIFileStatus.SndStored -> fileIcon()
|
||||
is CIFileStatus.SndTransfer -> progressIndicator()
|
||||
is CIFileStatus.SndComplete -> fileIcon(innerIcon = Icons.Filled.Check)
|
||||
is CIFileStatus.SndCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
|
||||
is CIFileStatus.RcvInvitation ->
|
||||
if (fileSizeValid())
|
||||
fileIcon(innerIcon = Icons.Outlined.ArrowDownward, color = MaterialTheme.colors.primary)
|
||||
else
|
||||
fileIcon(innerIcon = Icons.Outlined.PriorityHigh, color = WarningOrange)
|
||||
CIFileStatus.RcvAccepted -> fileIcon(innerIcon = Icons.Outlined.MoreHoriz)
|
||||
CIFileStatus.RcvTransfer -> progressIndicator()
|
||||
CIFileStatus.RcvComplete -> fileIcon()
|
||||
CIFileStatus.RcvCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
|
||||
is CIFileStatus.RcvAccepted -> fileIcon(innerIcon = Icons.Outlined.MoreHoriz)
|
||||
is CIFileStatus.RcvTransfer -> progressIndicator()
|
||||
is CIFileStatus.RcvComplete -> fileIcon()
|
||||
is CIFileStatus.RcvCancelled -> fileIcon(innerIcon = Icons.Outlined.Close)
|
||||
}
|
||||
} else {
|
||||
fileIcon()
|
||||
@@ -191,7 +191,7 @@ class ChatItemProvider: PreviewParameterProvider<ChatItem> {
|
||||
ChatItem.getFileMsgContentSample(),
|
||||
ChatItem.getFileMsgContentSample(fileName = "some_long_file_name_here", fileStatus = CIFileStatus.RcvInvitation),
|
||||
ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvAccepted),
|
||||
ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvTransfer),
|
||||
ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvTransfer(rcvProgress = 7, rcvTotal = 10)),
|
||||
ChatItem.getFileMsgContentSample(fileStatus = CIFileStatus.RcvCancelled),
|
||||
ChatItem.getFileMsgContentSample(fileSize = 1_000_000_000, fileStatus = CIFileStatus.RcvInvitation),
|
||||
ChatItem.getFileMsgContentSample(text = "Hello there", fileStatus = CIFileStatus.RcvInvitation),
|
||||
|
||||
@@ -55,33 +55,33 @@ fun CIImageView(
|
||||
contentAlignment = Alignment.Center
|
||||
) {
|
||||
when (file.fileStatus) {
|
||||
CIFileStatus.SndTransfer ->
|
||||
is CIFileStatus.SndTransfer ->
|
||||
CircularProgressIndicator(
|
||||
Modifier.size(16.dp),
|
||||
color = Color.White,
|
||||
strokeWidth = 2.dp
|
||||
)
|
||||
CIFileStatus.SndComplete ->
|
||||
is CIFileStatus.SndComplete ->
|
||||
Icon(
|
||||
Icons.Filled.Check,
|
||||
stringResource(R.string.icon_descr_image_snd_complete),
|
||||
Modifier.fillMaxSize(),
|
||||
tint = Color.White
|
||||
)
|
||||
CIFileStatus.RcvAccepted ->
|
||||
is CIFileStatus.RcvAccepted ->
|
||||
Icon(
|
||||
Icons.Outlined.MoreHoriz,
|
||||
stringResource(R.string.icon_descr_waiting_for_image),
|
||||
Modifier.fillMaxSize(),
|
||||
tint = Color.White
|
||||
)
|
||||
CIFileStatus.RcvTransfer ->
|
||||
is CIFileStatus.RcvTransfer ->
|
||||
CircularProgressIndicator(
|
||||
Modifier.size(16.dp),
|
||||
color = Color.White,
|
||||
strokeWidth = 2.dp
|
||||
)
|
||||
CIFileStatus.RcvInvitation ->
|
||||
is CIFileStatus.RcvInvitation ->
|
||||
Icon(
|
||||
Icons.Outlined.ArrowDownward,
|
||||
stringResource(R.string.icon_descr_asked_to_receive),
|
||||
@@ -187,7 +187,7 @@ fun CIImageView(
|
||||
generalGetString(R.string.waiting_for_image),
|
||||
generalGetString(R.string.image_will_be_received_when_contact_is_online)
|
||||
)
|
||||
CIFileStatus.RcvTransfer -> {} // ?
|
||||
CIFileStatus.RcvTransfer(rcvProgress = 7, rcvTotal = 10) -> {} // ?
|
||||
CIFileStatus.RcvComplete -> {} // ?
|
||||
CIFileStatus.RcvCancelled -> {} // TODO
|
||||
else -> {}
|
||||
|
||||
@@ -210,9 +210,9 @@ private fun VoiceMsgIndicator(
|
||||
PlayPauseButton(audioPlaying, sent, angle, strokeWidth, strokeColor, true, error, play, pause, longClick = longClick)
|
||||
}
|
||||
} else {
|
||||
if (file?.fileStatus == CIFileStatus.RcvInvitation
|
||||
|| file?.fileStatus == CIFileStatus.RcvTransfer
|
||||
|| file?.fileStatus == CIFileStatus.RcvAccepted
|
||||
if (file?.fileStatus is CIFileStatus.RcvInvitation
|
||||
|| file?.fileStatus is CIFileStatus.RcvTransfer
|
||||
|| file?.fileStatus is CIFileStatus.RcvAccepted
|
||||
) {
|
||||
Box(
|
||||
Modifier
|
||||
|
||||
@@ -237,12 +237,17 @@ const val MAX_VOICE_SIZE_AUTO_RCV: Long = MAX_IMAGE_SIZE
|
||||
const val MAX_VOICE_SIZE_FOR_SENDING: Long = 94680 // 6 chunks * 15780 bytes per chunk
|
||||
const val MAX_VOICE_MILLIS_FOR_SENDING: Int = 43_000
|
||||
|
||||
const val MAX_FILE_SIZE: Long = 8000000
|
||||
//const val MAX_FILE_SIZE_SMP: Long = 8000000 // TODO distinguish between XFTP and SMP files
|
||||
const val MAX_FILE_SIZE: Long = 1_073_741_824
|
||||
|
||||
fun getFilesDirectory(context: Context): String {
|
||||
return context.filesDir.toString()
|
||||
}
|
||||
|
||||
fun getTempFilesDirectory(context: Context): String {
|
||||
return "${getFilesDirectory(context)}/temp_files"
|
||||
}
|
||||
|
||||
fun getAppFilesDirectory(context: Context): String {
|
||||
return "${getFilesDirectory(context)}/app_files"
|
||||
}
|
||||
|
||||
+9
-5
@@ -5,18 +5,18 @@ import androidx.compose.foundation.layout.*
|
||||
import androidx.compose.material.MaterialTheme
|
||||
import androidx.compose.material.Text
|
||||
import androidx.compose.material.icons.Icons
|
||||
import androidx.compose.material.icons.outlined.Videocam
|
||||
import androidx.compose.material.icons.outlined.UploadFile
|
||||
import androidx.compose.runtime.Composable
|
||||
import androidx.compose.runtime.MutableState
|
||||
import androidx.compose.ui.Alignment
|
||||
import androidx.compose.ui.Modifier
|
||||
import androidx.compose.ui.res.stringResource
|
||||
import androidx.compose.ui.unit.dp
|
||||
import chat.simplex.app.R
|
||||
import chat.simplex.app.model.ChatModel
|
||||
import chat.simplex.app.views.helpers.withApi
|
||||
|
||||
@Composable
|
||||
fun ExperimentalFeaturesView(chatModel: ChatModel, enableCalls: MutableState<Boolean>) {
|
||||
fun ExperimentalFeaturesView(chatModel: ChatModel) {
|
||||
Column(
|
||||
Modifier.fillMaxWidth(),
|
||||
horizontalAlignment = Alignment.Start
|
||||
@@ -27,7 +27,11 @@ fun ExperimentalFeaturesView(chatModel: ChatModel, enableCalls: MutableState<Boo
|
||||
modifier = Modifier.padding(start = 16.dp, bottom = 24.dp)
|
||||
)
|
||||
SectionView("") {
|
||||
SettingsPreferenceItem(Icons.Outlined.Videocam, stringResource(R.string.settings_audio_video_calls), chatModel.controller.appPrefs.experimentalCalls, enableCalls)
|
||||
SettingsPreferenceItem(Icons.Outlined.UploadFile, stringResource(R.string.settings_send_files_via_xftp), chatModel.controller.appPrefs.xftpSendEnabled) {
|
||||
withApi {
|
||||
chatModel.controller.apiSetXFTPConfig(chatModel.controller.getXFTPCfg())
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -216,8 +216,8 @@ fun SettingsLayout(
|
||||
InstallTerminalAppItem(uriHandler)
|
||||
SectionDivider()
|
||||
}
|
||||
// SettingsActionItem(Icons.Outlined.Science, stringResource(R.string.settings_experimental_features), showSettingsModal { ExperimentalFeaturesView(it, enableCalls) })
|
||||
// SectionDivider()
|
||||
SettingsActionItem(Icons.Outlined.Science, stringResource(R.string.settings_experimental_features), showSettingsModal { ExperimentalFeaturesView(it) })
|
||||
SectionDivider()
|
||||
AppVersionItem(showVersion)
|
||||
}
|
||||
}
|
||||
|
||||
@@ -716,6 +716,7 @@
|
||||
<string name="settings_section_title_messages">MESSAGES</string>
|
||||
<string name="settings_section_title_calls">CALLS</string>
|
||||
<string name="settings_section_title_incognito">Incognito mode</string>
|
||||
<string name="settings_send_files_via_xftp">Send files via XFTP</string>
|
||||
|
||||
<!-- DatabaseView.kt -->
|
||||
<string name="your_chat_database">Your chat database</string>
|
||||
|
||||
@@ -215,12 +215,24 @@ func apiSuspendChat(timeoutMicroseconds: Int) {
|
||||
logger.error("apiSuspendChat error: \(String(describing: r))")
|
||||
}
|
||||
|
||||
func apiSetTempFolder(tempFolder: String) throws {
|
||||
let r = chatSendCmdSync(.setTempFolder(tempFolder: tempFolder))
|
||||
if case .cmdOk = r { return }
|
||||
throw r
|
||||
}
|
||||
|
||||
func apiSetFilesFolder(filesFolder: String) throws {
|
||||
let r = chatSendCmdSync(.setFilesFolder(filesFolder: filesFolder))
|
||||
if case .cmdOk = r { return }
|
||||
throw r
|
||||
}
|
||||
|
||||
func setXFTPConfig(_ cfg: XFTPFileConfig?) throws {
|
||||
let r = chatSendCmdSync(.apiSetXFTPConfig(config: cfg))
|
||||
if case .cmdOk = r { return }
|
||||
throw r
|
||||
}
|
||||
|
||||
func apiSetIncognito(incognito: Bool) throws {
|
||||
let r = chatSendCmdSync(.setIncognito(incognito: incognito))
|
||||
if case .cmdOk = r { return }
|
||||
@@ -992,7 +1004,9 @@ func initializeChat(start: Bool, dbKey: String? = nil, refreshInvitations: Bool
|
||||
if encryptionStartedDefault.get() {
|
||||
encryptionStartedDefault.set(false)
|
||||
}
|
||||
try apiSetTempFolder(tempFolder: getTempFilesDirectory().path)
|
||||
try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
|
||||
try setXFTPConfig(getXFTPCfg())
|
||||
try apiSetIncognito(incognito: incognitoGroupDefault.get())
|
||||
m.chatInitialized = true
|
||||
m.currentUser = try apiGetActiveUser()
|
||||
@@ -1307,6 +1321,8 @@ func processReceivedMsg(_ res: ChatResponse) async {
|
||||
chatItemSimpleUpdate(user, aChatItem)
|
||||
case let .rcvFileComplete(user, aChatItem):
|
||||
chatItemSimpleUpdate(user, aChatItem)
|
||||
case let .rcvFileProgressXFTP(user, aChatItem, _, _):
|
||||
chatItemSimpleUpdate(user, aChatItem)
|
||||
case let .sndFileStart(user, aChatItem, _):
|
||||
chatItemSimpleUpdate(user, aChatItem)
|
||||
case let .sndFileComplete(user, aChatItem, _):
|
||||
@@ -1318,6 +1334,8 @@ func processReceivedMsg(_ res: ChatResponse) async {
|
||||
let fileName = cItem.file?.filePath {
|
||||
removeFile(fileName)
|
||||
}
|
||||
case let .sndFileProgressXFTP(user, aChatItem, _, _, _):
|
||||
chatItemSimpleUpdate(user, aChatItem)
|
||||
case let .callInvitation(invitation):
|
||||
m.callInvitations[invitation.contact.id] = invitation
|
||||
activateCall(invitation)
|
||||
|
||||
@@ -16,8 +16,8 @@ struct CIFileView: View {
|
||||
|
||||
var body: some View {
|
||||
let metaReserve = edited
|
||||
? " "
|
||||
: " "
|
||||
? " "
|
||||
: " "
|
||||
Button(action: fileAction) {
|
||||
HStack(alignment: .bottom, spacing: 6) {
|
||||
fileIndicator()
|
||||
@@ -45,17 +45,34 @@ struct CIFileView: View {
|
||||
.padding(.leading, 10)
|
||||
.padding(.trailing, 12)
|
||||
}
|
||||
.disabled(file == nil || (file?.fileStatus != .rcvInvitation && file?.fileStatus != .rcvAccepted && file?.fileStatus != .rcvComplete))
|
||||
.disabled(!itemInteractive)
|
||||
}
|
||||
|
||||
func fileSizeValid() -> Bool {
|
||||
private var itemInteractive: Bool {
|
||||
if let file = file {
|
||||
switch (file.fileStatus) {
|
||||
case .sndStored: return false
|
||||
case .sndTransfer: return false
|
||||
case .sndComplete: return false
|
||||
case .sndCancelled: return false
|
||||
case .rcvInvitation: return true
|
||||
case .rcvAccepted: return true
|
||||
case .rcvTransfer: return false
|
||||
case .rcvComplete: return true
|
||||
case .rcvCancelled: return false
|
||||
}
|
||||
}
|
||||
return false
|
||||
}
|
||||
|
||||
private func fileSizeValid() -> Bool {
|
||||
if let file = file {
|
||||
return file.fileSize <= MAX_FILE_SIZE
|
||||
}
|
||||
return false
|
||||
}
|
||||
|
||||
func fileAction() {
|
||||
private func fileAction() {
|
||||
logger.debug("CIFileView fileAction")
|
||||
if let file = file {
|
||||
switch (file.fileStatus) {
|
||||
@@ -90,11 +107,12 @@ struct CIFileView: View {
|
||||
}
|
||||
}
|
||||
|
||||
@ViewBuilder func fileIndicator() -> some View {
|
||||
@ViewBuilder private func fileIndicator() -> some View {
|
||||
if let file = file {
|
||||
switch file.fileStatus {
|
||||
case .sndStored: fileIcon("doc.fill")
|
||||
case .sndTransfer: ProgressView().frame(width: 30, height: 30)
|
||||
// case .sndTransfer: ProgressView().frame(width: 30, height: 30) // TODO use for SMP files
|
||||
case let .sndTransfer(sndProgress, sndTotal): progressCircle(sndProgress, sndTotal)
|
||||
case .sndComplete: fileIcon("doc.fill", innerIcon: "checkmark", innerIconSize: 10)
|
||||
case .sndCancelled: fileIcon("doc.fill", innerIcon: "xmark", innerIconSize: 10)
|
||||
case .rcvInvitation:
|
||||
@@ -104,7 +122,8 @@ struct CIFileView: View {
|
||||
fileIcon("doc.fill", color: .orange, innerIcon: "exclamationmark", innerIconSize: 12)
|
||||
}
|
||||
case .rcvAccepted: fileIcon("doc.fill", innerIcon: "ellipsis", innerIconSize: 12)
|
||||
case .rcvTransfer: ProgressView().frame(width: 30, height: 30)
|
||||
// case .rcvTransfer: ProgressView().frame(width: 30, height: 30) // TODO use for SMP files
|
||||
case let .rcvTransfer(rcvProgress, rcvTotal): progressCircle(rcvProgress, rcvTotal)
|
||||
case .rcvComplete: fileIcon("doc.fill")
|
||||
case .rcvCancelled: fileIcon("doc.fill", innerIcon: "xmark", innerIconSize: 10)
|
||||
}
|
||||
@@ -113,7 +132,7 @@ struct CIFileView: View {
|
||||
}
|
||||
}
|
||||
|
||||
func fileIcon(_ icon: String, color: Color = Color(uiColor: .tertiaryLabel), innerIcon: String? = nil, innerIconSize: CGFloat? = nil) -> some View {
|
||||
private func fileIcon(_ icon: String, color: Color = Color(uiColor: .tertiaryLabel), innerIcon: String? = nil, innerIconSize: CGFloat? = nil) -> some View {
|
||||
ZStack(alignment: .center) {
|
||||
Image(systemName: icon)
|
||||
.resizable()
|
||||
@@ -132,6 +151,17 @@ struct CIFileView: View {
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
private func progressCircle(_ progress: Int64, _ total: Int64) -> some View {
|
||||
Circle()
|
||||
.trim(from: 0, to: Double(progress) / Double(total))
|
||||
.stroke(
|
||||
Color.accentColor,
|
||||
style: StrokeStyle(lineWidth: 3)
|
||||
)
|
||||
.rotationEffect(.degrees(-90))
|
||||
.frame(width: 30, height: 30)
|
||||
}
|
||||
}
|
||||
|
||||
struct CIFileView_Previews: PreviewProvider {
|
||||
@@ -155,7 +185,7 @@ struct CIFileView_Previews: PreviewProvider {
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileName: "some_long_file_name_here", fileStatus: .rcvInvitation), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvAccepted), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvTransfer), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvTransfer(rcvProgress: 7, rcvTotal: 10)), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileStatus: .rcvCancelled), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(fileSize: 1_000_000_000, fileStatus: .rcvInvitation), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getFileMsgContentSample(text: "Hello there", fileStatus: .rcvInvitation), revealed: Binding.constant(false))
|
||||
|
||||
@@ -243,7 +243,7 @@ struct CIVoiceView_Previews: PreviewProvider {
|
||||
)
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: sentVoiceMessage, revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(fileStatus: .rcvTransfer), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(fileStatus: .rcvTransfer(rcvProgress: 7, rcvTotal: 10)), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: voiceMessageWtFile, revealed: Binding.constant(false))
|
||||
}
|
||||
.previewLayout(.fixed(width: 360, height: 360))
|
||||
|
||||
@@ -62,7 +62,7 @@ struct FramedCIVoiceView_Previews: PreviewProvider {
|
||||
Group {
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: sentVoiceMessage, revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Hello there"), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Hello there", fileStatus: .rcvTransfer), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Hello there", fileStatus: .rcvTransfer(rcvProgress: 7, rcvTotal: 10)), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: ChatItem.getVoiceMsgContentSample(text: "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."), revealed: Binding.constant(false))
|
||||
ChatItemView(chatInfo: ChatInfo.sampleData.direct, chatItem: voiceMessageWithQuote, revealed: Binding.constant(false))
|
||||
}
|
||||
|
||||
@@ -7,15 +7,23 @@
|
||||
//
|
||||
|
||||
import SwiftUI
|
||||
import SimpleXChat
|
||||
|
||||
struct ExperimentalFeaturesView: View {
|
||||
@AppStorage(DEFAULT_EXPERIMENTAL_CALLS) private var enableCalls = false
|
||||
@AppStorage(GROUP_DEFAULT_XFTP_SEND_ENABLED, store: UserDefaults(suiteName: APP_GROUP_NAME)!) private var xftpSendEnabled = false
|
||||
|
||||
var body: some View {
|
||||
List {
|
||||
Section("") {
|
||||
settingsRow("video") {
|
||||
Toggle("Audio & video calls", isOn: $enableCalls)
|
||||
settingsRow("arrow.up.doc") {
|
||||
Toggle("Send files via XFTP", isOn: $xftpSendEnabled)
|
||||
.onChange(of: xftpSendEnabled) { _ in
|
||||
do {
|
||||
try setXFTPConfig(getXFTPCfg())
|
||||
} catch {
|
||||
logger.error("setXFTPConfig: cannot set XFTP config \(responseError(error))")
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -264,12 +264,12 @@ struct SettingsView: View {
|
||||
} label: {
|
||||
settingsRow("chevron.left.forwardslash.chevron.right") { Text("Developer tools") }
|
||||
}
|
||||
// NavigationLink {
|
||||
// ExperimentalFeaturesView()
|
||||
// .navigationTitle("Experimental features")
|
||||
// } label: {
|
||||
// settingsRow("gauge") { Text("Experimental features") }
|
||||
// }
|
||||
NavigationLink {
|
||||
ExperimentalFeaturesView()
|
||||
.navigationTitle("Experimental features")
|
||||
} label: {
|
||||
settingsRow("gauge") { Text("Experimental features") }
|
||||
}
|
||||
NavigationLink {
|
||||
VersionView()
|
||||
.navigationBarTitle("App version")
|
||||
|
||||
@@ -199,6 +199,7 @@ class NotificationService: UNNotificationServiceExtension {
|
||||
|
||||
var chatStarted = false
|
||||
var networkConfig: NetCfg = getNetCfg()
|
||||
var xftpConfig: XFTPFileConfig? = getXFTPCfg()
|
||||
|
||||
func startChat() -> DBMigrationResult? {
|
||||
hs_init(0, nil)
|
||||
@@ -212,10 +213,12 @@ func startChat() -> DBMigrationResult? {
|
||||
logger.debug("active user \(String(describing: user))")
|
||||
do {
|
||||
try setNetworkConfig(networkConfig)
|
||||
try apiSetTempFolder(tempFolder: getTempFilesDirectory().path)
|
||||
try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
|
||||
try setXFTPConfig(xftpConfig)
|
||||
let justStarted = try apiStartChat()
|
||||
chatStarted = true
|
||||
if justStarted {
|
||||
try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path)
|
||||
try apiSetIncognito(incognito: incognitoGroupDefault.get())
|
||||
chatLastStartGroupDefault.set(Date.now)
|
||||
Task { await receiveMessages() }
|
||||
@@ -329,12 +332,24 @@ func apiStartChat() throws -> Bool {
|
||||
}
|
||||
}
|
||||
|
||||
func apiSetTempFolder(tempFolder: String) throws {
|
||||
let r = sendSimpleXCmd(.setTempFolder(tempFolder: tempFolder))
|
||||
if case .cmdOk = r { return }
|
||||
throw r
|
||||
}
|
||||
|
||||
func apiSetFilesFolder(filesFolder: String) throws {
|
||||
let r = sendSimpleXCmd(.setFilesFolder(filesFolder: filesFolder))
|
||||
if case .cmdOk = r { return }
|
||||
throw r
|
||||
}
|
||||
|
||||
func setXFTPConfig(_ cfg: XFTPFileConfig?) throws {
|
||||
let r = sendSimpleXCmd(.apiSetXFTPConfig(config: cfg))
|
||||
if case .cmdOk = r { return }
|
||||
throw r
|
||||
}
|
||||
|
||||
func apiSetIncognito(incognito: Bool) throws {
|
||||
let r = sendSimpleXCmd(.setIncognito(incognito: incognito))
|
||||
if case .cmdOk = r { return }
|
||||
|
||||
@@ -26,7 +26,9 @@ public enum ChatCommand {
|
||||
case apiStopChat
|
||||
case apiActivateChat
|
||||
case apiSuspendChat(timeoutMicroseconds: Int)
|
||||
case setTempFolder(tempFolder: String)
|
||||
case setFilesFolder(filesFolder: String)
|
||||
case apiSetXFTPConfig(config: XFTPFileConfig?)
|
||||
case setIncognito(incognito: Bool)
|
||||
case apiExportArchive(config: ArchiveConfig)
|
||||
case apiImportArchive(config: ArchiveConfig)
|
||||
@@ -117,7 +119,13 @@ public enum ChatCommand {
|
||||
case .apiStopChat: return "/_stop"
|
||||
case .apiActivateChat: return "/_app activate"
|
||||
case let .apiSuspendChat(timeoutMicroseconds): return "/_app suspend \(timeoutMicroseconds)"
|
||||
case let .setTempFolder(tempFolder): return "/_temp_folder \(tempFolder)"
|
||||
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 .setIncognito(incognito): return "/incognito \(onOff(incognito))"
|
||||
case let .apiExportArchive(cfg): return "/_db export \(encodeJSON(cfg))"
|
||||
case let .apiImportArchive(cfg): return "/_db import \(encodeJSON(cfg))"
|
||||
@@ -219,7 +227,9 @@ public enum ChatCommand {
|
||||
case .apiStopChat: return "apiStopChat"
|
||||
case .apiActivateChat: return "apiActivateChat"
|
||||
case .apiSuspendChat: return "apiSuspendChat"
|
||||
case .setTempFolder: return "setTempFolder"
|
||||
case .setFilesFolder: return "setFilesFolder"
|
||||
case .apiSetXFTPConfig: return "apiSetXFTPConfig"
|
||||
case .setIncognito: return "setIncognito"
|
||||
case .apiExportArchive: return "apiExportArchive"
|
||||
case .apiImportArchive: return "apiImportArchive"
|
||||
@@ -441,6 +451,7 @@ public enum ChatResponse: Decodable, Error {
|
||||
case rcvFileAccepted(user: User, chatItem: AChatItem)
|
||||
case rcvFileAcceptedSndCancelled(user: User, rcvFileTransfer: RcvFileTransfer)
|
||||
case rcvFileStart(user: User, chatItem: AChatItem)
|
||||
case rcvFileProgressXFTP(user: User, chatItem: AChatItem, receivedSize: Int64, totalSize: Int64)
|
||||
case rcvFileComplete(user: User, chatItem: AChatItem)
|
||||
// sending file events
|
||||
case sndFileStart(user: User, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
|
||||
@@ -448,6 +459,7 @@ public enum ChatResponse: Decodable, Error {
|
||||
case sndFileCancelled(chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
|
||||
case sndFileRcvCancelled(user: User, chatItem: AChatItem, sndFileTransfer: SndFileTransfer)
|
||||
case sndGroupFileCancelled(user: User, chatItem: AChatItem, fileTransferMeta: FileTransferMeta, sndFileTransfers: [SndFileTransfer])
|
||||
case sndFileProgressXFTP(user: User, chatItem: AChatItem, fileTransferMeta: FileTransferMeta, sentSize: Int64, totalSize: Int64)
|
||||
case callInvitation(callInvitation: RcvCallInvitation)
|
||||
case callOffer(user: User, contact: Contact, callType: CallType, offer: WebRTCSession, sharedKey: String?, askConfirmation: Bool)
|
||||
case callAnswer(user: User, contact: Contact, answer: WebRTCSession)
|
||||
@@ -548,12 +560,14 @@ public enum ChatResponse: Decodable, Error {
|
||||
case .rcvFileAccepted: return "rcvFileAccepted"
|
||||
case .rcvFileAcceptedSndCancelled: return "rcvFileAcceptedSndCancelled"
|
||||
case .rcvFileStart: return "rcvFileStart"
|
||||
case .rcvFileProgressXFTP: return "rcvFileProgressXFTP"
|
||||
case .rcvFileComplete: return "rcvFileComplete"
|
||||
case .sndFileStart: return "sndFileStart"
|
||||
case .sndFileComplete: return "sndFileComplete"
|
||||
case .sndFileCancelled: return "sndFileCancelled"
|
||||
case .sndFileRcvCancelled: return "sndFileRcvCancelled"
|
||||
case .sndGroupFileCancelled: return "sndGroupFileCancelled"
|
||||
case .sndFileProgressXFTP: return "sndFileProgressXFTP"
|
||||
case .callInvitation: return "callInvitation"
|
||||
case .callOffer: return "callOffer"
|
||||
case .callAnswer: return "callAnswer"
|
||||
@@ -657,12 +671,14 @@ public enum ChatResponse: Decodable, Error {
|
||||
case let .rcvFileAccepted(u, chatItem): return withUser(u, String(describing: chatItem))
|
||||
case .rcvFileAcceptedSndCancelled: return noDetails
|
||||
case let .rcvFileStart(u, chatItem): return withUser(u, String(describing: chatItem))
|
||||
case let .rcvFileProgressXFTP(u, chatItem, receivedSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nreceivedSize: \(receivedSize)\ntotalSize: \(totalSize)")
|
||||
case let .rcvFileComplete(u, chatItem): return withUser(u, String(describing: chatItem))
|
||||
case let .sndFileStart(u, chatItem, _): return withUser(u, String(describing: chatItem))
|
||||
case let .sndFileComplete(u, chatItem, _): return withUser(u, String(describing: chatItem))
|
||||
case let .sndFileCancelled(chatItem, _): return String(describing: chatItem)
|
||||
case let .sndFileRcvCancelled(u, chatItem, _): return withUser(u, String(describing: chatItem))
|
||||
case let .sndGroupFileCancelled(u, chatItem, _, _): return withUser(u, String(describing: chatItem))
|
||||
case let .sndFileProgressXFTP(u, chatItem, _, sentSize, totalSize): return withUser(u, "chatItem: \(String(describing: chatItem))\nsentSize: \(sentSize)\ntotalSize: \(totalSize)")
|
||||
case let .callInvitation(inv): return String(describing: inv)
|
||||
case let .callOffer(u, contact, callType, offer, sharedKey, askConfirmation): return withUser(u, "contact: \(contact.id)\ncallType: \(String(describing: callType))\nsharedKey: \(sharedKey ?? "")\naskConfirmation: \(askConfirmation)\noffer: \(String(describing: offer))")
|
||||
case let .callAnswer(u, contact, answer): return withUser(u, "contact: \(contact.id)\nanswer: \(String(describing: answer))")
|
||||
@@ -712,6 +728,10 @@ struct ComposedMessage: Encodable {
|
||||
var msgContent: MsgContent
|
||||
}
|
||||
|
||||
public struct XFTPFileConfig: Encodable {
|
||||
var minFileSize: Int64
|
||||
}
|
||||
|
||||
public struct ArchiveConfig: Encodable {
|
||||
var archivePath: String
|
||||
var disableCompression: Bool?
|
||||
|
||||
@@ -31,6 +31,7 @@ let GROUP_DEFAULT_STORE_DB_PASSPHRASE = "storeDBPassphrase"
|
||||
let GROUP_DEFAULT_INITIAL_RANDOM_DB_PASSPHRASE = "initialRandomDBPassphrase"
|
||||
public let GROUP_DEFAULT_CONFIRM_DB_UPGRADES = "confirmDBUpgrades"
|
||||
public let GROUP_DEFAULT_CALL_KIT_ENABLED = "callKitEnabled"
|
||||
public let GROUP_DEFAULT_XFTP_SEND_ENABLED = "xftpSendEnabled"
|
||||
|
||||
public let APP_GROUP_NAME = "group.chat.simplex.app"
|
||||
|
||||
@@ -54,7 +55,8 @@ public func registerGroupDefaults() {
|
||||
GROUP_DEFAULT_PRIVACY_ACCEPT_IMAGES: true,
|
||||
GROUP_DEFAULT_PRIVACY_TRANSFER_IMAGES_INLINE: false,
|
||||
GROUP_DEFAULT_CONFIRM_DB_UPGRADES: false,
|
||||
GROUP_DEFAULT_CALL_KIT_ENABLED: true
|
||||
GROUP_DEFAULT_CALL_KIT_ENABLED: true,
|
||||
GROUP_DEFAULT_XFTP_SEND_ENABLED: false,
|
||||
])
|
||||
}
|
||||
|
||||
@@ -127,6 +129,8 @@ public let confirmDBUpgradesGroupDefault = BoolDefault(defaults: groupDefaults,
|
||||
|
||||
public let callKitEnabledGroupDefault = BoolDefault(defaults: groupDefaults, forKey: GROUP_DEFAULT_CALL_KIT_ENABLED)
|
||||
|
||||
public let xftpSendEnabledGroupDefault = BoolDefault(defaults: groupDefaults, forKey: GROUP_DEFAULT_XFTP_SEND_ENABLED)
|
||||
|
||||
public class DateDefault {
|
||||
var defaults: UserDefaults
|
||||
var key: String
|
||||
@@ -199,6 +203,11 @@ public class Default<T> {
|
||||
}
|
||||
}
|
||||
|
||||
public func getXFTPCfg() -> XFTPFileConfig? {
|
||||
let xftpSendEnabled = xftpSendEnabledGroupDefault.get()
|
||||
return xftpSendEnabled ? XFTPFileConfig(minFileSize: 0) : nil
|
||||
}
|
||||
|
||||
public func getNetCfg() -> NetCfg {
|
||||
let onionHosts = networkUseOnionHostsGroupDefault.get()
|
||||
let (hostMode, requiredHostMode) = onionHosts.hostMode
|
||||
|
||||
@@ -2237,16 +2237,30 @@ public struct CIFile: Decodable {
|
||||
}
|
||||
}
|
||||
|
||||
public enum CIFileStatus: String, Decodable {
|
||||
case sndStored = "snd_stored"
|
||||
case sndTransfer = "snd_transfer"
|
||||
case sndComplete = "snd_complete"
|
||||
case sndCancelled = "snd_cancelled"
|
||||
case rcvInvitation = "rcv_invitation"
|
||||
case rcvAccepted = "rcv_accepted"
|
||||
case rcvTransfer = "rcv_transfer"
|
||||
case rcvComplete = "rcv_complete"
|
||||
case rcvCancelled = "rcv_cancelled"
|
||||
public enum CIFileStatus: Decodable {
|
||||
case sndStored
|
||||
case sndTransfer(sndProgress: Int64, sndTotal: Int64)
|
||||
case sndComplete
|
||||
case sndCancelled
|
||||
case rcvInvitation
|
||||
case rcvAccepted
|
||||
case rcvTransfer(rcvProgress: Int64, rcvTotal: Int64)
|
||||
case rcvComplete
|
||||
case rcvCancelled
|
||||
|
||||
var id: String {
|
||||
switch self {
|
||||
case .sndStored: return "sndStored"
|
||||
case let .sndTransfer(sndProgress, sndTotal): return "sndTransfer \(sndProgress) \(sndTotal)"
|
||||
case .sndComplete: return "sndComplete"
|
||||
case .sndCancelled: return "sndCancelled"
|
||||
case .rcvInvitation: return "rcvInvitation"
|
||||
case .rcvAccepted: return "rcvAccepted"
|
||||
case let .rcvTransfer(rcvProgress, rcvTotal): return "rcvTransfer \(rcvProgress) \(rcvTotal)"
|
||||
case .rcvComplete: return "rcvComplete"
|
||||
case .rcvCancelled: return "rcvCancelled"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
public enum MsgContent {
|
||||
|
||||
@@ -16,7 +16,8 @@ public let MAX_IMAGE_SIZE: Int64 = 236700
|
||||
|
||||
public let MAX_IMAGE_SIZE_AUTO_RCV: Int64 = MAX_IMAGE_SIZE * 2
|
||||
|
||||
public let MAX_FILE_SIZE: Int64 = 8000000
|
||||
//public let MAX_FILE_SIZE_SMP: Int64 = 8000000 // TODO distinguish between XFTP and SMP files
|
||||
public let MAX_FILE_SIZE: Int64 = 1_073_741_824
|
||||
|
||||
public let MAX_VOICE_MESSAGE_LENGTH = TimeInterval(30)
|
||||
|
||||
@@ -158,6 +159,10 @@ public func removeLegacyDatabaseAndFiles() -> Bool {
|
||||
return r1 && r2
|
||||
}
|
||||
|
||||
public func getTempFilesDirectory() -> URL {
|
||||
getAppDirectory().appendingPathComponent("temp_files", isDirectory: true)
|
||||
}
|
||||
|
||||
public func getAppFilesDirectory() -> URL {
|
||||
getAppDirectory().appendingPathComponent("app_files", isDirectory: true)
|
||||
}
|
||||
|
||||
@@ -0,0 +1,42 @@
|
||||
sequenceDiagram
|
||||
participant A as Alice
|
||||
participant AC as Alice Chat
|
||||
participant AA as Alice Agent
|
||||
participant XFTP as Alice's XFTP relay(s)
|
||||
participant SMP as Bob's SMP relay
|
||||
participant BA as Bob Agent
|
||||
participant BC as Bob Chat
|
||||
participant B as Bob
|
||||
|
||||
A ->> AC: APISendMessage
|
||||
AC ->> AA: sendMessage(x.msg.new) /<br>CIFSSndStored
|
||||
AA ->> SMP: SEND<x.msg.new>
|
||||
SMP ->> BA: MSG<x.msg.new>
|
||||
BA ->> BC: MSG<x.msg.new>
|
||||
BC ->> B: CRNewChatItem<br>(file not ready)
|
||||
B ->> BC: ReceiveFile
|
||||
BC ->> B: error: no file description
|
||||
AC ->> AA: sendFile
|
||||
AC ->> A: CRSndFileStart
|
||||
AA ->> XFTP: chunk (FNEW, FPUT)
|
||||
AA ->> AC: SFPROG /<br>CIFSSndTransfer
|
||||
AC ->> A: CRSndFileProgress (new)
|
||||
AA ->> XFTP: chunks
|
||||
AA ->> AC: SFDONE sd rds
|
||||
AC ->> AA: sendMessage(x.msg.file.descr) /<br>FSComplete / CIFSSndComplete
|
||||
AC ->> A: CRSndFileComplete (?)
|
||||
AA ->> SMP: SEND<x.msg.file.descr>
|
||||
SMP ->> BA: MSG<x.msg.file.descr>
|
||||
BA ->> BC: MSG<x.msg.file.descr>
|
||||
BC ->> B: CRChatItemUpdated<br>(file is ready)
|
||||
BC ->> B: CRFileReady (TBC)
|
||||
B ->> BC: ReceiveFile
|
||||
BC ->> BA: getFile
|
||||
BC ->> B: CRRcvFileStart
|
||||
XFTP ->> BA: chunk (FGET / FRFile)
|
||||
BA ->> BC: RFPROG
|
||||
BC ->> B: CRRcvFileProgress (new)
|
||||
XFTP ->> BA: chunks
|
||||
BA ->> BC: RFDONE
|
||||
BC ->> B: CRNewChatItem<br>(file received)
|
||||
BC ->> B: CRRcvFileComplete
|
||||
+2
-1
@@ -85,8 +85,9 @@ library
|
||||
Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
|
||||
Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
|
||||
Simplex.Chat.Migrations.M20230303_group_link_role
|
||||
Simplex.Chat.Migrations.M20230304_file_description
|
||||
Simplex.Chat.Migrations.M20230317_hidden_profiles
|
||||
Simplex.Chat.Migrations.M20230318_file_description
|
||||
Simplex.Chat.Migrations.M20230321_agent_file_deleted
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.WebRTC
|
||||
Simplex.Chat.Options
|
||||
|
||||
+364
-104
@@ -59,6 +59,8 @@ import Simplex.Chat.Store
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (diffInMicros, diffInSeconds)
|
||||
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
|
||||
import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
|
||||
import Simplex.FileTransfer.Protocol (FileParty (..))
|
||||
import Simplex.Messaging.Agent as Agent
|
||||
import Simplex.Messaging.Agent.Client (AgentStatsKey (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
|
||||
@@ -71,13 +73,13 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (base64P)
|
||||
import Simplex.Messaging.Protocol (ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI)
|
||||
import Simplex.Messaging.Protocol (EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport.Client (defaultSocksProxy)
|
||||
import Simplex.Messaging.Util
|
||||
import System.Exit (exitFailure, exitSuccess)
|
||||
import System.FilePath (combine, splitExtensions, takeFileName)
|
||||
import System.FilePath (combine, splitExtensions, takeFileName, (</>))
|
||||
import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
|
||||
import Text.Read (readMaybe)
|
||||
import UnliftIO.Async
|
||||
@@ -105,7 +107,10 @@ defaultChatConfig =
|
||||
},
|
||||
tbqSize = 1024,
|
||||
fileChunkSize = 15780, -- do not change
|
||||
xftpDescrPartSize = 14000,
|
||||
inlineFiles = defaultInlineFilesConfig,
|
||||
xftpFileConfig = Nothing,
|
||||
tempDir = Nothing,
|
||||
logLevel = CLLImportant,
|
||||
subscriptionEvents = False,
|
||||
hostEvents = False,
|
||||
@@ -140,7 +145,7 @@ createChatDatabase filePrefix key confirmMigrations = runExceptT $ do
|
||||
pure ChatDatabase {chatStore, agentStore}
|
||||
|
||||
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
|
||||
newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
|
||||
newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do
|
||||
let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
|
||||
config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'}
|
||||
sendNotification = fromMaybe (const $ pure ()) sendToast
|
||||
@@ -166,12 +171,15 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
|
||||
cleanupManagerAsync <- newTVarIO Nothing
|
||||
timedItemThreads <- atomically TM.empty
|
||||
showLiveItems <- newTVarIO False
|
||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, logFilePath = logFile}
|
||||
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
|
||||
tempDirectory <- newTVarIO tempDir
|
||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
|
||||
where
|
||||
configServers :: DefaultAgentServers
|
||||
configServers =
|
||||
let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers)
|
||||
in defaultServers {smp = smp', netCfg = networkConfig}
|
||||
xftp' = fromMaybe (xftp (defaultServers :: DefaultAgentServers)) (nonEmpty xftpServers)
|
||||
in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig}
|
||||
agentServers :: ChatConfig -> IO InitialAgentServers
|
||||
agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
|
||||
users <- withTransaction chatStore getUsers
|
||||
@@ -211,9 +219,15 @@ startChatController subConns enableExpireCIs = do
|
||||
then Just <$> async (subscribeUsers users)
|
||||
else pure Nothing
|
||||
atomically . writeTVar s $ Just (a1, a2)
|
||||
startXFTP
|
||||
startCleanupManager
|
||||
when enableExpireCIs $ startExpireCIs users
|
||||
pure a1
|
||||
startXFTP = do
|
||||
tmp <- readTVarIO =<< asks tempDirectory
|
||||
runExceptT (withAgent $ \a -> xftpStartWorkers a tmp) >>= \case
|
||||
Left e -> liftIO $ print $ "Error starting XFTP workers: " <> show e
|
||||
Right _ -> pure ()
|
||||
startCleanupManager = do
|
||||
cleanupAsync <- asks cleanupManagerAsync
|
||||
readTVarIO cleanupAsync >>= \case
|
||||
@@ -381,10 +395,18 @@ processChatCommand = \case
|
||||
withAgent (`suspendAgent` t)
|
||||
ok_
|
||||
ResubscribeAllConnections -> withStore' getUsers >>= subscribeUsers >> ok_
|
||||
-- has to be called before StartChat
|
||||
SetTempFolder tf -> do
|
||||
createDirectoryIfMissing True tf
|
||||
asks tempDirectory >>= atomically . (`writeTVar` Just tf)
|
||||
ok_
|
||||
SetFilesFolder ff -> do
|
||||
createDirectoryIfMissing True ff
|
||||
asks filesFolder >>= atomically . (`writeTVar` Just ff)
|
||||
ok_
|
||||
APISetXFTPConfig cfg -> do
|
||||
asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
|
||||
ok_
|
||||
SetIncognito onOff -> do
|
||||
asks incognitoMode >>= atomically . (`writeTVar` onOff)
|
||||
ok_
|
||||
@@ -419,9 +441,9 @@ processChatCommand = \case
|
||||
if isVoice mc && not (featureAllowed SCFVoice forUser ct)
|
||||
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (chatFeatureNameText CFVoice))
|
||||
else do
|
||||
(fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
|
||||
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer ct
|
||||
timed_ <- sndContactCITimed live ct
|
||||
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_
|
||||
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_
|
||||
(msg@SndMessage {sharedMsgId}, _) <- sendDirectContactMessage ct (XMsgNew msgContainer)
|
||||
case ft_ of
|
||||
Just ft@FileTransferMeta {fileInline = Just IFMSent} ->
|
||||
@@ -435,23 +457,30 @@ processChatCommand = \case
|
||||
where
|
||||
setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
|
||||
setupSndFileTransfer ct = forM file_ $ \file -> do
|
||||
(fileSize, chSize, fileInline) <- checkSndFile mc file 1
|
||||
(agentConnId_, fileConnReq) <-
|
||||
if isJust fileInline
|
||||
then pure (Nothing, Nothing)
|
||||
else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing)
|
||||
let fileName = takeFileName file
|
||||
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
withStore' $ \db -> do
|
||||
ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize
|
||||
fileStatus <- case fileInline of
|
||||
Just IFMSent -> createSndDirectInlineFT db ct ft $> CIFSSndTransfer
|
||||
_ -> pure CIFSSndStored
|
||||
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
|
||||
pure (fileInvitation, ciFile, ft)
|
||||
(fileSize, fileMode) <- checkSndFile mc file 1
|
||||
case fileMode of
|
||||
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
|
||||
SendFileXFTP -> xftpSndFileTransfer user file fileSize 1 $ CGContact ct
|
||||
where
|
||||
smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
|
||||
smpSndFileTransfer file fileSize fileInline = do
|
||||
(agentConnId_, fileConnReq) <-
|
||||
if isJust fileInline
|
||||
then pure (Nothing, Nothing)
|
||||
else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing)
|
||||
let fileName = takeFileName file
|
||||
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
chSize <- asks $ fileChunkSize . config
|
||||
withStore' $ \db -> do
|
||||
ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize
|
||||
fileStatus <- case fileInline of
|
||||
Just IFMSent -> createSndDirectInlineFT db ct ft $> CIFSSndTransfer 0 1
|
||||
_ -> pure CIFSSndStored
|
||||
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
|
||||
pure (fileInvitation, ciFile, ft)
|
||||
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
|
||||
prepareMsg fileInvitation_ timed_ = case quotedItemId_ of
|
||||
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
prepareMsg fInv_ timed_ = case quotedItemId_ of
|
||||
Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
Just quotedItemId -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getDirectChatItem db user chatId quotedItemId
|
||||
@@ -459,7 +488,7 @@ processChatCommand = \case
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
|
||||
qmc = quoteContent origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
where
|
||||
quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote
|
||||
@@ -467,14 +496,14 @@ processChatCommand = \case
|
||||
quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
|
||||
quoteData _ = throwChatError CEInvalidQuote
|
||||
CTGroup -> do
|
||||
Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId
|
||||
g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms) <- withStore $ \db -> getGroup db user chatId
|
||||
assertUserGroupRole gInfo GRAuthor
|
||||
if isVoice mc && not (groupFeatureAllowed SGFVoice gInfo)
|
||||
then pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText GFVoice))
|
||||
else do
|
||||
(fileInvitation_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer gInfo (length $ filter memberCurrent ms)
|
||||
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
|
||||
timed_ <- sndGroupCITimed live gInfo
|
||||
(msgContainer, quotedItem_) <- prepareMsg fileInvitation_ timed_ membership
|
||||
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
|
||||
msg@SndMessage {sharedMsgId} <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
|
||||
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
|
||||
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
|
||||
@@ -483,16 +512,23 @@ processChatCommand = \case
|
||||
setActive $ ActiveG gName
|
||||
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
|
||||
where
|
||||
setupSndFileTransfer :: GroupInfo -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
|
||||
setupSndFileTransfer gInfo n = forM file_ $ \file -> do
|
||||
(fileSize, chSize, fileInline) <- checkSndFile mc file $ fromIntegral n
|
||||
let fileName = takeFileName file
|
||||
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline, fileDescr = Nothing}
|
||||
fileStatus = if fileInline == Just IFMSent then CIFSSndTransfer else CIFSSndStored
|
||||
withStore' $ \db -> do
|
||||
ft@FileTransferMeta {fileId} <- createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
|
||||
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
|
||||
pure (fileInvitation, ciFile, ft)
|
||||
setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
|
||||
setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
|
||||
(fileSize, fileMode) <- checkSndFile mc file $ fromIntegral n
|
||||
case fileMode of
|
||||
SendFileSMP fileInline -> smpSndFileTransfer file fileSize fileInline
|
||||
SendFileXFTP -> xftpSndFileTransfer user file fileSize n $ CGGroup g
|
||||
where
|
||||
smpSndFileTransfer :: FilePath -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
|
||||
smpSndFileTransfer file 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 ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus}
|
||||
pure (fileInvitation, ciFile, ft)
|
||||
sendGroupFileInline :: [GroupMember] -> SharedMsgId -> FileTransferMeta -> m ()
|
||||
sendGroupFileInline ms sharedMsgId ft@FileTransferMeta {fileInline} =
|
||||
when (fileInline == Just IFMSent) . forM_ ms $ \m ->
|
||||
@@ -504,8 +540,8 @@ processChatCommand = \case
|
||||
sendMemberFileInline m conn ft sharedMsgId
|
||||
processMember _ = pure ()
|
||||
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||
prepareMsg fileInvitation_ timed_ membership = case quotedItemId_ of
|
||||
Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
prepareMsg fInv_ timed_ membership = case quotedItemId_ of
|
||||
Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
|
||||
Just quotedItemId -> do
|
||||
CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
|
||||
withStore $ \db -> getGroupChatItem db user chatId quotedItemId
|
||||
@@ -513,7 +549,7 @@ processChatCommand = \case
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
|
||||
qmc = quoteContent origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
where
|
||||
quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
|
||||
quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
|
||||
@@ -546,6 +582,26 @@ processChatCommand = \case
|
||||
qText = msgContentText qmc
|
||||
qFileName = maybe qText (T.pack . (fileName :: CIFile d -> String)) ciFile_
|
||||
qTextOrFile = if T.null qText then qFileName else qText
|
||||
xftpSndFileTransfer :: User -> FilePath -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
|
||||
xftpSndFileTransfer user file fileSize n contactOrGroup = do
|
||||
let fileName = takeFileName file
|
||||
fileDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
|
||||
fInv = xftpFileInvitation fileName fileSize fileDescr
|
||||
fsFilePath <- toFSFilePath file
|
||||
aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) fsFilePath n
|
||||
-- TODO CRSndFileStart event for XFTP
|
||||
ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv $ AgentSndFileId aFileId
|
||||
let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored}
|
||||
case contactOrGroup of
|
||||
CGContact Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr
|
||||
CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchError` (toView . CRChatError (Just user))
|
||||
where
|
||||
-- we are not sending files to pending members, same as with inline files
|
||||
saveMemberFD m@GroupMember {activeConn = Just conn@Connection {connStatus}} =
|
||||
when ((connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn)) $
|
||||
withStore' $ \db -> createSndFTDescrXFTP db user (Just m) conn ft fileDescr
|
||||
saveMemberFD _ = pure ()
|
||||
pure (fInv, ciFile, ft)
|
||||
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)
|
||||
@@ -1484,14 +1540,21 @@ processChatCommand = \case
|
||||
contactMember Contact {contactId} =
|
||||
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
||||
cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft
|
||||
checkSndFile :: MsgContent -> FilePath -> Integer -> m (Integer, Integer, Maybe InlineFileMode)
|
||||
checkSndFile :: MsgContent -> FilePath -> Integer -> m (Integer, SendFileMode)
|
||||
checkSndFile mc f n = do
|
||||
fsFilePath <- toFSFilePath f
|
||||
unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f
|
||||
ChatConfig {fileChunkSize, inlineFiles} <- asks config
|
||||
xftpCfg <- readTVarIO =<< asks userXFTPFileConfig
|
||||
fileSize <- getFileSize fsFilePath
|
||||
let chunks = - ((- fileSize) `div` fileChunkSize)
|
||||
pure (fileSize, fileChunkSize, inlineFileMode mc inlineFiles chunks n)
|
||||
fileInline = inlineFileMode mc inlineFiles chunks n
|
||||
fileMode = case xftpCfg of
|
||||
Just cfg
|
||||
| fileInline == Just IFMSent || fileSize < minFileSize cfg -> 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
|
||||
@@ -1787,21 +1850,27 @@ callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do
|
||||
-- used during file transfer for actual operations with file system
|
||||
toFSFilePath :: ChatMonad m => FilePath -> m FilePath
|
||||
toFSFilePath f =
|
||||
maybe f (<> "/" <> f) <$> (readTVarIO =<< asks filesFolder)
|
||||
maybe f (</> f) <$> (readTVarIO =<< asks filesFolder)
|
||||
|
||||
acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe Bool -> Maybe FilePath -> m AChatItem
|
||||
acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
|
||||
acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = FileInvitation {fileName = fName, fileConnReq, fileInline, fileSize}, fileStatus, grpMemberId} rcvInline_ filePath_ = do
|
||||
unless (fileStatus == RFSNew) $ case fileStatus of
|
||||
RFSCancelled _ -> throwChatError $ CEFileCancelled fName
|
||||
_ -> throwChatError $ CEFileAlreadyReceiving fName
|
||||
case fileConnReq of
|
||||
case (xftpRcvFile, fileConnReq) of
|
||||
-- direct file protocol
|
||||
Just connReq -> do
|
||||
(Nothing, Just connReq) -> do
|
||||
connIds <- joinAgentConnectionAsync user True connReq . directMessage $ XFileAcpt fName
|
||||
filePath <- getRcvFilePath fileId filePath_ fName
|
||||
filePath <- getRcvFilePath fileId filePath_ fName True
|
||||
withStore $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath
|
||||
-- XFTP
|
||||
(Just XFTPRcvFile {rcvFileDescription}, _) -> do
|
||||
filePath <- getRcvFilePath fileId filePath_ fName False
|
||||
ci <- withStore $ \db -> xftpAcceptRcvFT db user fileId filePath
|
||||
receiveViaCompleteFD user fileId rcvFileDescription
|
||||
pure ci
|
||||
-- group & direct file protocol
|
||||
Nothing -> do
|
||||
_ -> do
|
||||
chatRef <- withStore $ \db -> getChatRefByFileId db user fileId
|
||||
case (chatRef, grpMemberId) of
|
||||
(ChatRef CTDirect contactId, Nothing) -> do
|
||||
@@ -1817,7 +1886,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F
|
||||
where
|
||||
acceptFile :: CommandFunction -> (ChatMsgEvent 'Json -> m ()) -> m AChatItem
|
||||
acceptFile cmdFunction send = do
|
||||
filePath <- getRcvFilePath fileId filePath_ fName
|
||||
filePath <- getRcvFilePath fileId filePath_ fName True
|
||||
inline <- receiveInline
|
||||
if
|
||||
| inline -> do
|
||||
@@ -1841,8 +1910,24 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F
|
||||
|| (rcvInline_ == Just True && fileSize <= fileChunkSize * offerChunks)
|
||||
)
|
||||
|
||||
getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> m FilePath
|
||||
getRcvFilePath fileId fPath_ fn = case fPath_ of
|
||||
receiveViaCompleteFD :: ChatMonad m => User -> FileTransferId -> RcvFileDescr -> m ()
|
||||
receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} =
|
||||
when fileDescrComplete $ do
|
||||
rd <- parseRcvFileDescription fileDescrText
|
||||
aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd
|
||||
startReceivingFile user fileId
|
||||
withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId)
|
||||
|
||||
startReceivingFile :: ChatMonad m => User -> FileTransferId -> m ()
|
||||
startReceivingFile user fileId = do
|
||||
ci <- withStore $ \db -> do
|
||||
liftIO $ updateRcvFileStatus db fileId FSConnected
|
||||
liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
|
||||
getChatItemByFileId db user fileId
|
||||
toView $ CRRcvFileStart user ci
|
||||
|
||||
getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> Bool -> m FilePath
|
||||
getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
|
||||
Nothing ->
|
||||
asks filesFolder >>= readTVarIO >>= \case
|
||||
Nothing -> do
|
||||
@@ -1867,9 +1952,15 @@ getRcvFilePath fileId fPath_ fn = case fPath_ of
|
||||
createEmptyFile fPath = emptyFile fPath `E.catch` (throwChatError . CEFileWrite fPath . (show :: E.SomeException -> String))
|
||||
emptyFile :: FilePath -> m FilePath
|
||||
emptyFile fPath = do
|
||||
h <- getFileHandle fileId fPath rcvFiles AppendMode
|
||||
h <-
|
||||
if keepHandle
|
||||
then getFileHandle fileId fPath rcvFiles AppendMode
|
||||
else getTmpHandle fPath
|
||||
liftIO $ B.hPut h "" >> hFlush h
|
||||
pure fPath
|
||||
getTmpHandle :: FilePath -> m Handle
|
||||
getTmpHandle fPath =
|
||||
liftIO (openFile fPath AppendMode) `E.catch` (throwChatError . CEFileInternal . (show :: E.SomeException -> String))
|
||||
uniqueCombine :: FilePath -> String -> m FilePath
|
||||
uniqueCombine filePath fileName = tryCombine (0 :: Int)
|
||||
where
|
||||
@@ -1916,18 +2007,24 @@ deleteGroupLink_ user gInfo conn = do
|
||||
deleteAgentConnectionAsync user $ aConnId conn
|
||||
withStore' $ \db -> deleteGroupLink db user gInfo
|
||||
|
||||
agentSubscriber :: ChatMonad' m => m ()
|
||||
agentSubscriber :: forall m. (MonadUnliftIO m, MonadReader ChatController m) => m ()
|
||||
agentSubscriber = do
|
||||
q <- asks $ subQ . smpAgent
|
||||
l <- asks chatLock
|
||||
forever $ do
|
||||
(corrId, connId, APC _ msg) <- atomically $ readTBQueue q
|
||||
let name = "agentSubscriber connId=" <> str connId <> " corrId=" <> str corrId <> " msg=" <> str (aCommandTag msg)
|
||||
withLock l name . void . runExceptT $
|
||||
processAgentMessage corrId connId msg `catchError` (toView . CRChatError Nothing)
|
||||
forever $ atomically (readTBQueue q) >>= void . process l
|
||||
where
|
||||
str :: StrEncoding a => a -> String
|
||||
str = B.unpack . strEncode
|
||||
process :: Lock -> (ACorrId, EntityId, APartyCmd 'Agent) -> m (Either ChatError ())
|
||||
process l (corrId, entId, APC e msg) = run $ case e of
|
||||
SAENone -> processAgentMessageNoConn msg
|
||||
SAEConn -> processAgentMessage corrId entId msg
|
||||
SAERcvFile -> processAgentMsgRcvFile corrId entId msg
|
||||
SAESndFile -> processAgentMsgSndFile corrId entId msg
|
||||
where
|
||||
run action = do
|
||||
let name = "agentSubscriber entity=" <> show e <> " entId=" <> str entId <> " msg=" <> str (aCommandTag msg)
|
||||
withLock l name $ runExceptT $ action `catchError` (toView . CRChatError Nothing)
|
||||
str :: StrEncoding a => a -> String
|
||||
str = B.unpack . strEncode
|
||||
|
||||
type AgentBatchSubscribe m = AgentClient -> [ConnId] -> ExceptT AgentErrorType m (Map ConnId (Either AgentErrorType ()))
|
||||
|
||||
@@ -2145,9 +2242,7 @@ expireChatItems user@User {userId} ttl sync = do
|
||||
membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo
|
||||
forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m
|
||||
|
||||
processAgentMessage :: forall e m. (AEntityI e, ChatMonad m) => ACorrId -> ConnId -> ACommand 'Agent e -> m ()
|
||||
processAgentMessage _ "" msg =
|
||||
processAgentMessageNoConn msg `catchError` (toView . CRChatError Nothing)
|
||||
processAgentMessage :: forall m. ChatMonad m => ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
|
||||
processAgentMessage _ connId (DEL_RCVQ srv qId err_) =
|
||||
toView $ CRAgentRcvQueueDeleted (AgentConnId connId) srv (AgentQueueId qId) err_
|
||||
processAgentMessage _ connId DEL_CONN =
|
||||
@@ -2157,7 +2252,7 @@ processAgentMessage corrId connId msg =
|
||||
Just user -> processAgentMessageConn user corrId connId msg `catchError` (toView . CRChatError (Just user))
|
||||
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
|
||||
|
||||
processAgentMessageNoConn :: forall e m. ChatMonad m => ACommand 'Agent e -> m ()
|
||||
processAgentMessageNoConn :: forall m. ChatMonad m => ACommand 'Agent 'AENone -> m ()
|
||||
processAgentMessageNoConn = \case
|
||||
CONNECT p h -> hostEvent $ CRHostConnected p h
|
||||
DISCONNECT p h -> hostEvent $ CRHostDisconnected p h
|
||||
@@ -2165,7 +2260,6 @@ processAgentMessageNoConn = \case
|
||||
UP srv conns -> serverEvent srv conns CRContactsSubscribed "connected"
|
||||
SUSPENDED -> toView CRChatSuspended
|
||||
DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId
|
||||
_ -> pure ()
|
||||
where
|
||||
hostEvent :: ChatResponse -> m ()
|
||||
hostEvent = whenM (asks $ hostEvents . config) . toView
|
||||
@@ -2174,7 +2268,110 @@ processAgentMessageNoConn = \case
|
||||
toView $ event srv cs
|
||||
showToast ("server " <> str) (safeDecodeUtf8 $ strEncode host)
|
||||
|
||||
processAgentMessageConn :: forall e m. (AEntityI e, ChatMonad m) => User -> ACorrId -> ConnId -> ACommand 'Agent e -> m ()
|
||||
processAgentMsgSndFile :: forall m. ChatMonad m => ACorrId -> SndFileId -> ACommand 'Agent 'AESndFile -> m ()
|
||||
processAgentMsgSndFile _corrId aFileId msg =
|
||||
withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case
|
||||
Just user -> process user `catchError` (toView . CRChatError (Just user))
|
||||
_ -> throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId
|
||||
where
|
||||
process :: User -> m ()
|
||||
process user = do
|
||||
fileId <- withStore $ \db -> getXFTPSndFileDBId db user $ AgentSndFileId aFileId
|
||||
case msg of
|
||||
SFPROG sndProgress sndTotal -> do
|
||||
let status = CIFSSndTransfer {sndProgress, sndTotal}
|
||||
(ci, ft) <- withStore $ \db -> do
|
||||
liftIO $ updateCIFileStatus db user fileId status
|
||||
ft <- getFileTransferMeta db user fileId
|
||||
(,ft) <$> getChatItemByFileId db user fileId
|
||||
toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal
|
||||
SFDONE _sndDescr rfds -> do
|
||||
ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <-
|
||||
withStore $ \db -> getChatItemByFileId db user fileId
|
||||
case (msgId_, itemDeleted) of
|
||||
(Just sharedMsgId, Nothing) -> do
|
||||
(ft, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId
|
||||
when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
|
||||
-- TODO either update database status or move to SFPROG
|
||||
toView $ CRSndFileProgressXFTP user ci ft 1 1
|
||||
case (rfds, sfts, d, cInfo) of
|
||||
(rfd : _, sft : _, SMDSnd, DirectChat ct) -> do
|
||||
msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
|
||||
withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
|
||||
(_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
|
||||
ms <- withStore' $ \db -> getGroupMembers db user g
|
||||
forM_ (zip rfds $ memberFTs ms) $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user))
|
||||
-- TODO update database status and send event to view CRSndFileCompleteXFTP
|
||||
pure ()
|
||||
where
|
||||
memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
|
||||
memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
|
||||
where
|
||||
mConns' = mapMaybe useMember ms
|
||||
sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
|
||||
useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
|
||||
| (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
|
||||
| otherwise = Nothing
|
||||
useMember _ = Nothing
|
||||
sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
|
||||
sendToMember (rfd, (conn, sft)) =
|
||||
void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
|
||||
_ -> pure ()
|
||||
_ -> pure () -- TODO error?
|
||||
where
|
||||
sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m Int64
|
||||
sendFileDescription sft rfd msgId sendMsg = do
|
||||
let rfdText = safeDecodeUtf8 $ strEncode rfd
|
||||
withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText
|
||||
partSize <- asks $ xftpDescrPartSize . config
|
||||
sendParts 1 partSize rfdText
|
||||
where
|
||||
sendParts partNo partSize rfdText = do
|
||||
let (part, rest) = T.splitAt partSize rfdText
|
||||
complete = T.null rest
|
||||
fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
|
||||
(_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr}
|
||||
if complete
|
||||
then pure msgDeliveryId
|
||||
else sendParts (partNo + 1) partSize rest
|
||||
|
||||
processAgentMsgRcvFile :: forall m. ChatMonad m => ACorrId -> RcvFileId -> ACommand 'Agent 'AERcvFile -> m ()
|
||||
processAgentMsgRcvFile _corrId aFileId msg =
|
||||
withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case
|
||||
Just user -> process user `catchError` (toView . CRChatError (Just user))
|
||||
_ -> throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId
|
||||
where
|
||||
process :: User -> m ()
|
||||
process user = do
|
||||
fileId <- withStore (`getXFTPRcvFileDBId` AgentRcvFileId aFileId)
|
||||
case msg of
|
||||
RFPROG rcvProgress rcvTotal -> do
|
||||
let status = CIFSRcvTransfer {rcvProgress, rcvTotal}
|
||||
ci <- withStore $ \db -> do
|
||||
liftIO $ updateCIFileStatus db user fileId status
|
||||
getChatItemByFileId db user fileId
|
||||
toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal
|
||||
RFDONE xftpPath -> do
|
||||
ft <- withStore $ \db -> getRcvFileTransfer db user fileId
|
||||
case liveRcvFileTransferPath ft of
|
||||
Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file"
|
||||
Just targetPath -> do
|
||||
fsTargetPath <- toFSFilePath targetPath
|
||||
renameFile xftpPath fsTargetPath
|
||||
ci <- withStore $ \db -> do
|
||||
liftIO $ do
|
||||
updateRcvFileStatus db fileId FSComplete
|
||||
updateCIFileStatus db user fileId CIFSRcvComplete
|
||||
getChatItemByFileId db user fileId
|
||||
agentXFTPDeleteRcvFile user aFileId fileId
|
||||
toView $ CRRcvFileComplete user ci
|
||||
RFERR _e -> do
|
||||
-- update chat item status
|
||||
-- send status to view
|
||||
agentXFTPDeleteRcvFile user aFileId fileId
|
||||
pure ()
|
||||
|
||||
processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
|
||||
processAgentMessageConn user _ agentConnId END =
|
||||
withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= \case
|
||||
RcvDirectMsgConnection _ (Just ct@Contact {localDisplayName = c}) -> do
|
||||
@@ -2265,6 +2462,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
updateChatLock "directMessage" event
|
||||
case event of
|
||||
XMsgNew mc -> newContentMessage ct mc msg msgMeta
|
||||
XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct sharedMsgId fileDescr msgMeta
|
||||
XMsgFileCancel sharedMsgId -> cancelMessageFile ct sharedMsgId msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgDel sharedMsgId _ -> messageDelete ct sharedMsgId msg msgMeta
|
||||
-- TODO discontinue XFile
|
||||
@@ -2480,6 +2679,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
updateChatLock "groupMessage" event
|
||||
case event of
|
||||
XMsgNew mc -> canSend $ newGroupContentMessage gInfo m mc msg msgMeta
|
||||
XMsgFileDescr sharedMsgId fileDescr -> canSend $ groupMessageFileDescription gInfo m sharedMsgId fileDescr msgMeta
|
||||
XMsgFileCancel sharedMsgId -> cancelGroupMessageFile gInfo m sharedMsgId msgMeta
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> canSend $ groupMessageUpdate gInfo m sharedMsgId mContent msg msgMeta ttl live
|
||||
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m sharedMsgId memberId msg
|
||||
-- TODO discontinue XFile
|
||||
@@ -2541,7 +2742,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
CON -> do
|
||||
ci <- withStore $ \db -> do
|
||||
liftIO $ updateSndFileStatus db ft FSConnected
|
||||
updateDirectCIFileStatus db user fileId CIFSSndTransfer
|
||||
updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1
|
||||
toView $ CRSndFileStart user ci ft
|
||||
sendFileChunk user ft
|
||||
SENT msgId -> do
|
||||
@@ -2598,7 +2799,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
case chatMsgEvent of
|
||||
XOk -> allowAgentConnectionAsync user conn confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
_ -> pure ()
|
||||
CON -> startReceivingFile ft
|
||||
CON -> startReceivingFile user fileId
|
||||
MSG meta _ msgBody -> do
|
||||
parseFileChunk msgBody >>= receiveFileChunk ft (Just conn) meta
|
||||
OK ->
|
||||
@@ -2613,14 +2814,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- TODO add debugging output
|
||||
_ -> pure ()
|
||||
|
||||
startReceivingFile :: RcvFileTransfer -> m ()
|
||||
startReceivingFile ft@RcvFileTransfer {fileId} = do
|
||||
ci <- withStore $ \db -> do
|
||||
liftIO $ updateRcvFileStatus db ft FSConnected
|
||||
liftIO $ updateCIFileStatus db user fileId CIFSRcvTransfer
|
||||
getChatItemByFileId db user fileId
|
||||
toView $ CRRcvFileStart user ci
|
||||
|
||||
receiveFileChunk :: RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> m ()
|
||||
receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize, cancelled} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case
|
||||
FileChunkCancel ->
|
||||
@@ -2645,7 +2838,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
appendFileChunk ft chunkNo chunk
|
||||
ci <- withStore $ \db -> do
|
||||
liftIO $ do
|
||||
updateRcvFileStatus db ft FSComplete
|
||||
updateRcvFileStatus db fileId FSComplete
|
||||
updateCIFileStatus db user fileId CIFSRcvComplete
|
||||
deleteRcvFileChunks db ft
|
||||
getChatItemByFileId db user fileId
|
||||
@@ -2720,7 +2913,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
where
|
||||
s = " " <> name <> "=" <> B.unpack (strEncode $ toCMEventTag event)
|
||||
|
||||
withCompletedCommand :: Connection -> ACommand 'Agent e -> (CommandData -> m ()) -> m ()
|
||||
withCompletedCommand :: forall e. AEntityI e => Connection -> ACommand 'Agent e -> (CommandData -> m ()) -> m ()
|
||||
withCompletedCommand Connection {connId} agentMsg action = do
|
||||
let agentMsgTag = APCT (sAEntity @e) $ aCommandTag agentMsg
|
||||
cmdData_ <- withStore' $ \db -> getCommandDataByCorrId db user corrId
|
||||
@@ -2813,7 +3006,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
newContentMessage ct@Contact {localDisplayName = c, contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
let ExtMsgContent content fileInvitation_ _ _ = mcExtMsgContent mc
|
||||
let ExtMsgContent content fInv_ _ _ = mcExtMsgContent mc
|
||||
if isVoice content && not (featureAllowed SCFVoice forContact ct)
|
||||
then do
|
||||
void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False
|
||||
@@ -2822,7 +3015,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc
|
||||
timed_ = rcvContactCITimed ct itemTTL
|
||||
live = fromMaybe False live_
|
||||
ciFile_ <- processFileInvitation fileInvitation_ content $ \db -> createRcvFileTransfer db userId ct
|
||||
ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct
|
||||
ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live
|
||||
whenContactNtfs user ct $ do
|
||||
showMsgToast (c <> "> ") content formattedText
|
||||
@@ -2833,14 +3026,46 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
|
||||
pure ci
|
||||
|
||||
processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
|
||||
messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
|
||||
messageFileDescription ct@Contact {contactId} sharedMsgId fileDescr msgMeta = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId
|
||||
processFDMessage fileId fileDescr
|
||||
|
||||
groupMessageFileDescription :: GroupInfo -> GroupMember -> SharedMsgId -> FileDescr -> MsgMeta -> m ()
|
||||
groupMessageFileDescription GroupInfo {groupId} _m sharedMsgId fileDescr _msgMeta = do
|
||||
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
|
||||
processFDMessage fileId fileDescr
|
||||
|
||||
processFDMessage :: FileTransferId -> FileDescr -> m ()
|
||||
processFDMessage fileId fileDescr = do
|
||||
(rfd, RcvFileTransfer {fileStatus}) <- withStore $ \db -> do
|
||||
rfd <- appendRcvFD db userId fileId fileDescr
|
||||
ft <- getRcvFileTransfer db user fileId
|
||||
pure (rfd, ft)
|
||||
case fileStatus of
|
||||
RFSAccepted _ -> receiveViaCompleteFD user fileId rfd
|
||||
_ -> pure ()
|
||||
|
||||
cancelMessageFile :: Contact -> SharedMsgId -> MsgMeta -> m ()
|
||||
cancelMessageFile ct _sharedMsgId msgMeta = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
-- find the original chat item and file
|
||||
-- mark file as cancelled, remove description if exists
|
||||
pure ()
|
||||
|
||||
cancelGroupMessageFile :: GroupInfo -> GroupMember -> SharedMsgId -> MsgMeta -> m ()
|
||||
cancelGroupMessageFile _gInfo _m _sharedMsgId _msgMeta = do
|
||||
pure ()
|
||||
|
||||
processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv))
|
||||
processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
|
||||
chSize <- asks $ fileChunkSize . config
|
||||
inline <- receiveInlineMode fInv (Just mc) chSize
|
||||
ft@RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFT db fInv inline chSize
|
||||
ChatConfig {fileChunkSize} <- asks config
|
||||
inline <- receiveInlineMode fInv (Just mc) fileChunkSize
|
||||
ft@RcvFileTransfer {fileId} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize
|
||||
(filePath, fileStatus) <- case inline of
|
||||
Just IFMSent -> do
|
||||
fPath <- getRcvFilePath fileId Nothing fileName
|
||||
fPath <- getRcvFilePath fileId Nothing fileName True
|
||||
withStore' $ \db -> startRcvInlineFT db user ft fPath inline
|
||||
pure (Just fPath, CIFSRcvAccepted)
|
||||
_ -> pure (Nothing, CIFSRcvInvitation)
|
||||
@@ -2970,9 +3195,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||
processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
chSize <- asks $ fileChunkSize . config
|
||||
inline <- receiveInlineMode fInv Nothing chSize
|
||||
RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline chSize
|
||||
ChatConfig {fileChunkSize} <- asks config
|
||||
inline <- receiveInlineMode fInv Nothing fileChunkSize
|
||||
RcvFileTransfer {fileId} <- withStore $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize
|
||||
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
|
||||
ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
|
||||
@@ -2983,9 +3208,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- TODO remove once XFile is discontinued
|
||||
processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||
processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
|
||||
chSize <- asks $ fileChunkSize . config
|
||||
inline <- receiveInlineMode fInv Nothing chSize
|
||||
RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline chSize
|
||||
ChatConfig {fileChunkSize} <- asks config
|
||||
inline <- receiveInlineMode fInv Nothing fileChunkSize
|
||||
RcvFileTransfer {fileId} <- withStore $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize
|
||||
let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation}
|
||||
ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False
|
||||
groupMsgToView gInfo m ci msgMeta
|
||||
@@ -2995,8 +3220,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
setActive $ ActiveG g
|
||||
|
||||
receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> m (Maybe InlineFileMode)
|
||||
receiveInlineMode FileInvitation {fileSize, fileInline} mc_ chSize = case fileInline of
|
||||
Just mode -> do
|
||||
receiveInlineMode FileInvitation {fileSize, fileInline, fileDescr} mc_ chSize = case (fileInline, fileDescr) of
|
||||
(Just mode, Nothing) -> do
|
||||
InlineFilesConfig {receiveChunks, receiveInstant} <- asks $ inlineFiles . config
|
||||
pure $ if fileSize <= receiveChunks * chSize then inline' receiveInstant else Nothing
|
||||
where
|
||||
@@ -3027,7 +3252,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
-- receiving inline
|
||||
_ -> do
|
||||
event <- withStore $ \db -> do
|
||||
ci <- updateDirectCIFileStatus db user fileId CIFSSndTransfer
|
||||
ci <- updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1
|
||||
sft <- liftIO $ createSndDirectInlineFT db ct ft
|
||||
pure $ CRSndFileStart user ci sft
|
||||
toView event
|
||||
@@ -3039,7 +3264,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
|
||||
checkSndInlineFTComplete :: Connection -> AgentMsgId -> m ()
|
||||
checkSndInlineFTComplete conn agentMsgId = do
|
||||
ft_ <- withStore' $ \db -> getSndInlineFTViaMsgDelivery db user conn agentMsgId
|
||||
ft_ <- withStore' $ \db -> getSndFTViaMsgDelivery db user conn agentMsgId
|
||||
forM_ ft_ $ \ft@SndFileTransfer {fileId} -> do
|
||||
ci <- withStore $ \db -> do
|
||||
liftIO $ updateSndFileStatus db ft FSComplete
|
||||
@@ -3068,9 +3293,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _
|
||||
| chunkNo == 1 = throwChatError $ CEInlineFileProhibited fileId
|
||||
| otherwise = pure ()
|
||||
receiveInlineChunk ft chunk meta = do
|
||||
receiveInlineChunk ft@RcvFileTransfer {fileId} chunk meta = do
|
||||
case chunk of
|
||||
FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile ft
|
||||
FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile user fileId
|
||||
_ -> pure ()
|
||||
receiveFileChunk ft Nothing meta chunk
|
||||
|
||||
@@ -3106,7 +3331,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
(_, Just conn) -> do
|
||||
-- receiving inline
|
||||
event <- withStore $ \db -> do
|
||||
ci <- updateDirectCIFileStatus db user fileId CIFSSndTransfer
|
||||
ci <- updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1
|
||||
sft <- liftIO $ createSndGroupInlineFT db m conn ft
|
||||
pure $ CRSndFileStart user ci sft
|
||||
toView event
|
||||
@@ -3501,6 +3726,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
groupMsgToView g' m ci msgMeta
|
||||
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
|
||||
|
||||
parseRcvFileDescription :: ChatMonad m => Text -> m (ValidFileDescription 'FRecipient)
|
||||
parseRcvFileDescription =
|
||||
liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8)
|
||||
|
||||
sendDirectFileInline :: ChatMonad m => Contact -> FileTransferMeta -> SharedMsgId -> m ()
|
||||
sendDirectFileInline ct ft sharedMsgId = do
|
||||
msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage ct
|
||||
@@ -3603,23 +3832,35 @@ isFileActive fileId files = do
|
||||
isJust . M.lookup fileId <$> readTVarIO fs
|
||||
|
||||
cancelRcvFileTransfer :: ChatMonad m => User -> RcvFileTransfer -> m (Maybe ConnId)
|
||||
cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, rcvFileInline} =
|
||||
cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, xftpRcvFile, rcvFileInline} =
|
||||
cancel' `catchError` (\e -> toView (CRChatError (Just user) e) $> fileConnId)
|
||||
where
|
||||
cancel' = do
|
||||
closeFileHandle fileId rcvFiles
|
||||
withStore' $ \db -> do
|
||||
updateFileCancelled db user fileId CIFSRcvCancelled
|
||||
updateRcvFileStatus db ft FSCancelled
|
||||
updateRcvFileStatus db fileId FSCancelled
|
||||
deleteRcvFileChunks db ft
|
||||
case xftpRcvFile of
|
||||
Just XFTPRcvFile {agentRcvFileId = Just (AgentRcvFileId aFileId), agentRcvFileDeleted} ->
|
||||
unless agentRcvFileDeleted $ agentXFTPDeleteRcvFile user aFileId fileId
|
||||
_ -> pure ()
|
||||
pure fileConnId
|
||||
fileConnId = if isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing
|
||||
fileConnId = if isNothing xftpRcvFile && isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing
|
||||
|
||||
cancelSndFile :: ChatMonad m => User -> FileTransferMeta -> [SndFileTransfer] -> Bool -> m [ConnId]
|
||||
cancelSndFile user FileTransferMeta {fileId} fts sendCancel = do
|
||||
cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do
|
||||
withStore' (\db -> updateFileCancelled db user fileId CIFSSndCancelled)
|
||||
`catchError` (toView . CRChatError (Just user))
|
||||
catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel)
|
||||
case xftpSndFile of
|
||||
Nothing ->
|
||||
catMaybes <$> forM fts (\ft -> cancelSndFileTransfer user ft sendCancel)
|
||||
Just _patternAgentSndFileId -> do
|
||||
forM_ fts (\ft -> cancelSndFileTransfer user ft False)
|
||||
-- TODO unless agentSndFileDeleted, do agentXFTPDeleteSndFile:
|
||||
-- TODO - with agent xftpDeleteSndFile
|
||||
-- TODO - with store setSndFTAgentDeleted
|
||||
pure []
|
||||
|
||||
cancelSndFileTransfer :: ChatMonad m => User -> SndFileTransfer -> Bool -> m (Maybe ConnId)
|
||||
cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel =
|
||||
@@ -3637,7 +3878,7 @@ cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, age
|
||||
void . sendDirectMessage conn (BFileChunk sharedMsgId FileChunkCancel) $ ConnectionId connId
|
||||
_ -> withAgent $ \a -> void . sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel
|
||||
pure fileConnId
|
||||
fileConnId = if isJust fileInline then Nothing else Just acId
|
||||
fileConnId = if isNothing fileInline then Just acId else Nothing
|
||||
|
||||
closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m ()
|
||||
closeFileHandle fileId files = do
|
||||
@@ -3845,6 +4086,11 @@ deleteAgentConnectionsAsync _ [] = pure ()
|
||||
deleteAgentConnectionsAsync user acIds =
|
||||
withAgent (`deleteConnectionsAsync` acIds) `catchError` (toView . CRChatError (Just user))
|
||||
|
||||
agentXFTPDeleteRcvFile :: ChatMonad m => User -> RcvFileId -> FileTransferId -> m ()
|
||||
agentXFTPDeleteRcvFile user aFileId fileId = do
|
||||
withAgent $ \a -> xftpDeleteRcvFile a (aUserId user) aFileId
|
||||
withStore' $ \db -> setRcvFTAgentDeleted db fileId
|
||||
|
||||
userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Profile
|
||||
userProfileToSend user@User {profile = p} incognitoProfile ct =
|
||||
let p' = fromMaybe (fromLocalProfile p) incognitoProfile
|
||||
@@ -4080,7 +4326,10 @@ chatCommandP =
|
||||
"/_app activate" $> APIActivateChat,
|
||||
"/_app suspend " *> (APISuspendChat <$> A.decimal),
|
||||
"/_resubscribe all" $> ResubscribeAllConnections,
|
||||
"/_temp_folder " *> (SetTempFolder <$> filePath),
|
||||
("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath),
|
||||
"/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
|
||||
"/xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
|
||||
"/_db export " *> (APIExportArchive <$> jsonP),
|
||||
"/db export" $> ExportArchive,
|
||||
"/_db import " *> (APIImportArchive <$> jsonP),
|
||||
@@ -4343,6 +4592,17 @@ chatCommandP =
|
||||
logErrors <- " log=" *> onOffP <|> pure False
|
||||
let tcpTimeout = 1000000 * fromMaybe (maybe 5 (const 10) socksProxy) t_
|
||||
pure $ fullNetworkConfig socksProxy tcpTimeout logErrors
|
||||
xftpCfgP = do
|
||||
minFileSize <- "minFileSize=" *> fileSizeP
|
||||
pure $ XFTPFileConfig {minFileSize}
|
||||
-- TODO move to Utils in simplexmq
|
||||
fileSizeP =
|
||||
A.choice
|
||||
[ gb <$> A.decimal <* "gb",
|
||||
mb <$> A.decimal <* "mb",
|
||||
kb <$> A.decimal <* "kb",
|
||||
A.decimal
|
||||
]
|
||||
dbKeyP = nonEmptyKey <$?> strP
|
||||
nonEmptyKey k@(DBEncryptionKey s) = if null s then Left "empty key" else Right k
|
||||
autoAcceptP =
|
||||
|
||||
@@ -65,7 +65,7 @@ importArchive cfg@ArchiveConfig {archivePath} =
|
||||
backup f = whenM (doesFileExist f) $ copyFile f $ f <> ".bak"
|
||||
|
||||
withTempDir :: ChatMonad m => ArchiveConfig -> (String -> (FilePath -> m ()) -> m ())
|
||||
withTempDir cfg = case parentTempDirectory cfg of
|
||||
withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
|
||||
Just tmpDir -> withTempDirectory tmpDir
|
||||
_ -> withSystemTempDirectory
|
||||
|
||||
|
||||
@@ -105,7 +105,10 @@ data ChatConfig = ChatConfig
|
||||
defaultServers :: DefaultAgentServers,
|
||||
tbqSize :: Natural,
|
||||
fileChunkSize :: Integer,
|
||||
xftpDescrPartSize :: Int,
|
||||
inlineFiles :: InlineFilesConfig,
|
||||
xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled
|
||||
tempDir :: Maybe FilePath,
|
||||
subscriptionEvents :: Bool,
|
||||
hostEvents :: Bool,
|
||||
logLevel :: ChatLogLevel,
|
||||
@@ -168,6 +171,8 @@ data ChatController = ChatController
|
||||
cleanupManagerAsync :: TVar (Maybe (Async ())),
|
||||
timedItemThreads :: TMap (ChatRef, ChatItemId) (TVar (Maybe (Weak ThreadId))),
|
||||
showLiveItems :: TVar Bool,
|
||||
userXFTPFileConfig :: TVar (Maybe XFTPFileConfig),
|
||||
tempDirectory :: TVar (Maybe FilePath),
|
||||
logFilePath :: Maybe FilePath
|
||||
}
|
||||
|
||||
@@ -199,7 +204,9 @@ data ChatCommand
|
||||
| APIActivateChat
|
||||
| APISuspendChat {suspendTimeout :: Int}
|
||||
| ResubscribeAllConnections
|
||||
| SetTempFolder FilePath
|
||||
| SetFilesFolder FilePath
|
||||
| APISetXFTPConfig (Maybe XFTPFileConfig)
|
||||
| SetIncognito Bool
|
||||
| APIExportArchive ArchiveConfig
|
||||
| ExportArchive
|
||||
@@ -431,9 +438,12 @@ data ChatResponse
|
||||
| CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
|
||||
| CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
|
||||
| CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo}
|
||||
| CRRcvFileDescrReady {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileAccepted {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileDescrNotReady {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileStart {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileProgressXFTP {user :: User, chatItem :: AChatItem, receivedSize :: Int64, totalSize :: Int64}
|
||||
| CRRcvFileComplete {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
@@ -442,6 +452,10 @@ data ChatResponse
|
||||
| CRSndFileCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileRcvCancelled {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndGroupFileCancelled {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
|
||||
| CRSndFileStartXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRSndFileProgressXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sentSize :: Int64, totalSize :: Int64}
|
||||
| CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRSndFileCancelledXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
|
||||
| CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile}
|
||||
| CRContactAliasUpdated {user :: User, toContact :: Contact}
|
||||
| CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection}
|
||||
@@ -628,6 +642,18 @@ instance ToJSON ComposedMessage where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
data XFTPFileConfig = XFTPFileConfig
|
||||
{ minFileSize :: Integer
|
||||
}
|
||||
deriving (Show, Generic, FromJSON)
|
||||
|
||||
defaultXFTPFileConfig :: XFTPFileConfig
|
||||
defaultXFTPFileConfig = XFTPFileConfig {minFileSize = 0}
|
||||
|
||||
instance ToJSON XFTPFileConfig where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
data NtfMsgInfo = NtfMsgInfo {msgTs :: UTCTime, msgFlags :: MsgFlags}
|
||||
deriving (Show, Generic)
|
||||
|
||||
@@ -688,6 +714,11 @@ data CoreVersionInfo = CoreVersionInfo
|
||||
|
||||
instance ToJSON CoreVersionInfo where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data SendFileMode
|
||||
= SendFileSMP (Maybe InlineFileMode)
|
||||
| SendFileXFTP
|
||||
deriving (Show, Generic)
|
||||
|
||||
data ChatError
|
||||
= ChatError {errorType :: ChatErrorType}
|
||||
| ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity}
|
||||
@@ -702,6 +733,8 @@ instance ToJSON ChatError where
|
||||
data ChatErrorType
|
||||
= CENoActiveUser
|
||||
| CENoConnectionUser {agentConnId :: AgentConnId}
|
||||
| CENoSndFileUser {agentSndFileId :: AgentSndFileId}
|
||||
| CENoRcvFileUser {agentRcvFileId :: AgentRcvFileId}
|
||||
| CEUserUnknown
|
||||
| CEActiveUserExists -- TODO delete
|
||||
| CEUserExists {contactName :: ContactName}
|
||||
@@ -760,6 +793,7 @@ data ChatErrorType
|
||||
| CEAgentNoSubResult {agentConnId :: AgentConnId}
|
||||
| CECommandError {message :: String}
|
||||
| CEAgentCommandError {message :: String}
|
||||
| CEInvalidFileDescription {message :: String}
|
||||
| CEInternalError {message :: String}
|
||||
deriving (Show, Exception, Generic)
|
||||
|
||||
|
||||
@@ -13,6 +13,7 @@
|
||||
|
||||
module Simplex.Chat.Messages where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
@@ -418,12 +419,12 @@ instance MsgDirectionI d => ToJSON (CIFile d) where
|
||||
|
||||
data CIFileStatus (d :: MsgDirection) where
|
||||
CIFSSndStored :: CIFileStatus 'MDSnd
|
||||
CIFSSndTransfer :: CIFileStatus 'MDSnd
|
||||
CIFSSndTransfer :: {sndProgress :: Int64, sndTotal :: Int64} -> CIFileStatus 'MDSnd
|
||||
CIFSSndCancelled :: CIFileStatus 'MDSnd
|
||||
CIFSSndComplete :: CIFileStatus 'MDSnd
|
||||
CIFSRcvInvitation :: CIFileStatus 'MDRcv
|
||||
CIFSRcvAccepted :: CIFileStatus 'MDRcv
|
||||
CIFSRcvTransfer :: CIFileStatus 'MDRcv
|
||||
CIFSRcvTransfer :: {rcvProgress :: Int64, rcvTotal :: Int64} -> CIFileStatus 'MDRcv
|
||||
CIFSRcvComplete :: CIFileStatus 'MDRcv
|
||||
CIFSRcvCancelled :: CIFileStatus 'MDRcv
|
||||
|
||||
@@ -434,18 +435,18 @@ deriving instance Show (CIFileStatus d)
|
||||
ciFileEnded :: CIFileStatus d -> Bool
|
||||
ciFileEnded = \case
|
||||
CIFSSndStored -> False
|
||||
CIFSSndTransfer -> False
|
||||
CIFSSndTransfer {} -> False
|
||||
CIFSSndCancelled -> True
|
||||
CIFSSndComplete -> True
|
||||
CIFSRcvInvitation -> False
|
||||
CIFSRcvAccepted -> False
|
||||
CIFSRcvTransfer -> False
|
||||
CIFSRcvTransfer {} -> False
|
||||
CIFSRcvCancelled -> True
|
||||
CIFSRcvComplete -> True
|
||||
|
||||
instance MsgDirectionI d => ToJSON (CIFileStatus d) where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
instance ToJSON (CIFileStatus d) where
|
||||
toJSON = J.toJSON . jsonCIFileStatus
|
||||
toEncoding = J.toEncoding . jsonCIFileStatus
|
||||
|
||||
instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode
|
||||
|
||||
@@ -458,12 +459,12 @@ deriving instance Show ACIFileStatus
|
||||
instance MsgDirectionI d => StrEncoding (CIFileStatus d) where
|
||||
strEncode = \case
|
||||
CIFSSndStored -> "snd_stored"
|
||||
CIFSSndTransfer -> "snd_transfer"
|
||||
CIFSSndTransfer sent total -> strEncode (Str "snd_transfer", sent, total)
|
||||
CIFSSndCancelled -> "snd_cancelled"
|
||||
CIFSSndComplete -> "snd_complete"
|
||||
CIFSRcvInvitation -> "rcv_invitation"
|
||||
CIFSRcvAccepted -> "rcv_accepted"
|
||||
CIFSRcvTransfer -> "rcv_transfer"
|
||||
CIFSRcvTransfer rcvd total -> strEncode (Str "rcv_transfer", rcvd, total)
|
||||
CIFSRcvComplete -> "rcv_complete"
|
||||
CIFSRcvCancelled -> "rcv_cancelled"
|
||||
strP = (\(AFS _ st) -> checkDirection st) <$?> strP
|
||||
@@ -473,15 +474,59 @@ instance StrEncoding ACIFileStatus where
|
||||
strP =
|
||||
A.takeTill (== ' ') >>= \case
|
||||
"snd_stored" -> pure $ AFS SMDSnd CIFSSndStored
|
||||
"snd_transfer" -> pure $ AFS SMDSnd CIFSSndTransfer
|
||||
"snd_transfer" -> AFS SMDSnd <$> progress CIFSSndTransfer
|
||||
"snd_cancelled" -> pure $ AFS SMDSnd CIFSSndCancelled
|
||||
"snd_complete" -> pure $ AFS SMDSnd CIFSSndComplete
|
||||
"rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation
|
||||
"rcv_accepted" -> pure $ AFS SMDRcv CIFSRcvAccepted
|
||||
"rcv_transfer" -> pure $ AFS SMDRcv CIFSRcvTransfer
|
||||
"rcv_transfer" -> AFS SMDRcv <$> progress CIFSRcvTransfer
|
||||
"rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete
|
||||
"rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled
|
||||
_ -> fail "bad file status"
|
||||
where
|
||||
progress :: (Int64 -> Int64 -> a) -> A.Parser a
|
||||
progress f = f <$> num <*> num <|> pure (f 0 1)
|
||||
num = A.space *> A.decimal
|
||||
|
||||
data JSONCIFileStatus
|
||||
= JCIFSSndStored
|
||||
| JCIFSSndTransfer {sndProgress :: Int64, sndTotal :: Int64}
|
||||
| JCIFSSndCancelled
|
||||
| JCIFSSndComplete
|
||||
| JCIFSRcvInvitation
|
||||
| JCIFSRcvAccepted
|
||||
| JCIFSRcvTransfer {rcvProgress :: Int64, rcvTotal :: Int64}
|
||||
| JCIFSRcvComplete
|
||||
| JCIFSRcvCancelled
|
||||
deriving (Generic)
|
||||
|
||||
instance ToJSON JSONCIFileStatus where
|
||||
toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCIFS"
|
||||
toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCIFS"
|
||||
|
||||
jsonCIFileStatus :: CIFileStatus d -> JSONCIFileStatus
|
||||
jsonCIFileStatus = \case
|
||||
CIFSSndStored -> JCIFSSndStored
|
||||
CIFSSndTransfer sent total -> JCIFSSndTransfer sent total
|
||||
CIFSSndCancelled -> JCIFSSndCancelled
|
||||
CIFSSndComplete -> JCIFSSndComplete
|
||||
CIFSRcvInvitation -> JCIFSRcvInvitation
|
||||
CIFSRcvAccepted -> JCIFSRcvAccepted
|
||||
CIFSRcvTransfer rcvd total -> JCIFSRcvTransfer rcvd total
|
||||
CIFSRcvComplete -> JCIFSRcvComplete
|
||||
CIFSRcvCancelled -> JCIFSRcvCancelled
|
||||
|
||||
aciFileStatusJSON :: JSONCIFileStatus -> ACIFileStatus
|
||||
aciFileStatusJSON = \case
|
||||
JCIFSSndStored -> AFS SMDSnd CIFSSndStored
|
||||
JCIFSSndTransfer sent total -> AFS SMDSnd $ CIFSSndTransfer sent total
|
||||
JCIFSSndCancelled -> AFS SMDSnd CIFSSndCancelled
|
||||
JCIFSSndComplete -> AFS SMDSnd CIFSSndComplete
|
||||
JCIFSRcvInvitation -> AFS SMDRcv CIFSRcvInvitation
|
||||
JCIFSRcvAccepted -> AFS SMDRcv CIFSRcvAccepted
|
||||
JCIFSRcvTransfer rcvd total -> AFS SMDRcv $ CIFSRcvTransfer rcvd total
|
||||
JCIFSRcvComplete -> AFS SMDRcv CIFSRcvComplete
|
||||
JCIFSRcvCancelled -> AFS SMDRcv CIFSRcvCancelled
|
||||
|
||||
-- to conveniently read file data from db
|
||||
data CIFileInfo = CIFileInfo
|
||||
|
||||
@@ -1,29 +0,0 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230304_file_description where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
-- this table includes file descriptions for the recipients for both sent and received files
|
||||
-- in the latter case the user is the recipient
|
||||
|
||||
m20230304_file_description :: Query
|
||||
m20230304_file_description =
|
||||
[sql|
|
||||
CREATE TABLE recipient_file_descriptions (
|
||||
file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
file_descr_size INTEGER NOT NULL,
|
||||
file_descr_status TEXT NOT NULL,
|
||||
file_descr_text TEXT NOT NULL
|
||||
);
|
||||
|
||||
ALTER TABLE rcv_files ADD COLUMN file_descr_id INTEGER NULL
|
||||
REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
|
||||
|
||||
ALTER TABLE snd_files ADD COLUMN file_descr_id INTEGER NULL
|
||||
REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
|
||||
|
||||
-- this is a private file description allowing to delete the file from the server
|
||||
ALTER TABLE files ADD COLUMN snd_file_descr_text TEXT NULL;
|
||||
|]
|
||||
@@ -0,0 +1,56 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230318_file_description where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
-- this table includes file descriptions for the recipients for both sent and received files
|
||||
-- in the latter case the user is the recipient
|
||||
|
||||
m20230318_file_description :: Query
|
||||
m20230318_file_description =
|
||||
[sql|
|
||||
CREATE TABLE xftp_file_descriptions (
|
||||
file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
|
||||
file_descr_text TEXT NOT NULL,
|
||||
file_descr_part_no INTEGER NOT NULL DEFAULT(0),
|
||||
file_descr_complete INTEGER NOT NULL DEFAULT(0),
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
|
||||
ALTER TABLE files ADD COLUMN agent_snd_file_id BLOB NULL;
|
||||
|
||||
ALTER TABLE files ADD COLUMN private_snd_file_descr TEXT NULL;
|
||||
|
||||
ALTER TABLE snd_files ADD COLUMN file_descr_id INTEGER NULL
|
||||
REFERENCES xftp_file_descriptions ON DELETE SET NULL;
|
||||
|
||||
CREATE INDEX idx_snd_files_file_descr_id ON snd_files(file_descr_id);
|
||||
|
||||
ALTER TABLE rcv_files ADD COLUMN file_descr_id INTEGER NULL
|
||||
REFERENCES xftp_file_descriptions ON DELETE SET NULL;
|
||||
|
||||
CREATE INDEX idx_rcv_files_file_descr_id ON rcv_files(file_descr_id);
|
||||
|
||||
ALTER TABLE rcv_files ADD COLUMN agent_rcv_file_id BLOB NULL;
|
||||
|]
|
||||
|
||||
down_m20230318_file_description :: Query
|
||||
down_m20230318_file_description =
|
||||
[sql|
|
||||
ALTER TABLE rcv_files DROP COLUMN agent_rcv_file_id;
|
||||
|
||||
DROP INDEX idx_rcv_files_file_descr_id;
|
||||
ALTER TABLE rcv_files DROP COLUMN file_descr_id;
|
||||
|
||||
DROP INDEX idx_snd_files_file_descr_id;
|
||||
ALTER TABLE snd_files DROP COLUMN file_descr_id;
|
||||
|
||||
ALTER TABLE files DROP COLUMN private_snd_file_descr;
|
||||
ALTER TABLE files DROP COLUMN agent_snd_file_id;
|
||||
|
||||
DROP TABLE xftp_file_descriptions;
|
||||
|]
|
||||
@@ -0,0 +1,28 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230321_agent_file_deleted where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20230321_agent_file_deleted :: Query
|
||||
m20230321_agent_file_deleted =
|
||||
[sql|
|
||||
PRAGMA ignore_check_constraints=ON;
|
||||
|
||||
ALTER TABLE files ADD COLUMN agent_snd_file_deleted INTEGER DEFAULT 0 CHECK (agent_snd_file_deleted NOT NULL);
|
||||
UPDATE files SET agent_snd_file_deleted = 0;
|
||||
|
||||
ALTER TABLE rcv_files ADD COLUMN agent_rcv_file_deleted INTEGER DEFAULT 0 CHECK (agent_rcv_file_deleted NOT NULL);
|
||||
UPDATE rcv_files SET agent_rcv_file_deleted = 0;
|
||||
|
||||
PRAGMA ignore_check_constraints=OFF;
|
||||
|]
|
||||
|
||||
down_m20230321_agent_file_deleted :: Query
|
||||
down_m20230321_agent_file_deleted =
|
||||
[sql|
|
||||
ALTER TABLE rcv_files DROP COLUMN agent_rcv_file_deleted;
|
||||
|
||||
ALTER TABLE files DROP COLUMN agent_snd_file_deleted;
|
||||
|]
|
||||
@@ -197,7 +197,10 @@ CREATE TABLE files(
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
cancelled INTEGER,
|
||||
ci_file_status TEXT,
|
||||
file_inline TEXT
|
||||
file_inline TEXT,
|
||||
agent_snd_file_id BLOB NULL,
|
||||
private_snd_file_descr TEXT NULL,
|
||||
agent_snd_file_deleted INTEGER DEFAULT 0 CHECK(agent_snd_file_deleted NOT NULL)
|
||||
);
|
||||
CREATE TABLE snd_files(
|
||||
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
|
||||
@@ -208,6 +211,8 @@ CREATE TABLE snd_files(
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
file_inline TEXT,
|
||||
last_inline_msg_delivery_id INTEGER,
|
||||
file_descr_id INTEGER NULL
|
||||
REFERENCES xftp_file_descriptions ON DELETE SET NULL,
|
||||
PRIMARY KEY(file_id, connection_id)
|
||||
) WITHOUT ROWID;
|
||||
CREATE TABLE rcv_files(
|
||||
@@ -219,7 +224,11 @@ CREATE TABLE rcv_files(
|
||||
created_at TEXT CHECK(created_at NOT NULL),
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
rcv_file_inline TEXT,
|
||||
file_inline TEXT
|
||||
file_inline TEXT,
|
||||
file_descr_id INTEGER NULL
|
||||
REFERENCES xftp_file_descriptions ON DELETE SET NULL,
|
||||
agent_rcv_file_id BLOB NULL,
|
||||
agent_rcv_file_deleted INTEGER DEFAULT 0 CHECK(agent_rcv_file_deleted NOT NULL)
|
||||
);
|
||||
CREATE TABLE snd_file_chunks(
|
||||
file_id INTEGER NOT NULL,
|
||||
@@ -555,3 +564,14 @@ CREATE INDEX idx_smp_servers_user_id ON smp_servers(user_id);
|
||||
CREATE INDEX idx_chat_items_item_deleted_by_group_member_id ON chat_items(
|
||||
item_deleted_by_group_member_id
|
||||
);
|
||||
CREATE TABLE xftp_file_descriptions(
|
||||
file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
|
||||
file_descr_text TEXT NOT NULL,
|
||||
file_descr_part_no INTEGER NOT NULL DEFAULT(0),
|
||||
file_descr_complete INTEGER NOT NULL DEFAULT(0),
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE INDEX idx_snd_files_file_descr_id ON snd_files(file_descr_id);
|
||||
CREATE INDEX idx_rcv_files_file_descr_id ON rcv_files(file_descr_id);
|
||||
|
||||
@@ -115,6 +115,7 @@ mobileChatOpts dbFilePrefix dbKey =
|
||||
{ dbFilePrefix,
|
||||
dbKey,
|
||||
smpServers = [],
|
||||
xftpServers = [],
|
||||
networkConfig = defaultNetworkConfig,
|
||||
logLevel = CLLImportant,
|
||||
logConnections = False,
|
||||
|
||||
@@ -25,7 +25,7 @@ import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionNumber, ver
|
||||
import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (parseAll)
|
||||
import Simplex.Messaging.Protocol (SMPServerWithAuth)
|
||||
import Simplex.Messaging.Protocol (SMPServerWithAuth, XFTPServerWithAuth)
|
||||
import Simplex.Messaging.Transport.Client (SocksProxy, defaultSocksProxy)
|
||||
import System.FilePath (combine)
|
||||
|
||||
@@ -43,6 +43,7 @@ data CoreChatOpts = CoreChatOpts
|
||||
{ dbFilePrefix :: String,
|
||||
dbKey :: String,
|
||||
smpServers :: [SMPServerWithAuth],
|
||||
xftpServers :: [XFTPServerWithAuth],
|
||||
networkConfig :: NetworkConfig,
|
||||
logLevel :: ChatLogLevel,
|
||||
logConnections :: Bool,
|
||||
@@ -88,6 +89,14 @@ coreChatOptsP appDir defaultDbFileName = do
|
||||
<> help "Semicolon-separated list of SMP server(s) to use (each server can have more than one hostname)"
|
||||
<> value []
|
||||
)
|
||||
xftpServers <-
|
||||
option
|
||||
parseXFTPServers
|
||||
( long "xftp-server"
|
||||
<> metavar "SERVER"
|
||||
<> help "Semicolon-separated list of XFTP server(s) to use (each server can have more than one hostname)"
|
||||
<> value []
|
||||
)
|
||||
socksProxy <-
|
||||
flag' (Just defaultSocksProxy) (short 'x' <> help "Use local SOCKS5 proxy at :9050")
|
||||
<|> option
|
||||
@@ -156,6 +165,7 @@ coreChatOptsP appDir defaultDbFileName = do
|
||||
{ dbFilePrefix,
|
||||
dbKey,
|
||||
smpServers,
|
||||
xftpServers,
|
||||
networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel == CLLDebug),
|
||||
logLevel,
|
||||
logConnections = logConnections || logLevel <= CLLInfo,
|
||||
@@ -236,6 +246,9 @@ fullNetworkConfig socksProxy tcpTimeout logTLSErrors =
|
||||
parseSMPServers :: ReadM [SMPServerWithAuth]
|
||||
parseSMPServers = eitherReader $ parseAll smpServersP . B.pack
|
||||
|
||||
parseXFTPServers :: ReadM [XFTPServerWithAuth]
|
||||
parseXFTPServers = eitherReader $ parseAll xftpServersP . B.pack
|
||||
|
||||
parseSocksProxy :: ReadM (Maybe SocksProxy)
|
||||
parseSocksProxy = eitherReader $ parseAll strP . B.pack
|
||||
|
||||
@@ -248,6 +261,9 @@ serverPortP = Just . B.unpack <$> A.takeWhile A.isDigit
|
||||
smpServersP :: A.Parser [SMPServerWithAuth]
|
||||
smpServersP = strP `A.sepBy1` A.char ';'
|
||||
|
||||
xftpServersP :: A.Parser [XFTPServerWithAuth]
|
||||
xftpServersP = strP `A.sepBy1` A.char ';'
|
||||
|
||||
parseLogLevel :: ReadM ChatLogLevel
|
||||
parseLogLevel = eitherReader $ \case
|
||||
"debug" -> Right CLLDebug
|
||||
|
||||
+262
-77
@@ -34,6 +34,8 @@ module Simplex.Chat.Store
|
||||
getUser,
|
||||
getUserIdByName,
|
||||
getUserByAConnId,
|
||||
getUserByASndFileId,
|
||||
getUserByARcvFileId,
|
||||
getUserByContactId,
|
||||
getUserByGroupId,
|
||||
getUserByFileId,
|
||||
@@ -154,7 +156,13 @@ module Simplex.Chat.Store
|
||||
createSndGroupInlineFT,
|
||||
updateSndDirectFTDelivery,
|
||||
updateSndGroupFTDelivery,
|
||||
getSndInlineFTViaMsgDelivery,
|
||||
getSndFTViaMsgDelivery,
|
||||
createSndFileTransferXFTP,
|
||||
createSndFTDescrXFTP,
|
||||
updateSndFTDescrXFTP,
|
||||
updateSndFTDeliveryXFTP,
|
||||
getXFTPSndFileDBId,
|
||||
getXFTPRcvFileDBId,
|
||||
updateFileCancelled,
|
||||
updateCIFileStatus,
|
||||
getSharedMsgIdByFileId,
|
||||
@@ -169,12 +177,16 @@ module Simplex.Chat.Store
|
||||
deleteSndFileChunks,
|
||||
createRcvFileTransfer,
|
||||
createRcvGroupFileTransfer,
|
||||
appendRcvFD,
|
||||
updateRcvFileAgentId,
|
||||
getRcvFileTransferById,
|
||||
getRcvFileTransfer,
|
||||
acceptRcvFileTransfer,
|
||||
getContactByFileId,
|
||||
acceptRcvInlineFT,
|
||||
startRcvInlineFT,
|
||||
xftpAcceptRcvFT,
|
||||
setRcvFTAgentDeleted,
|
||||
updateRcvFileStatus,
|
||||
createRcvFileChunk,
|
||||
updatedRcvFileChunkStored,
|
||||
@@ -184,6 +196,7 @@ module Simplex.Chat.Store
|
||||
getFileTransferProgress,
|
||||
getFileTransferMeta,
|
||||
getSndFileTransfer,
|
||||
getSndFileTransfers,
|
||||
getContactFileInfo,
|
||||
deleteContactCIs,
|
||||
getGroupFileInfo,
|
||||
@@ -348,7 +361,8 @@ import Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
|
||||
import Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
|
||||
import Simplex.Chat.Migrations.M20230303_group_link_role
|
||||
import Simplex.Chat.Migrations.M20230317_hidden_profiles
|
||||
-- import Simplex.Chat.Migrations.M20230304_file_description
|
||||
import Simplex.Chat.Migrations.M20230318_file_description
|
||||
import Simplex.Chat.Migrations.M20230321_agent_file_deleted
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (week)
|
||||
@@ -416,8 +430,9 @@ schemaMigrations =
|
||||
("20230129_drop_chat_items_group_idx", m20230129_drop_chat_items_group_idx, Nothing),
|
||||
("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id, Nothing),
|
||||
("20230303_group_link_role", m20230303_group_link_role, Nothing),
|
||||
("20230317_hidden_profiles", m20230317_hidden_profiles, Just down_m20230317_hidden_profiles)
|
||||
-- ("20230304_file_description", m20230304_file_description)
|
||||
("20230317_hidden_profiles", m20230317_hidden_profiles, Just down_m20230317_hidden_profiles),
|
||||
("20230318_file_description", m20230318_file_description, Just down_m20230318_file_description),
|
||||
("20230321_agent_file_deleted", m20230321_agent_file_deleted, Just down_m20230321_agent_file_deleted)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
@@ -548,6 +563,16 @@ getUserByAConnId db agentConnId =
|
||||
maybeFirstRow toUser $
|
||||
DB.query db (userQuery <> " JOIN connections c ON c.user_id = u.user_id WHERE c.agent_conn_id = ?") (Only agentConnId)
|
||||
|
||||
getUserByASndFileId :: DB.Connection -> AgentSndFileId -> IO (Maybe User)
|
||||
getUserByASndFileId db aSndFileId =
|
||||
maybeFirstRow toUser $
|
||||
DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id WHERE f.agent_snd_file_id = ?") (Only aSndFileId)
|
||||
|
||||
getUserByARcvFileId :: DB.Connection -> AgentRcvFileId -> IO (Maybe User)
|
||||
getUserByARcvFileId db aRcvFileId =
|
||||
maybeFirstRow toUser $
|
||||
DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id JOIN rcv_files r ON r.file_id = f.file_id WHERE r.agent_rcv_file_id = ?") (Only aRcvFileId)
|
||||
|
||||
getUserByContactId :: DB.Connection -> ContactId -> ExceptT StoreError IO User
|
||||
getUserByContactId db contactId =
|
||||
ExceptT . firstRow toUser (SEUserNotFoundByContactId contactId) $
|
||||
@@ -1414,7 +1439,10 @@ getLiveSndFileTransfers db User {userId} = do
|
||||
SELECT DISTINCT f.file_id
|
||||
FROM files f
|
||||
JOIN snd_files s USING (file_id)
|
||||
WHERE f.user_id = ? AND s.file_status IN (?, ?, ?) AND s.file_inline IS NULL
|
||||
WHERE f.user_id = ?
|
||||
AND s.file_status IN (?, ?, ?)
|
||||
AND s.file_descr_id IS NULL
|
||||
AND s.file_inline IS NULL
|
||||
AND s.created_at > ?
|
||||
|]
|
||||
(userId, FSNew, FSAccepted, FSConnected, cutoffTs)
|
||||
@@ -1434,7 +1462,9 @@ getLiveRcvFileTransfers db user@User {userId} = do
|
||||
SELECT f.file_id
|
||||
FROM files f
|
||||
JOIN rcv_files r USING (file_id)
|
||||
WHERE f.user_id = ? AND r.file_status IN (?, ?) AND r.rcv_file_inline IS NULL
|
||||
WHERE f.user_id = ? AND r.file_status IN (?, ?)
|
||||
AND r.rcv_file_inline IS NULL
|
||||
AND r.file_descr_id IS NULL
|
||||
AND r.created_at > ?
|
||||
|]
|
||||
(userId, FSAccepted, FSConnected, cutoffTs)
|
||||
@@ -1761,7 +1791,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, cs.local_display_name, m.local_display_name
|
||||
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.group_member_id, cs.local_display_name, m.local_display_name
|
||||
FROM snd_files s
|
||||
JOIN files f USING (file_id)
|
||||
LEFT JOIN contacts cs USING (contact_id)
|
||||
@@ -1769,10 +1799,10 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ?
|
||||
|]
|
||||
(userId, fileId, connId)
|
||||
sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
|
||||
sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, contactName_, memberName_) =
|
||||
sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
|
||||
sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, contactName_, memberName_) =
|
||||
case contactName_ <|> memberName_ of
|
||||
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName, connId, agentConnId}
|
||||
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId, groupMemberId}
|
||||
Nothing -> Left $ SESndFileInvalid fileId
|
||||
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
|
||||
getUserContact_ userContactLinkId = ExceptT $ do
|
||||
@@ -2659,7 +2689,7 @@ createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitatio
|
||||
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, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
|
||||
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> IO ()
|
||||
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) = do
|
||||
@@ -2679,7 +2709,7 @@ createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, fileName, filePath, fileSize, chunkSize, fileInline, CIFSSndStored, currentTs, currentTs)
|
||||
fileId <- insertedRowId db
|
||||
pure FileTransferMeta {fileId, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
|
||||
|
||||
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> IO ()
|
||||
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} = do
|
||||
@@ -2700,7 +2730,7 @@ createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Connectio
|
||||
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 SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileInline = fileInline'}
|
||||
pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Nothing, fileStatus, fileDescrId = Nothing, fileInline = fileInline'}
|
||||
|
||||
createSndGroupInlineFT :: DB.Connection -> GroupMember -> Connection -> FileTransferMeta -> IO SndFileTransfer
|
||||
createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Connection {connId, agentConnId} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = do
|
||||
@@ -2711,7 +2741,7 @@ createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Conn
|
||||
db
|
||||
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(fileId, fileStatus, fileInline', connId, groupMemberId, currentTs, currentTs)
|
||||
pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileInline = fileInline'}
|
||||
pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Just groupMemberId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'}
|
||||
|
||||
updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> IO ()
|
||||
updateSndDirectFTDelivery db Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} msgDeliveryId =
|
||||
@@ -2727,27 +2757,84 @@ updateSndGroupFTDelivery db GroupMember {groupMemberId} Connection {connId} File
|
||||
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE group_member_id = ? AND connection_id = ? AND file_id = ? AND file_inline IS NOT NULL"
|
||||
(msgDeliveryId, groupMemberId, connId, fileId)
|
||||
|
||||
getSndInlineFTViaMsgDelivery :: DB.Connection -> User -> Connection -> AgentMsgId -> IO (Maybe SndFileTransfer)
|
||||
getSndInlineFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMsgId = do
|
||||
getSndFTViaMsgDelivery :: DB.Connection -> User -> Connection -> AgentMsgId -> IO (Maybe SndFileTransfer)
|
||||
getSndFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMsgId = do
|
||||
(sndFileTransfer_ <=< listToMaybe)
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, c.local_display_name, m.local_display_name
|
||||
SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.group_member_id, c.local_display_name, m.local_display_name
|
||||
FROM msg_deliveries d
|
||||
JOIN snd_files s ON s.connection_id = d.connection_id AND s.last_inline_msg_delivery_id = d.msg_delivery_id
|
||||
JOIN files f ON f.file_id = s.file_id
|
||||
LEFT JOIN contacts c USING (contact_id)
|
||||
LEFT JOIN group_members m USING (group_member_id)
|
||||
WHERE d.connection_id = ? AND d.agent_msg_id = ? AND f.user_id = ? AND s.file_inline IS NOT NULL
|
||||
WHERE d.connection_id = ? AND d.agent_msg_id = ? AND f.user_id = ?
|
||||
AND (s.file_descr_id IS NOT NULL OR s.file_inline IS NOT NULL)
|
||||
|]
|
||||
(connId, agentMsgId, userId)
|
||||
where
|
||||
sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer
|
||||
sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, contactName_, memberName_) =
|
||||
(\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName = n, connId, agentConnId})
|
||||
sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe Int64, Maybe InlineFileMode, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer
|
||||
sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, contactName_, memberName_) =
|
||||
(\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, groupMemberId, recipientDisplayName = n, connId, agentConnId})
|
||||
<$> (contactName_ <|> memberName_)
|
||||
|
||||
createSndFileTransferXFTP :: DB.Connection -> User -> ContactOrGroup -> FilePath -> FileInvitation -> AgentSndFileId -> IO FileTransferMeta
|
||||
createSndFileTransferXFTP db User {userId} contactOrGroup filePath FileInvitation {fileName, fileSize} agentSndFileId = do
|
||||
currentTs <- getCurrentTime
|
||||
let chunkSize = 0
|
||||
xftpSndFile = Just XFTPSndFile {agentSndFileId, privateSndFileDescr = Nothing}
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (contact_id, group_id, user_id, file_name, file_path, file_size, chunk_size, agent_snd_file_id, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
|
||||
(contactAndGroupIds contactOrGroup :. (userId, fileName, filePath, fileSize, chunkSize, agentSndFileId, CIFSSndStored, currentTs, currentTs))
|
||||
fileId <- insertedRowId db
|
||||
pure FileTransferMeta {fileId, xftpSndFile, fileName, filePath, fileSize, fileInline = Nothing, chunkSize, cancelled = False}
|
||||
|
||||
createSndFTDescrXFTP :: DB.Connection -> User -> Maybe GroupMember -> Connection -> FileTransferMeta -> FileDescr -> IO ()
|
||||
createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fileId} FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
|
||||
currentTs <- getCurrentTime
|
||||
let fileStatus = FSNew
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs)
|
||||
fileDescrId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(fileId, fileStatus, fileDescrId, groupMemberId' <$> m, connId, currentTs, currentTs)
|
||||
|
||||
updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO ()
|
||||
updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDescrId} rfdText = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE xftp_file_descriptions
|
||||
SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?
|
||||
WHERE user_id = ? AND file_descr_id = ?
|
||||
|]
|
||||
(rfdText, 1 :: Int, True, userId, fileDescrId)
|
||||
updateCIFileStatus db user fileId $ CIFSSndTransfer 1 1
|
||||
updateSndFileStatus db sft FSConnected
|
||||
|
||||
updateSndFTDeliveryXFTP :: DB.Connection -> SndFileTransfer -> Int64 -> IO ()
|
||||
updateSndFTDeliveryXFTP db SndFileTransfer {connId, fileId, fileDescrId} msgDeliveryId =
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_descr_id = ?"
|
||||
(msgDeliveryId, connId, fileId, fileDescrId)
|
||||
|
||||
getXFTPSndFileDBId :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO FileTransferId
|
||||
getXFTPSndFileDBId db User {userId} aSndFileId =
|
||||
ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $
|
||||
DB.query db "SELECT file_id FROM files WHERE user_id = ? AND agent_snd_file_id = ?" (userId, aSndFileId)
|
||||
|
||||
getXFTPRcvFileDBId :: DB.Connection -> AgentRcvFileId -> ExceptT StoreError IO FileTransferId
|
||||
getXFTPRcvFileDBId db aRcvFileId =
|
||||
ExceptT . firstRow fromOnly (SERcvFileNotFoundXFTP aRcvFileId) $
|
||||
DB.query db "SELECT file_id FROM rcv_files WHERE agent_rcv_file_id = ?" (Only aRcvFileId)
|
||||
|
||||
updateFileCancelled :: MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> IO ()
|
||||
updateFileCancelled db User {userId} fileId ciFileStatus = do
|
||||
currentTs <- getCurrentTime
|
||||
@@ -2884,33 +2971,109 @@ deleteSndFileChunks :: DB.Connection -> SndFileTransfer -> IO ()
|
||||
deleteSndFileChunks db SndFileTransfer {fileId, connId} =
|
||||
DB.execute db "DELETE FROM snd_file_chunks WHERE file_id = ? AND connection_id = ?" (fileId, connId)
|
||||
|
||||
createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
|
||||
createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
|
||||
fileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, currentTs, currentTs)
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
|
||||
createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
|
||||
createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
fileId <- liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, contactId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
|
||||
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs)
|
||||
pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
|
||||
|
||||
createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
|
||||
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
|
||||
createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
|
||||
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
fileId <- liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr
|
||||
let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd_
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId = Nothing, agentRcvFileDeleted = False}) <$> rfd_
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs)
|
||||
pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
|
||||
|
||||
createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr
|
||||
createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
|
||||
when (fileDescrPartNo /= 0) $ throwError SERcvFileInvalidDescrPart
|
||||
fileDescrId <- liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
pure RcvFileDescr {fileDescrId, fileDescrPartNo, fileDescrText, fileDescrComplete}
|
||||
|
||||
appendRcvFD :: DB.Connection -> UserId -> FileTransferId -> FileDescr -> ExceptT StoreError IO RcvFileDescr
|
||||
appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
|
||||
Nothing -> do
|
||||
rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId currentTs fd
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE rcv_files SET file_descr_id = ?, updated_at = ? WHERE file_id = ?"
|
||||
(fileDescrId, currentTs, fileId)
|
||||
pure rfd
|
||||
Just
|
||||
RcvFileDescr
|
||||
{ fileDescrId,
|
||||
fileDescrText = rfdText,
|
||||
fileDescrPartNo = rfdPNo,
|
||||
fileDescrComplete = rfdComplete
|
||||
} -> do
|
||||
when (fileDescrPartNo /= rfdPNo + 1 || rfdComplete) $ throwError SERcvFileInvalidDescrPart
|
||||
let fileDescrText' = rfdText <> fileDescrText
|
||||
liftIO $
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE xftp_file_descriptions
|
||||
SET file_descr_text = ?, file_descr_part_no = ?, file_descr_complete = ?
|
||||
WHERE file_descr_id = ?
|
||||
|]
|
||||
(fileDescrText', fileDescrPartNo, fileDescrComplete, fileDescrId)
|
||||
pure RcvFileDescr {fileDescrId, fileDescrText = fileDescrText', fileDescrPartNo, fileDescrComplete}
|
||||
|
||||
getRcvFileDescrByFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
|
||||
getRcvFileDescrByFileId_ db fileId =
|
||||
maybeFirstRow toRcvFileDescr $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT d.file_descr_id, d.file_descr_text, d.file_descr_part_no, d.file_descr_complete
|
||||
FROM xftp_file_descriptions d
|
||||
JOIN rcv_files f ON f.file_descr_id = d.file_descr_id
|
||||
WHERE f.file_id = ?
|
||||
LIMIT 1
|
||||
|]
|
||||
(Only fileId)
|
||||
where
|
||||
toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
|
||||
toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
|
||||
RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
|
||||
|
||||
updateRcvFileAgentId :: DB.Connection -> FileTransferId -> AgentRcvFileId -> IO ()
|
||||
updateRcvFileAgentId db fileId aFileId = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
|
||||
fileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, currentTs, currentTs)
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
|
||||
DB.execute db "UPDATE rcv_files SET agent_rcv_file_id = ?, updated_at = ? WHERE file_id = ?" (aFileId, currentTs, fileId)
|
||||
|
||||
getRcvFileTransferById :: DB.Connection -> FileTransferId -> ExceptT StoreError IO (User, RcvFileTransfer)
|
||||
getRcvFileTransferById db fileId = do
|
||||
@@ -2926,7 +3089,7 @@ getRcvFileTransfer db User {userId} fileId = do
|
||||
[sql|
|
||||
SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name,
|
||||
f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name,
|
||||
f.file_path, r.file_inline, r.rcv_file_inline, c.connection_id, c.agent_conn_id
|
||||
f.file_path, r.file_inline, r.rcv_file_inline, r.agent_rcv_file_id, r.agent_rcv_file_deleted, c.connection_id, c.agent_conn_id
|
||||
FROM rcv_files r
|
||||
JOIN files f USING (file_id)
|
||||
LEFT JOIN connections c ON r.file_id = c.rcv_file_id
|
||||
@@ -2935,28 +3098,30 @@ getRcvFileTransfer db User {userId} fileId = do
|
||||
WHERE f.user_id = ? AND f.file_id = ?
|
||||
|]
|
||||
(userId, fileId)
|
||||
rcvFileTransfer rftRow
|
||||
rfd_ <- liftIO $ getRcvFileDescrByFileId_ db fileId
|
||||
rcvFileTransfer rfd_ rftRow
|
||||
where
|
||||
rcvFileTransfer ::
|
||||
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode) :. (Maybe Int64, Maybe AgentConnId) ->
|
||||
Maybe RcvFileDescr ->
|
||||
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, Bool) :. (Maybe Int64, Maybe AgentConnId) ->
|
||||
ExceptT StoreError IO RcvFileTransfer
|
||||
rcvFileTransfer ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline) :. (connId_, agentConnId_)) = do
|
||||
let fileInv = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
fileInfo = (filePath_, connId_, agentConnId_)
|
||||
rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline, agentRcvFileId, agentRcvFileDeleted) :. (connId_, agentConnId_)) =
|
||||
case contactName_ <|> memberName_ of
|
||||
Nothing -> throwError $ SERcvFileInvalid fileId
|
||||
Just name -> do
|
||||
case fileStatus' of
|
||||
FSNew -> pure $ ft name fileInv RFSNew
|
||||
FSAccepted -> ft name fileInv . RFSAccepted <$> rfi fileInfo
|
||||
FSConnected -> ft name fileInv . RFSConnected <$> rfi fileInfo
|
||||
FSComplete -> ft name fileInv . RFSComplete <$> rfi fileInfo
|
||||
FSCancelled -> ft name fileInv . RFSCancelled <$> rfi_ fileInfo
|
||||
FSNew -> pure $ ft name RFSNew
|
||||
FSAccepted -> ft name . RFSAccepted <$> rfi
|
||||
FSConnected -> ft name . RFSConnected <$> rfi
|
||||
FSComplete -> ft name . RFSComplete <$> rfi
|
||||
FSCancelled -> ft name . RFSCancelled <$> rfi_
|
||||
where
|
||||
ft senderDisplayName fileInvitation fileStatus =
|
||||
RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName, chunkSize, cancelled, grpMemberId}
|
||||
rfi fileInfo = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ fileInfo
|
||||
rfi_ = \case
|
||||
ft senderDisplayName fileStatus =
|
||||
let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted}) <$> rfd_
|
||||
in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
|
||||
rfi = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_
|
||||
rfi_ = case (filePath_, connId_, agentConnId_) of
|
||||
(Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
|
||||
_ -> pure Nothing
|
||||
cancelled = fromMaybe False cancelled_
|
||||
@@ -2982,7 +3147,7 @@ getContactByFileId db user@User {userId} fileId = do
|
||||
ExceptT . firstRow fromOnly (SEContactNotFoundByFileId fileId) $
|
||||
DB.query db "SELECT contact_id FROM files WHERE user_id = ? AND file_id = ?" (userId, fileId)
|
||||
|
||||
acceptRcvInlineFT :: DB.Connection -> User -> Int64 -> FilePath -> ExceptT StoreError IO AChatItem
|
||||
acceptRcvInlineFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
|
||||
acceptRcvInlineFT db user fileId filePath = do
|
||||
liftIO $ acceptRcvFT_ db user fileId filePath (Just IFMOffer) =<< getCurrentTime
|
||||
getChatItemByFileId db user fileId
|
||||
@@ -2991,7 +3156,12 @@ startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Mayb
|
||||
startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline =
|
||||
acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime
|
||||
|
||||
acceptRcvFT_ :: DB.Connection -> User -> Int64 -> FilePath -> Maybe InlineFileMode -> UTCTime -> IO ()
|
||||
xftpAcceptRcvFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
|
||||
xftpAcceptRcvFT db user fileId filePath = do
|
||||
liftIO $ acceptRcvFT_ db user fileId filePath Nothing =<< getCurrentTime
|
||||
getChatItemByFileId db user fileId
|
||||
|
||||
acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Maybe InlineFileMode -> UTCTime -> IO ()
|
||||
acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
|
||||
DB.execute
|
||||
db
|
||||
@@ -3002,8 +3172,16 @@ acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do
|
||||
"UPDATE rcv_files SET rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?"
|
||||
(rcvFileInline, FSAccepted, currentTs, fileId)
|
||||
|
||||
updateRcvFileStatus :: DB.Connection -> RcvFileTransfer -> FileStatus -> IO ()
|
||||
updateRcvFileStatus db RcvFileTransfer {fileId} status = do
|
||||
setRcvFTAgentDeleted :: DB.Connection -> FileTransferId -> IO ()
|
||||
setRcvFTAgentDeleted db fileId = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE rcv_files SET agent_rcv_file_deleted = 1, updated_at = ? WHERE file_id = ?"
|
||||
(currentTs, fileId)
|
||||
|
||||
updateRcvFileStatus :: DB.Connection -> FileTransferId -> FileStatus -> IO ()
|
||||
updateRcvFileStatus db fileId status = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute db "UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" (status, currentTs, fileId)
|
||||
|
||||
@@ -3091,18 +3269,21 @@ getFileTransfer db user@User {userId} fileId =
|
||||
(userId, fileId)
|
||||
|
||||
getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
|
||||
getSndFileTransfer db user@User {userId} fileId = do
|
||||
getSndFileTransfer db user fileId = do
|
||||
fileTransferMeta <- getFileTransferMeta db user fileId
|
||||
sndFileTransfers <- ExceptT $ getSndFileTransfers_ db userId fileId
|
||||
sndFileTransfers <- getSndFileTransfers db user fileId
|
||||
pure (fileTransferMeta, sndFileTransfers)
|
||||
|
||||
getSndFileTransfers :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO [SndFileTransfer]
|
||||
getSndFileTransfers db User {userId} fileId = ExceptT $ getSndFileTransfers_ db userId fileId
|
||||
|
||||
getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer])
|
||||
getSndFileTransfers_ db userId fileId =
|
||||
mapM sndFileTransfer
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, s.connection_id, c.agent_conn_id,
|
||||
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_descr_id, s.file_inline, s.connection_id, c.agent_conn_id, s.group_member_id,
|
||||
cs.local_display_name, m.local_display_name
|
||||
FROM snd_files s
|
||||
JOIN files f USING (file_id)
|
||||
@@ -3113,10 +3294,10 @@ getSndFileTransfers_ db userId fileId =
|
||||
|]
|
||||
(userId, fileId)
|
||||
where
|
||||
sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Int64, AgentConnId, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
|
||||
sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, connId, agentConnId, contactName_, memberName_) =
|
||||
sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath) :. (Maybe Int64, Maybe InlineFileMode, Int64, AgentConnId, Maybe Int64, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
|
||||
sndFileTransfer ((fileStatus, fileName, fileSize, chunkSize, filePath) :. (fileDescrId, fileInline, connId, agentConnId, groupMemberId, contactName_, memberName_)) =
|
||||
case contactName_ <|> memberName_ of
|
||||
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName, connId, agentConnId}
|
||||
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileDescrId, fileInline, recipientDisplayName, connId, agentConnId, groupMemberId}
|
||||
Nothing -> Left $ SESndFileInvalid fileId
|
||||
|
||||
getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
|
||||
@@ -3125,15 +3306,16 @@ getFileTransferMeta db User {userId} fileId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT f.file_name, f.file_size, f.chunk_size, f.file_path, f.file_inline, f.cancelled
|
||||
FROM files f
|
||||
WHERE f.user_id = ? AND f.file_id = ?
|
||||
SELECT file_name, file_size, chunk_size, file_path, file_inline, agent_snd_file_id, private_snd_file_descr, cancelled
|
||||
FROM files
|
||||
WHERE user_id = ? AND file_id = ?
|
||||
|]
|
||||
(userId, fileId)
|
||||
where
|
||||
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe Bool) -> FileTransferMeta
|
||||
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileInline, cancelled_) =
|
||||
FileTransferMeta {fileId, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
|
||||
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe AgentSndFileId, Maybe Text, Maybe Bool) -> FileTransferMeta
|
||||
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileInline, aSndFileId_, privateSndFileDescr, cancelled_) =
|
||||
let xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr}) <$> aSndFileId_
|
||||
in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
|
||||
|
||||
getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
|
||||
getContactFileInfo db User {userId} Contact {contactId} =
|
||||
@@ -5017,8 +5199,11 @@ data StoreError
|
||||
| SERcvFileNotFound {fileId :: FileTransferId}
|
||||
| SEFileNotFound {fileId :: FileTransferId}
|
||||
| SERcvFileInvalid {fileId :: FileTransferId}
|
||||
| SERcvFileInvalidDescrPart
|
||||
| SESharedMsgIdNotFoundByFileId {fileId :: FileTransferId}
|
||||
| SEFileIdNotFoundBySharedMsgId {sharedMsgId :: SharedMsgId}
|
||||
| SESndFileNotFoundXFTP {agentSndFileId :: AgentSndFileId}
|
||||
| SERcvFileNotFoundXFTP {agentRcvFileId :: AgentRcvFileId}
|
||||
| SEConnectionNotFound {agentConnId :: AgentConnId}
|
||||
| SEConnectionNotFoundById {connId :: Int64}
|
||||
| SEPendingConnectionNotFound {connId :: Int64}
|
||||
|
||||
+91
-14
@@ -317,6 +317,13 @@ instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOption
|
||||
groupName' :: GroupInfo -> GroupName
|
||||
groupName' GroupInfo {localDisplayName = g} = g
|
||||
|
||||
data ContactOrGroup = CGContact Contact | CGGroup Group
|
||||
|
||||
contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
|
||||
contactAndGroupIds = \case
|
||||
CGContact Contact {contactId} -> (Just contactId, Nothing)
|
||||
CGGroup (Group GroupInfo {groupId} _) -> (Nothing, Just groupId)
|
||||
|
||||
-- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties)
|
||||
data ChatSettings = ChatSettings
|
||||
{ enableNtfs :: Bool
|
||||
@@ -1484,7 +1491,9 @@ data SndFileTransfer = SndFileTransfer
|
||||
recipientDisplayName :: ContactName,
|
||||
connId :: Int64,
|
||||
agentConnId :: AgentConnId,
|
||||
groupMemberId :: Maybe Int64,
|
||||
fileStatus :: FileStatus,
|
||||
fileDescrId :: Maybe Int64,
|
||||
fileInline :: Maybe InlineFileMode
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
@@ -1513,18 +1522,26 @@ instance ToJSON FileInvitation where
|
||||
instance FromJSON FileInvitation where
|
||||
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
data FileDescr
|
||||
= FDText {fileDescrText :: Text}
|
||||
| FDInline {fileDescrSize :: Integer, fileDescrInline :: InlineFileMode}
|
||||
| FDPending
|
||||
data FileDescr = FileDescr {fileDescrText :: Text, fileDescrPartNo :: Int, fileDescrComplete :: Bool}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON FileDescr where
|
||||
toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "FD"
|
||||
toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "FD"
|
||||
toEncoding = J.genericToEncoding J.defaultOptions
|
||||
toJSON = J.genericToJSON J.defaultOptions
|
||||
|
||||
instance FromJSON FileDescr where
|
||||
parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD"
|
||||
parseJSON = J.genericParseJSON J.defaultOptions
|
||||
|
||||
xftpFileInvitation :: FilePath -> Integer -> FileDescr -> FileInvitation
|
||||
xftpFileInvitation fileName fileSize fileDescr =
|
||||
FileInvitation
|
||||
{ fileName,
|
||||
fileSize,
|
||||
fileDigest = Nothing,
|
||||
fileConnReq = Nothing,
|
||||
fileInline = Nothing,
|
||||
fileDescr = Just fileDescr
|
||||
}
|
||||
|
||||
data InlineFileMode
|
||||
= IFMOffer -- file will be sent inline once accepted
|
||||
@@ -1553,10 +1570,10 @@ instance ToJSON InlineFileMode where
|
||||
|
||||
data RcvFileTransfer = RcvFileTransfer
|
||||
{ fileId :: FileTransferId,
|
||||
xftpRcvFile :: Maybe XFTPRcvFile,
|
||||
fileInvitation :: FileInvitation,
|
||||
fileStatus :: RcvFileStatus,
|
||||
rcvFileInline :: Maybe InlineFileMode,
|
||||
rcvFileDescription :: Maybe RcvFileDescr,
|
||||
senderDisplayName :: ContactName,
|
||||
chunkSize :: Integer,
|
||||
cancelled :: Bool,
|
||||
@@ -1566,11 +1583,20 @@ data RcvFileTransfer = RcvFileTransfer
|
||||
|
||||
instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data XFTPRcvFile = XFTPRcvFile
|
||||
{ rcvFileDescription :: RcvFileDescr,
|
||||
agentRcvFileId :: Maybe AgentRcvFileId,
|
||||
agentRcvFileDeleted :: Bool
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON XFTPRcvFile where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data RcvFileDescr = RcvFileDescr
|
||||
{ fileDescrId :: Int64,
|
||||
fileDescrStatus :: RcvFileStatus,
|
||||
fileDescrText :: Text,
|
||||
chunkSize :: Integer
|
||||
fileDescrPartNo :: Int,
|
||||
fileDescrComplete :: Bool
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
@@ -1597,15 +1623,23 @@ data RcvFileInfo = RcvFileInfo
|
||||
|
||||
instance ToJSON RcvFileInfo where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
liveRcvFileTransferConnId :: RcvFileTransfer -> Maybe ConnId
|
||||
liveRcvFileTransferConnId RcvFileTransfer {fileStatus} = case fileStatus of
|
||||
RFSAccepted fi -> acId fi
|
||||
RFSConnected fi -> acId fi
|
||||
liveRcvFileTransferInfo :: RcvFileTransfer -> Maybe RcvFileInfo
|
||||
liveRcvFileTransferInfo RcvFileTransfer {fileStatus} = case fileStatus of
|
||||
RFSAccepted fi -> Just fi
|
||||
RFSConnected fi -> Just fi
|
||||
_ -> Nothing
|
||||
|
||||
liveRcvFileTransferConnId :: RcvFileTransfer -> Maybe ConnId
|
||||
liveRcvFileTransferConnId ft = acId =<< liveRcvFileTransferInfo ft
|
||||
where
|
||||
acId RcvFileInfo {agentConnId = Just (AgentConnId cId)} = Just cId
|
||||
acId _ = Nothing
|
||||
|
||||
liveRcvFileTransferPath :: RcvFileTransfer -> Maybe FilePath
|
||||
liveRcvFileTransferPath ft = fp <$> liveRcvFileTransferInfo ft
|
||||
where
|
||||
fp RcvFileInfo {filePath} = filePath
|
||||
|
||||
newtype AgentConnId = AgentConnId ConnId
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -1622,6 +1656,38 @@ instance FromField AgentConnId where fromField f = AgentConnId <$> fromField f
|
||||
|
||||
instance ToField AgentConnId where toField (AgentConnId m) = toField m
|
||||
|
||||
newtype AgentSndFileId = AgentSndFileId ConnId
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance StrEncoding AgentSndFileId where
|
||||
strEncode (AgentSndFileId connId) = strEncode connId
|
||||
strDecode s = AgentSndFileId <$> strDecode s
|
||||
strP = AgentSndFileId <$> strP
|
||||
|
||||
instance ToJSON AgentSndFileId where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
instance FromField AgentSndFileId where fromField f = AgentSndFileId <$> fromField f
|
||||
|
||||
instance ToField AgentSndFileId where toField (AgentSndFileId m) = toField m
|
||||
|
||||
newtype AgentRcvFileId = AgentRcvFileId ConnId
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance StrEncoding AgentRcvFileId where
|
||||
strEncode (AgentRcvFileId connId) = strEncode connId
|
||||
strDecode s = AgentRcvFileId <$> strDecode s
|
||||
strP = AgentRcvFileId <$> strP
|
||||
|
||||
instance ToJSON AgentRcvFileId where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
instance FromField AgentRcvFileId where fromField f = AgentRcvFileId <$> fromField f
|
||||
|
||||
instance ToField AgentRcvFileId where toField (AgentRcvFileId m) = toField m
|
||||
|
||||
newtype AgentInvId = AgentInvId InvitationId
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -1652,6 +1718,7 @@ instance ToJSON FileTransfer where
|
||||
|
||||
data FileTransferMeta = FileTransferMeta
|
||||
{ fileId :: FileTransferId,
|
||||
xftpSndFile :: Maybe XFTPSndFile,
|
||||
fileName :: String,
|
||||
filePath :: String,
|
||||
fileSize :: Integer,
|
||||
@@ -1663,10 +1730,20 @@ data FileTransferMeta = FileTransferMeta
|
||||
|
||||
instance ToJSON FileTransferMeta where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data XFTPSndFile = XFTPSndFile
|
||||
{ agentSndFileId :: AgentSndFileId,
|
||||
privateSndFileDescr :: Maybe Text
|
||||
-- TODO agentSndFileDeleted :: Bool
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON XFTPSndFile where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
fileTransferCancelled :: FileTransfer -> Bool
|
||||
fileTransferCancelled (FTSnd FileTransferMeta {cancelled} _) = cancelled
|
||||
fileTransferCancelled (FTRcv RcvFileTransfer {cancelled}) = cancelled
|
||||
|
||||
-- For XFTP file transfers FSConnected means "uploaded to XFTP relays"
|
||||
data FileStatus = FSNew | FSAccepted | FSConnected | FSComplete | FSCancelled deriving (Eq, Ord, Show)
|
||||
|
||||
instance FromField FileStatus where fromField = fromTextField_ textDecode
|
||||
|
||||
@@ -132,6 +132,9 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
||||
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
|
||||
CRRcvFileDescrReady _ _ -> []
|
||||
CRRcvFileDescrNotReady _ _ -> []
|
||||
CRRcvFileProgressXFTP _ _ _ _ -> []
|
||||
CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
|
||||
CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft
|
||||
CRSndGroupFileCancelled u _ ftm fts -> ttyUser u $ viewSndGroupFileCancelled ftm fts
|
||||
@@ -149,6 +152,10 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
|
||||
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
|
||||
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
|
||||
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
|
||||
CRSndFileStartXFTP _ _ _ -> []
|
||||
CRSndFileProgressXFTP _ _ _ _ _ -> []
|
||||
CRSndFileCompleteXFTP _ _ _ -> []
|
||||
CRSndFileCancelledXFTP _ _ _ -> []
|
||||
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
|
||||
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
|
||||
CRContactConnecting u _ -> ttyUser u []
|
||||
@@ -1026,7 +1033,7 @@ viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts = case filePa
|
||||
where
|
||||
ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending
|
||||
cancelSending = case fileStatus of
|
||||
CIFSSndTransfer -> []
|
||||
CIFSSndTransfer _ _ -> []
|
||||
_ -> ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]
|
||||
|
||||
sentWithTime_ :: CurrentTime -> [StyledString] -> CIMeta c d -> [StyledString]
|
||||
@@ -1226,6 +1233,8 @@ viewChatError logLevel = \case
|
||||
ChatError err -> case err of
|
||||
CENoActiveUser -> ["error: active user is required"]
|
||||
CENoConnectionUser agentConnId -> ["error: message user not found, conn id: " <> sShow agentConnId | logLevel <= CLLError]
|
||||
CENoSndFileUser aFileId -> ["error: snd file user not found, file id: " <> sShow aFileId | logLevel <= CLLError]
|
||||
CENoRcvFileUser aFileId -> ["error: rcv file user not found, file id: " <> sShow aFileId | logLevel <= CLLError]
|
||||
CEActiveUserExists -> ["error: active user already exists"]
|
||||
CEUserExists name -> ["user with the name " <> ttyContact name <> " already exists"]
|
||||
CEUserUnknown -> ["user does not exist or incorrect password"]
|
||||
@@ -1287,6 +1296,7 @@ viewChatError logLevel = \case
|
||||
CEAgentNoSubResult connId -> ["no subscription result for connection: " <> sShow connId]
|
||||
CECommandError e -> ["bad chat command: " <> plain e]
|
||||
CEAgentCommandError e -> ["agent command error: " <> plain e]
|
||||
CEInvalidFileDescription e -> ["invalid file description: " <> plain e]
|
||||
CEInternalError e -> ["internal chat error: " <> plain e]
|
||||
-- e -> ["chat error: " <> sShow e]
|
||||
ChatErrorStore err -> case err of
|
||||
|
||||
@@ -26,6 +26,9 @@ import Simplex.Chat.Store
|
||||
import Simplex.Chat.Terminal
|
||||
import Simplex.Chat.Terminal.Output (newChatTerminal)
|
||||
import Simplex.Chat.Types (AgentUserId (..), Profile, User (..))
|
||||
import Simplex.FileTransfer.Description (kb, mb)
|
||||
import Simplex.FileTransfer.Server (runXFTPServerBlocking)
|
||||
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration)
|
||||
import Simplex.Messaging.Agent.Env.SQLite
|
||||
import Simplex.Messaging.Agent.RetryInterval
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..))
|
||||
@@ -56,6 +59,7 @@ testOpts =
|
||||
dbKey = "",
|
||||
-- dbKey = "this is a pass-phrase to encrypt the database",
|
||||
smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],
|
||||
xftpServers = ["xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7002"],
|
||||
networkConfig = defaultNetworkConfig,
|
||||
logLevel = CLLImportant,
|
||||
logConnections = False,
|
||||
@@ -306,6 +310,42 @@ serverCfg =
|
||||
withSmpServer :: IO () -> IO ()
|
||||
withSmpServer = serverBracket (`runSMPServerBlocking` serverCfg)
|
||||
|
||||
xftpTestPort :: ServiceName
|
||||
xftpTestPort = "7002"
|
||||
|
||||
xftpServerFiles :: FilePath
|
||||
xftpServerFiles = "tests/tmp/xftp-server-files"
|
||||
|
||||
xftpServerConfig :: XFTPServerConfig
|
||||
xftpServerConfig =
|
||||
XFTPServerConfig
|
||||
{ xftpPort = xftpTestPort,
|
||||
fileIdSize = 16,
|
||||
storeLogFile = Just "tests/tmp/xftp-server-store.log",
|
||||
filesPath = xftpServerFiles,
|
||||
fileSizeQuota = Nothing,
|
||||
allowedChunkSizes = [kb 128, kb 256, mb 1, mb 4],
|
||||
allowNewFiles = True,
|
||||
newFileBasicAuth = Nothing,
|
||||
fileExpiration = Just defaultFileExpiration,
|
||||
caCertificateFile = "tests/fixtures/tls/ca.crt",
|
||||
privateKeyFile = "tests/fixtures/tls/server.key",
|
||||
certificateFile = "tests/fixtures/tls/server.crt",
|
||||
logStatsInterval = Nothing,
|
||||
logStatsStartTime = 0,
|
||||
serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",
|
||||
serverStatsBackupFile = Nothing,
|
||||
logTLSErrors = True
|
||||
}
|
||||
|
||||
withXFTPServer :: IO () -> IO ()
|
||||
withXFTPServer =
|
||||
serverBracket
|
||||
( \started -> do
|
||||
createDirectoryIfMissing False xftpServerFiles
|
||||
runXFTPServerBlocking started xftpServerConfig
|
||||
)
|
||||
|
||||
serverBracket :: (TMVar Bool -> IO ()) -> IO () -> IO ()
|
||||
serverBracket server f = do
|
||||
started <- newEmptyTMVarIO
|
||||
|
||||
+130
-1
@@ -8,7 +8,7 @@ import ChatTests.Utils
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (concurrently_)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), defaultInlineFilesConfig)
|
||||
import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig)
|
||||
import Simplex.Chat.Options (ChatOpts (..))
|
||||
import Simplex.Messaging.Util (unlessM)
|
||||
import System.Directory (copyFile, doesFileExist)
|
||||
@@ -48,6 +48,11 @@ chatFileTests = do
|
||||
it "v2" testAsyncFileTransfer
|
||||
it "v1" testAsyncFileTransferV1
|
||||
xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer
|
||||
describe "file transfer over XFTP" $ do
|
||||
it "send and receive file" testXFTPFileTransfer
|
||||
it "with changed XFTP config: send and receive file" testXFTPWithChangedConfig
|
||||
it "with relative paths: send and receive file" testXFTPWithRelativePaths
|
||||
it "continue receiving file after restart" testXFTPContinueRcv
|
||||
|
||||
runTestFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
|
||||
runTestFileTransfer alice bob = do
|
||||
@@ -915,6 +920,130 @@ testAsyncGroupFileTransfer tmp = do
|
||||
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
|
||||
dest2 `shouldBe` src
|
||||
|
||||
testXFTPFileTransfer :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPFileTransfer =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
connectUsers alice bob
|
||||
|
||||
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
||||
alice <## "use /fc 1 to cancel sending"
|
||||
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
||||
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
bob ##> "/fr 1 ./tests/tmp"
|
||||
bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
|
||||
-- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
|
||||
alice <## "completed sending file 1 (test.pdf) to bob"
|
||||
bob <## "started receiving file 1 (test.pdf) from alice"
|
||||
bob <## "completed receiving file 1 (test.pdf) from alice"
|
||||
|
||||
src <- B.readFile "./tests/fixtures/test.pdf"
|
||||
dest <- B.readFile "./tests/tmp/test.pdf"
|
||||
dest `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testXFTPWithChangedConfig :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPWithChangedConfig =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
alice #$> ("/_xftp off", id, "ok")
|
||||
alice #$> ("/_xftp on {\"minFileSize\":1024}", id, "ok")
|
||||
|
||||
bob #$> ("/xftp off", id, "ok")
|
||||
bob #$> ("/xftp on minFileSize=1kb", id, "ok")
|
||||
|
||||
connectUsers alice bob
|
||||
|
||||
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
||||
alice <## "use /fc 1 to cancel sending"
|
||||
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
||||
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
bob ##> "/fr 1 ./tests/tmp"
|
||||
bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
|
||||
-- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
|
||||
alice <## "completed sending file 1 (test.pdf) to bob"
|
||||
bob <## "started receiving file 1 (test.pdf) from alice"
|
||||
bob <## "completed receiving file 1 (test.pdf) from alice"
|
||||
|
||||
src <- B.readFile "./tests/fixtures/test.pdf"
|
||||
dest <- B.readFile "./tests/tmp/test.pdf"
|
||||
dest `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {tempDir = Just "./tests/tmp"}
|
||||
|
||||
testXFTPWithRelativePaths :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPWithRelativePaths =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
-- agent is passed xftp work directory only on chat start,
|
||||
-- so for test we work around by stopping and starting chat
|
||||
alice ##> "/_stop"
|
||||
alice <## "chat stopped"
|
||||
alice #$> ("/_files_folder ./tests/fixtures", id, "ok")
|
||||
alice #$> ("/_temp_folder ./tests/tmp/alice_xftp", id, "ok")
|
||||
alice ##> "/_start"
|
||||
alice <## "chat started"
|
||||
|
||||
bob ##> "/_stop"
|
||||
bob <## "chat stopped"
|
||||
bob #$> ("/_files_folder ./tests/tmp/bob_files", id, "ok")
|
||||
bob #$> ("/_temp_folder ./tests/tmp/bob_xftp", id, "ok")
|
||||
bob ##> "/_start"
|
||||
bob <## "chat started"
|
||||
|
||||
connectUsers alice bob
|
||||
|
||||
alice #> "/f @bob test.pdf"
|
||||
alice <## "use /fc 1 to cancel sending"
|
||||
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
||||
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
bob ##> "/fr 1"
|
||||
bob <## "saving file 1 from alice to test.pdf"
|
||||
-- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
|
||||
alice <## "completed sending file 1 (test.pdf) to bob"
|
||||
bob <## "started receiving file 1 (test.pdf) from alice"
|
||||
bob <## "completed receiving file 1 (test.pdf) from alice"
|
||||
|
||||
src <- B.readFile "./tests/fixtures/test.pdf"
|
||||
dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
|
||||
dest `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}}
|
||||
|
||||
testXFTPContinueRcv :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPContinueRcv tmp = do
|
||||
withXFTPServer $ do
|
||||
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
|
||||
connectUsers alice bob
|
||||
|
||||
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
||||
alice <## "use /fc 1 to cancel sending"
|
||||
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
||||
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
-- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
|
||||
alice <## "completed sending file 1 (test.pdf) to bob"
|
||||
|
||||
-- server is down - file is not received
|
||||
withTestChatCfg tmp cfg "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
bob ##> "/fr 1 ./tests/tmp"
|
||||
bob <## "started receiving file 1 (test.pdf) from alice"
|
||||
bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
|
||||
(bob </)
|
||||
|
||||
withXFTPServer $ do
|
||||
-- server is up - file reception is continued
|
||||
withTestChatCfg tmp cfg "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
bob <## "completed receiving file 1 (test.pdf) from alice"
|
||||
src <- B.readFile "./tests/fixtures/test.pdf"
|
||||
dest <- B.readFile "./tests/tmp/test.pdf"
|
||||
dest `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
|
||||
startFileTransfer alice bob =
|
||||
startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"
|
||||
|
||||
+2
-2
@@ -13,7 +13,7 @@ import qualified Simplex.Chat.Store as Store
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), closeSQLiteStore, createSQLiteStore, withConnection)
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..), MigrationsToRun (..), toDownMigration)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
|
||||
import Simplex.Messaging.Util (ifM)
|
||||
import Simplex.Messaging.Util (ifM, whenM)
|
||||
import System.Directory (doesFileExist, removeFile)
|
||||
import System.Process (readCreateProcess, shell)
|
||||
import Test.Hspec
|
||||
@@ -47,7 +47,7 @@ testSchemaMigrations = withTmpFiles $ do
|
||||
mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
|
||||
closeSQLiteStore st
|
||||
removeFile testDB
|
||||
removeFile testSchema
|
||||
whenM (doesFileExist testSchema) $ removeFile testSchema
|
||||
where
|
||||
testDownMigration st m = do
|
||||
putStrLn $ "down migration " <> name m
|
||||
|
||||
+1
-1
@@ -25,7 +25,7 @@ main = do
|
||||
testBracket test = do
|
||||
t <- getSystemTime
|
||||
let ts = show (systemSeconds t) <> show (systemNanoseconds t)
|
||||
withSmpServer $ withTmpFiles $ withTempDirectory "tests" ("tmp" <> ts) test
|
||||
withSmpServer $ withTmpFiles $ withTempDirectory "tests/tmp" ts test
|
||||
|
||||
logCfg :: LogConfig
|
||||
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
|
||||
|
||||
Reference in New Issue
Block a user