diff --git a/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt b/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt index 440bc6862..e3351dc12 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/model/ChatModel.kt @@ -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") diff --git a/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt b/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt index 56794e41b..04f721ec3 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt @@ -149,6 +149,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), @@ -247,6 +249,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" } } @@ -282,6 +285,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() @@ -289,7 +295,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 @@ -473,12 +478,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 @@ -1697,6 +1714,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 @@ -1776,7 +1798,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() @@ -1857,7 +1881,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)}" @@ -1939,7 +1965,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" @@ -2068,6 +2096,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) diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt index b9e3bbc62..0df2c1518 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIFileView.kt @@ -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.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), diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt index 644bacfe6..7fb2e92f9 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIImageView.kt @@ -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 -> {} diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt index a42acadea..c20df776a 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/views/chat/item/CIVoiceView.kt @@ -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 diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt b/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt index cff2b4141..cdb567554 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/views/helpers/Util.kt @@ -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" } diff --git a/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt b/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt index 3fb3ee9db..637bda9eb 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/views/usersettings/ExperimentalFeaturesView.kt @@ -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) { +fun ExperimentalFeaturesView(chatModel: ChatModel) { Column( Modifier.fillMaxWidth(), horizontalAlignment = Alignment.Start @@ -27,7 +27,11 @@ fun ExperimentalFeaturesView(chatModel: ChatModel, enableCalls: MutableStateMESSAGES CALLS Incognito mode + Send files via XFTP Your chat database diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift index 81661c2fb..26e71dbf6 100644 --- a/apps/ios/Shared/Model/SimpleXAPI.swift +++ b/apps/ios/Shared/Model/SimpleXAPI.swift @@ -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) diff --git a/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift b/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift index 3f04253e5..1445ea3df 100644 --- a/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift +++ b/apps/ios/Shared/Views/Chat/ChatItem/CIFileView.swift @@ -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)) diff --git a/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift b/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift index e17968b7e..111643e6a 100644 --- a/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift +++ b/apps/ios/Shared/Views/Chat/ChatItem/CIVoiceView.swift @@ -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)) diff --git a/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift b/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift index 5d25a489a..34c3ecb4a 100644 --- a/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift +++ b/apps/ios/Shared/Views/Chat/ChatItem/FramedCIVoiceView.swift @@ -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)) } diff --git a/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift b/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift index 0fa754ec2..fa8be9f06 100644 --- a/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift +++ b/apps/ios/Shared/Views/UserSettings/ExperimentalFeaturesView.swift @@ -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))") + } + } } } } diff --git a/apps/ios/Shared/Views/UserSettings/SettingsView.swift b/apps/ios/Shared/Views/UserSettings/SettingsView.swift index e885fc1f2..715533481 100644 --- a/apps/ios/Shared/Views/UserSettings/SettingsView.swift +++ b/apps/ios/Shared/Views/UserSettings/SettingsView.swift @@ -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") diff --git a/apps/ios/SimpleX NSE/NotificationService.swift b/apps/ios/SimpleX NSE/NotificationService.swift index 2b511f7b4..27384f157 100644 --- a/apps/ios/SimpleX NSE/NotificationService.swift +++ b/apps/ios/SimpleX NSE/NotificationService.swift @@ -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 } diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index d57d1b939..246aea230 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -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? diff --git a/apps/ios/SimpleXChat/AppGroup.swift b/apps/ios/SimpleXChat/AppGroup.swift index c93a3acbc..a738dd586 100644 --- a/apps/ios/SimpleXChat/AppGroup.swift +++ b/apps/ios/SimpleXChat/AppGroup.swift @@ -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 { } } +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 diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index d5c692f1f..d58347e31 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -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 { diff --git a/apps/ios/SimpleXChat/FileUtils.swift b/apps/ios/SimpleXChat/FileUtils.swift index 7df65f244..09cc0b996 100644 --- a/apps/ios/SimpleXChat/FileUtils.swift +++ b/apps/ios/SimpleXChat/FileUtils.swift @@ -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) } diff --git a/docs/protocol/diagrams/xftp.mmd b/docs/protocol/diagrams/xftp.mmd new file mode 100644 index 000000000..af4595207 --- /dev/null +++ b/docs/protocol/diagrams/xftp.mmd @@ -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) /
CIFSSndStored + AA ->> SMP: SEND + SMP ->> BA: MSG + BA ->> BC: MSG + BC ->> B: CRNewChatItem
(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 /
CIFSSndTransfer + AC ->> A: CRSndFileProgress (new) + AA ->> XFTP: chunks + AA ->> AC: SFDONE sd rds + AC ->> AA: sendMessage(x.msg.file.descr) /
FSComplete / CIFSSndComplete + AC ->> A: CRSndFileComplete (?) + AA ->> SMP: SEND + SMP ->> BA: MSG + BA ->> BC: MSG + BC ->> B: CRChatItemUpdated
(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
(file received) + BC ->> B: CRRcvFileComplete diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 08c66a88d..7de66a5bd 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -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 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index fc3fe7878..9db725d88 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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 = diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs index f07fba4ca..110c1dbda 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -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 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 5c1379011..1b13fc34f 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -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) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index d94cff500..f84d1ab29 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -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 diff --git a/src/Simplex/Chat/Migrations/M20230304_file_description.hs b/src/Simplex/Chat/Migrations/M20230304_file_description.hs deleted file mode 100644 index 1846de09d..000000000 --- a/src/Simplex/Chat/Migrations/M20230304_file_description.hs +++ /dev/null @@ -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; -|] diff --git a/src/Simplex/Chat/Migrations/M20230318_file_description.hs b/src/Simplex/Chat/Migrations/M20230318_file_description.hs new file mode 100644 index 000000000..39f56b2a4 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230318_file_description.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs b/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs new file mode 100644 index 000000000..97c213ea4 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20230321_agent_file_deleted.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 7eccb9a1b..ed1b30354 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -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); diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 04493351e..a4aea94bc 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -115,6 +115,7 @@ mobileChatOpts dbFilePrefix dbKey = { dbFilePrefix, dbKey, smpServers = [], + xftpServers = [], networkConfig = defaultNetworkConfig, logLevel = CLLImportant, logConnections = False, diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index 8631e7a27..20053a806 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -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 diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index fef0fd90c..1d45e2fe9 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -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} diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index ba02c6034..36ce9e863 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -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 diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 46912712e..a989a09bc 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -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 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index d5f2d616e..dcb8f3fc4 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -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 diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index b28f6c0d0..2f2d93744 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -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 [/ | ] 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 [/ | ] 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 [/ | ] 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 [/ | ] 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 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" diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index 96197f129..5a6b53156 100644 --- a/tests/SchemaDump.hs +++ b/tests/SchemaDump.hs @@ -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 diff --git a/tests/Test.hs b/tests/Test.hs index 0cbf14796..4ea3e9ef5 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -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}