Merge branch 'master-ghc8107' into master-android
This commit is contained in:
commit
9530a6055a
@ -21,10 +21,10 @@ struct SimpleXApp: App {
|
||||
@State private var enteredBackgroundAuthenticated: TimeInterval? = nil
|
||||
|
||||
init() {
|
||||
// DispatchQueue.global(qos: .background).sync {
|
||||
haskell_init()
|
||||
DispatchQueue.global(qos: .background).sync {
|
||||
haskell_init()
|
||||
// hs_init(0, nil)
|
||||
// }
|
||||
}
|
||||
UserDefaults.standard.register(defaults: appDefaults)
|
||||
setGroupDefaults()
|
||||
registerGroupDefaults()
|
||||
|
@ -143,7 +143,7 @@ struct LibraryMediaListPicker: UIViewControllerRepresentable {
|
||||
config.filter = .any(of: [.images, .videos])
|
||||
config.selectionLimit = selectionLimit
|
||||
config.selection = .ordered
|
||||
config.preferredAssetRepresentationMode = .current
|
||||
//config.preferredAssetRepresentationMode = .current
|
||||
let controller = PHPickerViewController(configuration: config)
|
||||
controller.delegate = context.coordinator
|
||||
return controller
|
||||
|
@ -442,7 +442,7 @@ func startChat() -> DBMigrationResult? {
|
||||
func doStartChat() -> DBMigrationResult? {
|
||||
logger.debug("NotificationService: doStartChat")
|
||||
hs_init(0, nil)
|
||||
let (_, dbStatus) = chatMigrateInit(confirmMigrations: defaultMigrationConfirmation())
|
||||
let (_, dbStatus) = chatMigrateInit(confirmMigrations: defaultMigrationConfirmation(), backgroundMode: true)
|
||||
if dbStatus != .ok {
|
||||
resetChatCtrl()
|
||||
NSEChatState.shared.set(.created)
|
||||
|
@ -116,11 +116,11 @@
|
||||
5CC2C0FF2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CC2C0FD2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings */; };
|
||||
5CC868F329EB540C0017BBFD /* CIRcvDecryptionError.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */; };
|
||||
5CCB939C297EFCB100399E78 /* NavStackCompat.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCB939B297EFCB100399E78 /* NavStackCompat.swift */; };
|
||||
5CCD1A882B2A5D56001A4199 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1A832B2A5D55001A4199 /* libgmp.a */; };
|
||||
5CCD1A892B2A5D56001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1A842B2A5D55001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn.a */; };
|
||||
5CCD1A8A2B2A5D56001A4199 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1A852B2A5D55001A4199 /* libgmpxx.a */; };
|
||||
5CCD1A8B2B2A5D56001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn-ghc8.10.7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1A862B2A5D55001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn-ghc8.10.7.a */; };
|
||||
5CCD1A8C2B2A5D56001A4199 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1A872B2A5D56001A4199 /* libffi.a */; };
|
||||
5CCD1B0A2B3444B9001A4199 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1B052B3444B8001A4199 /* libffi.a */; };
|
||||
5CCD1B0B2B3444B9001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1B062B3444B8001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg-ghc9.6.3.a */; };
|
||||
5CCD1B0C2B3444B9001A4199 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1B072B3444B8001A4199 /* libgmpxx.a */; };
|
||||
5CCD1B0D2B3444B9001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1B082B3444B9001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg.a */; };
|
||||
5CCD1B0E2B3444B9001A4199 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CCD1B092B3444B9001A4199 /* libgmp.a */; };
|
||||
5CCD403427A5F6DF00368C90 /* AddContactView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCD403327A5F6DF00368C90 /* AddContactView.swift */; };
|
||||
5CCD403727A5F9A200368C90 /* ScanToConnectView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCD403627A5F9A200368C90 /* ScanToConnectView.swift */; };
|
||||
5CD67B8F2B0E858A00C510B1 /* hs_init.h in Headers */ = {isa = PBXBuildFile; fileRef = 5CD67B8D2B0E858A00C510B1 /* hs_init.h */; settings = {ATTRIBUTES = (Public, ); }; };
|
||||
@ -407,11 +407,11 @@
|
||||
5CC2C0FE2809BF11000C35E3 /* ru */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ru; path = "ru.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = "<group>"; };
|
||||
5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIRcvDecryptionError.swift; sourceTree = "<group>"; };
|
||||
5CCB939B297EFCB100399E78 /* NavStackCompat.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NavStackCompat.swift; sourceTree = "<group>"; };
|
||||
5CCD1A832B2A5D55001A4199 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
|
||||
5CCD1A842B2A5D55001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn.a"; sourceTree = "<group>"; };
|
||||
5CCD1A852B2A5D55001A4199 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
|
||||
5CCD1A862B2A5D55001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn-ghc8.10.7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn-ghc8.10.7.a"; sourceTree = "<group>"; };
|
||||
5CCD1A872B2A5D56001A4199 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
|
||||
5CCD1B052B3444B8001A4199 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
|
||||
5CCD1B062B3444B8001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg-ghc9.6.3.a"; sourceTree = "<group>"; };
|
||||
5CCD1B072B3444B8001A4199 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
|
||||
5CCD1B082B3444B9001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg.a"; sourceTree = "<group>"; };
|
||||
5CCD1B092B3444B9001A4199 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
|
||||
5CCD403327A5F6DF00368C90 /* AddContactView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = AddContactView.swift; sourceTree = "<group>"; };
|
||||
5CCD403627A5F9A200368C90 /* ScanToConnectView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ScanToConnectView.swift; sourceTree = "<group>"; };
|
||||
5CD67B8D2B0E858A00C510B1 /* hs_init.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = hs_init.h; sourceTree = "<group>"; };
|
||||
@ -528,12 +528,12 @@
|
||||
buildActionMask = 2147483647;
|
||||
files = (
|
||||
5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */,
|
||||
5CCD1A8B2B2A5D56001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn-ghc8.10.7.a in Frameworks */,
|
||||
5CCD1A8A2B2A5D56001A4199 /* libgmpxx.a in Frameworks */,
|
||||
5CCD1A882B2A5D56001A4199 /* libgmp.a in Frameworks */,
|
||||
5CCD1A8C2B2A5D56001A4199 /* libffi.a in Frameworks */,
|
||||
5CCD1A892B2A5D56001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn.a in Frameworks */,
|
||||
5CCD1B0E2B3444B9001A4199 /* libgmp.a in Frameworks */,
|
||||
5CCD1B0C2B3444B9001A4199 /* libgmpxx.a in Frameworks */,
|
||||
5CCD1B0B2B3444B9001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg-ghc9.6.3.a in Frameworks */,
|
||||
5CCD1B0A2B3444B9001A4199 /* libffi.a in Frameworks */,
|
||||
5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */,
|
||||
5CCD1B0D2B3444B9001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg.a in Frameworks */,
|
||||
);
|
||||
runOnlyForDeploymentPostprocessing = 0;
|
||||
};
|
||||
@ -595,11 +595,11 @@
|
||||
5C764E5C279C70B7000C6508 /* Libraries */ = {
|
||||
isa = PBXGroup;
|
||||
children = (
|
||||
5CCD1A872B2A5D56001A4199 /* libffi.a */,
|
||||
5CCD1A832B2A5D55001A4199 /* libgmp.a */,
|
||||
5CCD1A852B2A5D55001A4199 /* libgmpxx.a */,
|
||||
5CCD1A862B2A5D55001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn-ghc8.10.7.a */,
|
||||
5CCD1A842B2A5D55001A4199 /* libHSsimplex-chat-5.4.0.7-8PiOsot1xukLpqHaIcecqn.a */,
|
||||
5CCD1B052B3444B8001A4199 /* libffi.a */,
|
||||
5CCD1B092B3444B9001A4199 /* libgmp.a */,
|
||||
5CCD1B072B3444B8001A4199 /* libgmpxx.a */,
|
||||
5CCD1B062B3444B8001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg-ghc9.6.3.a */,
|
||||
5CCD1B082B3444B9001A4199 /* libHSsimplex-chat-5.4.0.7-K3rb8mQtqiP3LyZDoNKwwg.a */,
|
||||
);
|
||||
path = Libraries;
|
||||
sourceTree = "<group>";
|
||||
|
@ -17,7 +17,7 @@ public func getChatCtrl(_ useKey: String? = nil) -> chat_ctrl {
|
||||
fatalError("chat controller not initialized")
|
||||
}
|
||||
|
||||
public func chatMigrateInit(_ useKey: String? = nil, confirmMigrations: MigrationConfirmation? = nil) -> (Bool, DBMigrationResult) {
|
||||
public func chatMigrateInit(_ useKey: String? = nil, confirmMigrations: MigrationConfirmation? = nil, backgroundMode: Bool = false) -> (Bool, DBMigrationResult) {
|
||||
if let res = migrationResult { return res }
|
||||
let dbPath = getAppDatabasePath().path
|
||||
var dbKey = ""
|
||||
@ -41,7 +41,7 @@ public func chatMigrateInit(_ useKey: String? = nil, confirmMigrations: Migratio
|
||||
var cKey = dbKey.cString(using: .utf8)!
|
||||
var cConfirm = confirm.rawValue.cString(using: .utf8)!
|
||||
// the last parameter of chat_migrate_init is used to return the pointer to chat controller
|
||||
let cjson = chat_migrate_init_key(&cPath, &cKey, 1, &cConfirm, &chatController)!
|
||||
let cjson = chat_migrate_init_key(&cPath, &cKey, 1, &cConfirm, backgroundMode ? 1 : 0, &chatController)!
|
||||
let dbRes = dbMigrationResult(fromCString(cjson))
|
||||
let encrypted = dbKey != ""
|
||||
let keychainErr = dbRes == .ok && useKeychain && encrypted && !kcDatabasePassword.set(dbKey)
|
||||
|
@ -16,7 +16,7 @@ extern void hs_init(int argc, char **argv[]);
|
||||
typedef void* chat_ctrl;
|
||||
|
||||
// the last parameter is used to return the pointer to chat controller
|
||||
extern char *chat_migrate_init_key(char *path, char *key, int keepKey, char *confirm, chat_ctrl *ctrl);
|
||||
extern char *chat_migrate_init_key(char *path, char *key, int keepKey, char *confirm, int backgroundMode, chat_ctrl *ctrl);
|
||||
extern char *chat_close_store(chat_ctrl ctl);
|
||||
extern char *chat_reopen_store(chat_ctrl ctl);
|
||||
extern char *chat_send_cmd(chat_ctrl ctl, char *cmd);
|
||||
|
@ -39,6 +39,7 @@
|
||||
android:exported="true"
|
||||
android:label="${app_name}"
|
||||
android:windowSoftInputMode="adjustResize"
|
||||
android:configChanges="uiMode"
|
||||
android:theme="@style/Theme.SimpleX">
|
||||
<intent-filter>
|
||||
<category android:name="android.intent.category.LAUNCHER" />
|
||||
|
@ -5,6 +5,7 @@ import android.net.Uri
|
||||
import android.os.*
|
||||
import android.view.WindowManager
|
||||
import androidx.activity.compose.setContent
|
||||
import androidx.appcompat.app.AppCompatDelegate
|
||||
import androidx.fragment.app.FragmentActivity
|
||||
import chat.simplex.app.model.NtfManager
|
||||
import chat.simplex.app.model.NtfManager.getUserIdFromIntent
|
||||
@ -22,6 +23,7 @@ import java.lang.ref.WeakReference
|
||||
class MainActivity: FragmentActivity() {
|
||||
|
||||
override fun onCreate(savedInstanceState: Bundle?) {
|
||||
platform.androidSetNightModeIfSupported()
|
||||
applyAppLocale(ChatModel.controller.appPrefs.appLanguage)
|
||||
super.onCreate(savedInstanceState)
|
||||
// testJson()
|
||||
|
@ -1,9 +1,8 @@
|
||||
package chat.simplex.app
|
||||
|
||||
import android.app.Application
|
||||
import android.os.Handler
|
||||
import android.os.Looper
|
||||
import chat.simplex.common.platform.Log
|
||||
import android.app.UiModeManager
|
||||
import android.os.*
|
||||
import androidx.lifecycle.*
|
||||
import androidx.work.*
|
||||
import chat.simplex.app.model.NtfManager
|
||||
@ -12,10 +11,12 @@ import chat.simplex.common.helpers.requiresIgnoringBattery
|
||||
import chat.simplex.common.model.*
|
||||
import chat.simplex.common.model.ChatController.appPrefs
|
||||
import chat.simplex.common.model.ChatModel.updatingChatsMutex
|
||||
import chat.simplex.common.platform.*
|
||||
import chat.simplex.common.ui.theme.CurrentColors
|
||||
import chat.simplex.common.ui.theme.DefaultTheme
|
||||
import chat.simplex.common.views.call.RcvCallInvitation
|
||||
import chat.simplex.common.views.helpers.*
|
||||
import chat.simplex.common.views.onboarding.OnboardingStage
|
||||
import chat.simplex.common.platform.*
|
||||
import chat.simplex.common.views.call.RcvCallInvitation
|
||||
import com.jakewharton.processphoenix.ProcessPhoenix
|
||||
import kotlinx.coroutines.*
|
||||
import kotlinx.coroutines.sync.withLock
|
||||
@ -225,6 +226,23 @@ class SimplexApp: Application(), LifecycleEventObserver {
|
||||
|
||||
override fun androidIsBackgroundCallAllowed(): Boolean = !SimplexService.isBackgroundRestricted()
|
||||
|
||||
override fun androidSetNightModeIfSupported() {
|
||||
if (Build.VERSION.SDK_INT < 31) return
|
||||
|
||||
val light = if (CurrentColors.value.name == DefaultTheme.SYSTEM.name) {
|
||||
null
|
||||
} else {
|
||||
CurrentColors.value.colors.isLight
|
||||
}
|
||||
val mode = when (light) {
|
||||
null -> UiModeManager.MODE_NIGHT_AUTO
|
||||
true -> UiModeManager.MODE_NIGHT_NO
|
||||
false -> UiModeManager.MODE_NIGHT_YES
|
||||
}
|
||||
val uiModeManager = androidAppContext.getSystemService(UI_MODE_SERVICE) as UiModeManager
|
||||
uiModeManager.setApplicationNightMode(mode)
|
||||
}
|
||||
|
||||
override suspend fun androidAskToAllowBackgroundCalls(): Boolean {
|
||||
if (SimplexService.isBackgroundRestricted()) {
|
||||
val userChoice: CompletableDeferred<Boolean> = CompletableDeferred()
|
||||
|
@ -0,0 +1,8 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<resources>
|
||||
|
||||
<style name="Theme.SimpleX" parent="Theme.AppCompat.DayNight.NoActionBar">
|
||||
<item name="android:statusBarColor">@color/black</item>
|
||||
<item name="android:windowBackground">@color/window_background_dark</item>
|
||||
</style>
|
||||
</resources>
|
@ -1,7 +1,7 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<resources>
|
||||
|
||||
<style name="Theme.SimpleX" parent="android:Theme.Material.Light.NoActionBar">
|
||||
<style name="Theme.SimpleX" parent="Theme.AppCompat.DayNight.NoActionBar">
|
||||
<item name="android:statusBarColor">@color/black</item>
|
||||
</style>
|
||||
</resources>
|
||||
|
@ -27,7 +27,6 @@ import androidx.core.view.inputmethod.EditorInfoCompat
|
||||
import androidx.core.view.inputmethod.InputConnectionCompat
|
||||
import androidx.core.widget.doAfterTextChanged
|
||||
import androidx.core.widget.doOnTextChanged
|
||||
import chat.simplex.common.*
|
||||
import chat.simplex.common.R
|
||||
import chat.simplex.common.helpers.toURI
|
||||
import chat.simplex.common.model.ChatModel
|
||||
@ -45,6 +44,7 @@ import java.net.URI
|
||||
actual fun PlatformTextField(
|
||||
composeState: MutableState<ComposeState>,
|
||||
sendMsgEnabled: Boolean,
|
||||
sendMsgButtonDisabled: Boolean,
|
||||
textStyle: MutableState<TextStyle>,
|
||||
showDeleteTextButton: MutableState<Boolean>,
|
||||
userIsObserver: Boolean,
|
||||
|
@ -65,9 +65,9 @@ extern char *chat_parse_markdown(const char *str);
|
||||
extern char *chat_parse_server(const char *str);
|
||||
extern char *chat_password_hash(const char *pwd, const char *salt);
|
||||
extern char *chat_valid_name(const char *name);
|
||||
extern char *chat_write_file(const char *path, char *ptr, int length);
|
||||
extern char *chat_write_file(chat_ctrl ctrl, const char *path, char *ptr, int length);
|
||||
extern char *chat_read_file(const char *path, const char *key, const char *nonce);
|
||||
extern char *chat_encrypt_file(const char *from_path, const char *to_path);
|
||||
extern char *chat_encrypt_file(chat_ctrl ctrl, const char *from_path, const char *to_path);
|
||||
extern char *chat_decrypt_file(const char *from_path, const char *key, const char *nonce, const char *to_path);
|
||||
|
||||
JNIEXPORT jobjectArray JNICALL
|
||||
@ -157,11 +157,11 @@ Java_chat_simplex_common_platform_CoreKt_chatValidName(JNIEnv *env, jclass clazz
|
||||
}
|
||||
|
||||
JNIEXPORT jstring JNICALL
|
||||
Java_chat_simplex_common_platform_CoreKt_chatWriteFile(JNIEnv *env, jclass clazz, jstring path, jobject buffer) {
|
||||
Java_chat_simplex_common_platform_CoreKt_chatWriteFile(JNIEnv *env, jclass clazz, jlong controller, jstring path, jobject buffer) {
|
||||
const char *_path = (*env)->GetStringUTFChars(env, path, JNI_FALSE);
|
||||
jbyte *buff = (jbyte *) (*env)->GetDirectBufferAddress(env, buffer);
|
||||
jlong capacity = (*env)->GetDirectBufferCapacity(env, buffer);
|
||||
jstring res = (*env)->NewStringUTF(env, chat_write_file(_path, buff, capacity));
|
||||
jstring res = (*env)->NewStringUTF(env, chat_write_file((void*)controller, _path, buff, capacity));
|
||||
(*env)->ReleaseStringUTFChars(env, path, _path);
|
||||
return res;
|
||||
}
|
||||
@ -206,10 +206,10 @@ Java_chat_simplex_common_platform_CoreKt_chatReadFile(JNIEnv *env, jclass clazz,
|
||||
}
|
||||
|
||||
JNIEXPORT jstring JNICALL
|
||||
Java_chat_simplex_common_platform_CoreKt_chatEncryptFile(JNIEnv *env, jclass clazz, jstring from_path, jstring to_path) {
|
||||
Java_chat_simplex_common_platform_CoreKt_chatEncryptFile(JNIEnv *env, jclass clazz, jlong controller, jstring from_path, jstring to_path) {
|
||||
const char *_from_path = (*env)->GetStringUTFChars(env, from_path, JNI_FALSE);
|
||||
const char *_to_path = (*env)->GetStringUTFChars(env, to_path, JNI_FALSE);
|
||||
jstring res = (*env)->NewStringUTF(env, chat_encrypt_file(_from_path, _to_path));
|
||||
jstring res = (*env)->NewStringUTF(env, chat_encrypt_file((void*)controller, _from_path, _to_path));
|
||||
(*env)->ReleaseStringUTFChars(env, from_path, _from_path);
|
||||
(*env)->ReleaseStringUTFChars(env, to_path, _to_path);
|
||||
return res;
|
||||
|
@ -38,9 +38,9 @@ extern char *chat_parse_markdown(const char *str);
|
||||
extern char *chat_parse_server(const char *str);
|
||||
extern char *chat_password_hash(const char *pwd, const char *salt);
|
||||
extern char *chat_valid_name(const char *name);
|
||||
extern char *chat_write_file(const char *path, char *ptr, int length);
|
||||
extern char *chat_write_file(chat_ctrl ctrl, const char *path, char *ptr, int length);
|
||||
extern char *chat_read_file(const char *path, const char *key, const char *nonce);
|
||||
extern char *chat_encrypt_file(const char *from_path, const char *to_path);
|
||||
extern char *chat_encrypt_file(chat_ctrl ctrl, const char *from_path, const char *to_path);
|
||||
extern char *chat_decrypt_file(const char *from_path, const char *key, const char *nonce, const char *to_path);
|
||||
|
||||
// As a reference: https://stackoverflow.com/a/60002045
|
||||
@ -167,11 +167,11 @@ Java_chat_simplex_common_platform_CoreKt_chatValidName(JNIEnv *env, jclass clazz
|
||||
}
|
||||
|
||||
JNIEXPORT jstring JNICALL
|
||||
Java_chat_simplex_common_platform_CoreKt_chatWriteFile(JNIEnv *env, jclass clazz, jstring path, jobject buffer) {
|
||||
Java_chat_simplex_common_platform_CoreKt_chatWriteFile(JNIEnv *env, jclass clazz, jlong controller, jstring path, jobject buffer) {
|
||||
const char *_path = encode_to_utf8_chars(env, path);
|
||||
jbyte *buff = (jbyte *) (*env)->GetDirectBufferAddress(env, buffer);
|
||||
jlong capacity = (*env)->GetDirectBufferCapacity(env, buffer);
|
||||
jstring res = decode_to_utf8_string(env, chat_write_file(_path, buff, capacity));
|
||||
jstring res = decode_to_utf8_string(env, chat_write_file((void*)controller, _path, buff, capacity));
|
||||
(*env)->ReleaseStringUTFChars(env, path, _path);
|
||||
return res;
|
||||
}
|
||||
@ -216,10 +216,10 @@ Java_chat_simplex_common_platform_CoreKt_chatReadFile(JNIEnv *env, jclass clazz,
|
||||
}
|
||||
|
||||
JNIEXPORT jstring JNICALL
|
||||
Java_chat_simplex_common_platform_CoreKt_chatEncryptFile(JNIEnv *env, jclass clazz, jstring from_path, jstring to_path) {
|
||||
Java_chat_simplex_common_platform_CoreKt_chatEncryptFile(JNIEnv *env, jclass clazz, jlong controller, jstring from_path, jstring to_path) {
|
||||
const char *_from_path = encode_to_utf8_chars(env, from_path);
|
||||
const char *_to_path = encode_to_utf8_chars(env, to_path);
|
||||
jstring res = decode_to_utf8_string(env, chat_encrypt_file(_from_path, _to_path));
|
||||
jstring res = decode_to_utf8_string(env, chat_encrypt_file((void*)controller, _from_path, _to_path));
|
||||
(*env)->ReleaseStringUTFChars(env, from_path, _from_path);
|
||||
(*env)->ReleaseStringUTFChars(env, to_path, _to_path);
|
||||
return res;
|
||||
|
@ -21,10 +21,11 @@ sealed class WriteFileResult {
|
||||
* */
|
||||
|
||||
fun writeCryptoFile(path: String, data: ByteArray): CryptoFileArgs {
|
||||
val ctrl = ChatController.ctrl ?: throw Exception("Controller is not initialized")
|
||||
val buffer = ByteBuffer.allocateDirect(data.size)
|
||||
buffer.put(data)
|
||||
buffer.rewind()
|
||||
val str = chatWriteFile(path, buffer)
|
||||
val str = chatWriteFile(ctrl, path, buffer)
|
||||
return when (val d = json.decodeFromString(WriteFileResult.serializer(), str)) {
|
||||
is WriteFileResult.Result -> d.cryptoArgs
|
||||
is WriteFileResult.Error -> throw Exception(d.writeError)
|
||||
@ -43,7 +44,8 @@ fun readCryptoFile(path: String, cryptoArgs: CryptoFileArgs): ByteArray {
|
||||
}
|
||||
|
||||
fun encryptCryptoFile(fromPath: String, toPath: String): CryptoFileArgs {
|
||||
val str = chatEncryptFile(fromPath, toPath)
|
||||
val ctrl = ChatController.ctrl ?: throw Exception("Controller is not initialized")
|
||||
val str = chatEncryptFile(ctrl, fromPath, toPath)
|
||||
val d = json.decodeFromString(WriteFileResult.serializer(), str)
|
||||
return when (d) {
|
||||
is WriteFileResult.Result -> d.cryptoArgs
|
||||
|
@ -22,9 +22,9 @@ external fun chatParseMarkdown(str: String): String
|
||||
external fun chatParseServer(str: String): String
|
||||
external fun chatPasswordHash(pwd: String, salt: String): String
|
||||
external fun chatValidName(name: String): String
|
||||
external fun chatWriteFile(path: String, buffer: ByteBuffer): String
|
||||
external fun chatWriteFile(ctrl: ChatCtrl, path: String, buffer: ByteBuffer): String
|
||||
external fun chatReadFile(path: String, key: String, nonce: String): Array<Any>
|
||||
external fun chatEncryptFile(fromPath: String, toPath: String): String
|
||||
external fun chatEncryptFile(ctrl: ChatCtrl, fromPath: String, toPath: String): String
|
||||
external fun chatDecryptFile(fromPath: String, key: String, nonce: String, toPath: String): String
|
||||
|
||||
val chatModel: ChatModel
|
||||
|
@ -10,6 +10,7 @@ interface PlatformInterface {
|
||||
fun androidChatStopped() {}
|
||||
fun androidChatInitializedAndStarted() {}
|
||||
fun androidIsBackgroundCallAllowed(): Boolean = true
|
||||
fun androidSetNightModeIfSupported() {}
|
||||
suspend fun androidAskToAllowBackgroundCalls(): Boolean = true
|
||||
}
|
||||
/**
|
||||
|
@ -4,13 +4,13 @@ import androidx.compose.runtime.Composable
|
||||
import androidx.compose.runtime.MutableState
|
||||
import androidx.compose.ui.text.TextStyle
|
||||
import chat.simplex.common.views.chat.ComposeState
|
||||
import java.io.File
|
||||
import java.net.URI
|
||||
|
||||
@Composable
|
||||
expect fun PlatformTextField(
|
||||
composeState: MutableState<ComposeState>,
|
||||
sendMsgEnabled: Boolean,
|
||||
sendMsgButtonDisabled: Boolean,
|
||||
textStyle: MutableState<TextStyle>,
|
||||
showDeleteTextButton: MutableState<Boolean>,
|
||||
userIsObserver: Boolean,
|
||||
|
@ -7,6 +7,7 @@ import androidx.compose.ui.text.font.FontFamily
|
||||
import chat.simplex.res.MR
|
||||
import chat.simplex.common.model.AppPreferences
|
||||
import chat.simplex.common.model.ChatController
|
||||
import chat.simplex.common.platform.platform
|
||||
import chat.simplex.common.views.helpers.generalGetString
|
||||
|
||||
// https://github.com/rsms/inter
|
||||
@ -96,6 +97,7 @@ object ThemeManager {
|
||||
fun applyTheme(theme: String, darkForSystemTheme: Boolean) {
|
||||
appPrefs.currentTheme.set(theme)
|
||||
CurrentColors.value = currentColors(darkForSystemTheme)
|
||||
platform.androidSetNightModeIfSupported()
|
||||
}
|
||||
|
||||
fun changeDarkTheme(theme: String, darkForSystemTheme: Boolean) {
|
||||
|
@ -29,7 +29,6 @@ import chat.simplex.res.MR
|
||||
import dev.icerock.moko.resources.compose.stringResource
|
||||
import dev.icerock.moko.resources.compose.painterResource
|
||||
import kotlinx.coroutines.*
|
||||
import java.io.File
|
||||
import java.net.URI
|
||||
|
||||
@Composable
|
||||
@ -82,7 +81,10 @@ fun SendMsgView(
|
||||
val showVoiceButton = !nextSendGrpInv && cs.message.isEmpty() && showVoiceRecordIcon && !composeState.value.editing &&
|
||||
cs.liveMessage == null && (cs.preview is ComposePreview.NoPreview || recState.value is RecordingState.Started)
|
||||
val showDeleteTextButton = rememberSaveable { mutableStateOf(false) }
|
||||
PlatformTextField(composeState, sendMsgEnabled, textStyle, showDeleteTextButton, userIsObserver, onMessageChange, editPrevMessage, onFilesPasted) {
|
||||
val sendMsgButtonDisabled = !sendMsgEnabled || !cs.sendEnabled() ||
|
||||
(!allowedVoiceByPrefs && cs.preview is ComposePreview.VoicePreview) ||
|
||||
cs.endLiveDisabled
|
||||
PlatformTextField(composeState, sendMsgEnabled, sendMsgButtonDisabled, textStyle, showDeleteTextButton, userIsObserver, onMessageChange, editPrevMessage, onFilesPasted) {
|
||||
if (!cs.inProgress) {
|
||||
sendMessage(null)
|
||||
}
|
||||
@ -155,9 +157,6 @@ fun SendMsgView(
|
||||
else -> {
|
||||
val cs = composeState.value
|
||||
val icon = if (cs.editing || cs.liveMessage != null) painterResource(MR.images.ic_check_filled) else painterResource(MR.images.ic_arrow_upward)
|
||||
val disabled = !sendMsgEnabled || !cs.sendEnabled() ||
|
||||
(!allowedVoiceByPrefs && cs.preview is ComposePreview.VoicePreview) ||
|
||||
cs.endLiveDisabled
|
||||
val showDropdown = rememberSaveable { mutableStateOf(false) }
|
||||
|
||||
@Composable
|
||||
@ -200,12 +199,12 @@ fun SendMsgView(
|
||||
|
||||
val menuItems = MenuItems()
|
||||
if (menuItems.isNotEmpty()) {
|
||||
SendMsgButton(icon, sendButtonSize, sendButtonAlpha, sendButtonColor, !disabled, sendMessage) { showDropdown.value = true }
|
||||
SendMsgButton(icon, sendButtonSize, sendButtonAlpha, sendButtonColor, !sendMsgButtonDisabled, sendMessage) { showDropdown.value = true }
|
||||
DefaultDropdownMenu(showDropdown) {
|
||||
menuItems.forEach { composable -> composable() }
|
||||
}
|
||||
} else {
|
||||
SendMsgButton(icon, sendButtonSize, sendButtonAlpha, sendButtonColor, !disabled, sendMessage)
|
||||
SendMsgButton(icon, sendButtonSize, sendButtonAlpha, sendButtonColor, !sendMsgButtonDisabled, sendMessage)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -195,7 +195,13 @@ fun ChatItemView(
|
||||
}
|
||||
val clipboard = LocalClipboardManager.current
|
||||
val cachedRemoteReqs = remember { CIFile.cachedRemoteFileRequests }
|
||||
val copyAndShareAllowed = cItem.file == null || !chatModel.connectedToRemote() || getLoadedFilePath(cItem.file) != null || cachedRemoteReqs[cItem.file.fileSource] != false
|
||||
val copyAndShareAllowed = when {
|
||||
cItem.content.text.isNotEmpty() -> true
|
||||
cItem.file != null && chatModel.connectedToRemote() && cachedRemoteReqs[cItem.file.fileSource] != false && cItem.file.loaded -> true
|
||||
getLoadedFilePath(cItem.file) != null -> true
|
||||
else -> false
|
||||
}
|
||||
|
||||
if (copyAndShareAllowed) {
|
||||
ItemAction(stringResource(MR.strings.share_verb), painterResource(MR.images.ic_share), onClick = {
|
||||
var fileSource = getLoadedFileSource(cItem.file)
|
||||
@ -221,7 +227,7 @@ fun ChatItemView(
|
||||
showMenu.value = false
|
||||
})
|
||||
}
|
||||
if ((cItem.content.msgContent is MsgContent.MCImage || cItem.content.msgContent is MsgContent.MCVideo || cItem.content.msgContent is MsgContent.MCFile || cItem.content.msgContent is MsgContent.MCVoice) && (getLoadedFilePath(cItem.file) != null || (chatModel.connectedToRemote() && cachedRemoteReqs[cItem.file?.fileSource] != false))) {
|
||||
if ((cItem.content.msgContent is MsgContent.MCImage || cItem.content.msgContent is MsgContent.MCVideo || cItem.content.msgContent is MsgContent.MCFile || cItem.content.msgContent is MsgContent.MCVoice) && (getLoadedFilePath(cItem.file) != null || (chatModel.connectedToRemote() && cachedRemoteReqs[cItem.file?.fileSource] != false && cItem.file?.loaded == true))) {
|
||||
SaveContentItemAction(cItem, saveFileLauncher, showMenu)
|
||||
}
|
||||
if (cItem.meta.editable && cItem.content.msgContent !is MsgContent.MCVoice && !live) {
|
||||
|
@ -270,7 +270,7 @@ private fun DatabaseKeyField(text: MutableState<String>, enabled: Boolean, onCli
|
||||
} else null
|
||||
),
|
||||
modifier = Modifier.focusRequester(focusRequester).onPreviewKeyEvent {
|
||||
if (onClick != null && it.key == Key.Enter && it.type == KeyEventType.KeyUp) {
|
||||
if (onClick != null && (it.key == Key.Enter || it.key == Key.NumPadEnter) && it.type == KeyEventType.KeyUp) {
|
||||
onClick()
|
||||
true
|
||||
} else {
|
||||
|
@ -120,7 +120,7 @@ private fun SetupDatabasePassphraseLayout(
|
||||
.padding(horizontal = DEFAULT_PADDING)
|
||||
.focusRequester(focusRequester)
|
||||
.onPreviewKeyEvent {
|
||||
if (it.key == Key.Enter && it.type == KeyEventType.KeyUp) {
|
||||
if ((it.key == Key.Enter || it.key == Key.NumPadEnter) && it.type == KeyEventType.KeyUp) {
|
||||
focusManager.moveFocus(FocusDirection.Down)
|
||||
true
|
||||
} else {
|
||||
@ -150,7 +150,7 @@ private fun SetupDatabasePassphraseLayout(
|
||||
modifier = Modifier
|
||||
.padding(horizontal = DEFAULT_PADDING)
|
||||
.onPreviewKeyEvent {
|
||||
if (!disabled && it.key == Key.Enter && it.type == KeyEventType.KeyUp) {
|
||||
if (!disabled && (it.key == Key.Enter || it.key == Key.NumPadEnter) && it.type == KeyEventType.KeyUp) {
|
||||
onClickUpdate()
|
||||
true
|
||||
} else {
|
||||
|
@ -45,6 +45,7 @@ import kotlin.text.substring
|
||||
actual fun PlatformTextField(
|
||||
composeState: MutableState<ComposeState>,
|
||||
sendMsgEnabled: Boolean,
|
||||
sendMsgButtonDisabled: Boolean,
|
||||
textStyle: MutableState<TextStyle>,
|
||||
showDeleteTextButton: MutableState<Boolean>,
|
||||
userIsObserver: Boolean,
|
||||
@ -103,7 +104,7 @@ actual fun PlatformTextField(
|
||||
.padding(vertical = 4.dp)
|
||||
.focusRequester(focusRequester)
|
||||
.onPreviewKeyEvent {
|
||||
if (it.key == Key.Enter && it.type == KeyEventType.KeyDown) {
|
||||
if ((it.key == Key.Enter || it.key == Key.NumPadEnter) && it.type == KeyEventType.KeyDown) {
|
||||
if (it.isShiftPressed) {
|
||||
val start = if (minOf(textFieldValue.selection.min) == 0) "" else textFieldValue.text.substring(0 until textFieldValue.selection.min)
|
||||
val newText = start + "\n" +
|
||||
@ -113,7 +114,7 @@ actual fun PlatformTextField(
|
||||
selection = TextRange(textFieldValue.selection.min + 1)
|
||||
)
|
||||
onMessageChange(newText)
|
||||
} else if (cs.message.isNotEmpty()) {
|
||||
} else if (!sendMsgButtonDisabled) {
|
||||
onDone()
|
||||
}
|
||||
true
|
||||
|
@ -1,3 +1,3 @@
|
||||
# SimpleX Chat CLI app
|
||||
|
||||
See [repo REAMDE](../../README.md#zap-quick-installation-of-a-terminal-app) for installation and usage instructions.
|
||||
See [repo README](../../README.md#zap-quick-installation-of-a-terminal-app) for installation and usage instructions.
|
||||
|
@ -14,7 +14,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: 13a60d1d3944aa175311563e661161e759b92563
|
||||
tag: 46056557f833c54ce8e7fc94cba447a5e116e939
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
@ -173,7 +173,7 @@ This message is used to delete previously sent chat items. Receiving clients MUS
|
||||
|
||||
When content message `x.msg.new` contains file attachment (the invitation to receive the file), this sub-protocol is used to accept this file or to notify the recipient that sending the file was cancelled.
|
||||
|
||||
File attachement can optionally include connection address to receive the file - clients MUST include it when sending files to direct connections, and MUST NOT include it when sending file attachment to the group (as different members would need different connections to receive the file).
|
||||
File attachment can optionally include connection address to receive the file - clients MUST include it when sending files to direct connections, and MUST NOT include it when sending file attachment to the group (as different members would need different connections to receive the file).
|
||||
|
||||
`x.file.acpt` message is used to accept the file in case when file connection address was included in the message (that is the case when the file invitation was sent in direct message). It is sent as part of file connection handshake via file connection, that is why this message contains no reference to the file - the used connection provides sufficient context for the sender.
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: simplex-chat
|
||||
version: 5.4.0.7
|
||||
version: 5.4.2.0
|
||||
#synopsis:
|
||||
#description:
|
||||
homepage: https://github.com/simplex-chat/simplex-chat#readme
|
||||
|
@ -1,5 +1,5 @@
|
||||
{
|
||||
"https://github.com/simplex-chat/simplexmq.git"."13a60d1d3944aa175311563e661161e759b92563" = "08mvqrbjfnq7c6mhkj4hhy4cxn0cj21n49lqzh67ani71g2g1xwa";
|
||||
"https://github.com/simplex-chat/simplexmq.git"."46056557f833c54ce8e7fc94cba447a5e116e939" = "1zyw7nhd678gk4806jw1fbr1ibnfp71mnzy68dg6r9607qnmqy9y";
|
||||
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
|
||||
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
|
||||
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
|
||||
|
@ -5,7 +5,7 @@ cabal-version: 1.12
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: simplex-chat
|
||||
version: 5.4.0.7
|
||||
version: 5.4.2.0
|
||||
category: Web, System, Services, Cryptography
|
||||
homepage: https://github.com/simplex-chat/simplex-chat#readme
|
||||
author: simplex.chat
|
||||
@ -36,6 +36,7 @@ library
|
||||
Simplex.Chat.Help
|
||||
Simplex.Chat.Markdown
|
||||
Simplex.Chat.Messages
|
||||
Simplex.Chat.Messages.Batch
|
||||
Simplex.Chat.Messages.CIContent
|
||||
Simplex.Chat.Messages.CIContent.Events
|
||||
Simplex.Chat.Migrations.M20220101_initial
|
||||
@ -127,6 +128,7 @@ library
|
||||
Simplex.Chat.Migrations.M20231126_remote_ctrl_address
|
||||
Simplex.Chat.Migrations.M20231207_chat_list_pagination
|
||||
Simplex.Chat.Migrations.M20231214_item_content_tag
|
||||
Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.File
|
||||
Simplex.Chat.Mobile.Shared
|
||||
@ -543,6 +545,7 @@ test-suite simplex-chat-test
|
||||
ChatTests.Utils
|
||||
JSONTests
|
||||
MarkdownTests
|
||||
MessageBatching
|
||||
MobileTests
|
||||
ProtocolTests
|
||||
RemoteTests
|
||||
|
@ -28,6 +28,7 @@ import Data.Bifunctor (bimap, first)
|
||||
import Data.ByteArray (ScrubbedBytes)
|
||||
import qualified Data.ByteArray as BA
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import Data.ByteString.Builder (toLazyByteString)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
@ -37,20 +38,19 @@ import Data.Either (fromRight, lefts, partitionEithers, rights)
|
||||
import Data.Fixed (div')
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
import Data.List (find, foldl', isSuffixOf, partition, sortBy, sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
||||
import Data.List (find, foldl', isSuffixOf, partition, sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty (..), nonEmpty, toList, (<|))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
|
||||
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
|
||||
import Data.Time.Clock.System (systemToUTCTime)
|
||||
import Data.Word (Word16, Word32)
|
||||
import Data.Word (Word32)
|
||||
import qualified Database.SQLite.Simple as SQL
|
||||
import Simplex.Chat.Archive
|
||||
import Simplex.Chat.Call
|
||||
@ -58,6 +58,7 @@ import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Files
|
||||
import Simplex.Chat.Markdown
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.Batch (MsgBatch (..), batchMessages)
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Messages.CIContent.Events
|
||||
import Simplex.Chat.Options
|
||||
@ -76,7 +77,7 @@ import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Util
|
||||
import Simplex.Chat.Util (encryptFile)
|
||||
import Simplex.Chat.Util (encryptFile, shuffle)
|
||||
import Simplex.FileTransfer.Client.Main (maxFileSize)
|
||||
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
|
||||
import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
|
||||
@ -196,79 +197,84 @@ createChatDatabase filePrefix key keepKey confirmMigrations = runExceptT $ do
|
||||
agentStore <- ExceptT $ createAgentStore (agentStoreFile filePrefix) key keepKey confirmMigrations
|
||||
pure ChatDatabase {chatStore, agentStore}
|
||||
|
||||
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> IO ChatController
|
||||
newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir, deviceNameForRemote} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} = do
|
||||
let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
|
||||
config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
|
||||
firstTime = dbNew chatStore
|
||||
currentUser <- newTVarIO user
|
||||
currentRemoteHost <- newTVarIO Nothing
|
||||
servers <- agentServers config
|
||||
smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore
|
||||
agentAsync <- newTVarIO Nothing
|
||||
random <- liftIO C.newRandom
|
||||
inputQ <- newTBQueueIO tbqSize
|
||||
outputQ <- newTBQueueIO tbqSize
|
||||
connNetworkStatuses <- atomically TM.empty
|
||||
subscriptionMode <- newTVarIO SMSubscribe
|
||||
chatLock <- newEmptyTMVarIO
|
||||
sndFiles <- newTVarIO M.empty
|
||||
rcvFiles <- newTVarIO M.empty
|
||||
currentCalls <- atomically TM.empty
|
||||
localDeviceName <- newTVarIO $ fromMaybe deviceNameForRemote deviceName
|
||||
multicastSubscribers <- newTMVarIO 0
|
||||
remoteSessionSeq <- newTVarIO 0
|
||||
remoteHostSessions <- atomically TM.empty
|
||||
remoteHostsFolder <- newTVarIO Nothing
|
||||
remoteCtrlSession <- newTVarIO Nothing
|
||||
filesFolder <- newTVarIO optFilesFolder
|
||||
chatStoreChanged <- newTVarIO False
|
||||
expireCIThreads <- newTVarIO M.empty
|
||||
expireCIFlags <- newTVarIO M.empty
|
||||
cleanupManagerAsync <- newTVarIO Nothing
|
||||
timedItemThreads <- atomically TM.empty
|
||||
showLiveItems <- newTVarIO False
|
||||
encryptLocalFiles <- newTVarIO False
|
||||
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
|
||||
tempDirectory <- newTVarIO tempDir
|
||||
contactMergeEnabled <- newTVarIO True
|
||||
pure
|
||||
ChatController
|
||||
{ firstTime,
|
||||
currentUser,
|
||||
currentRemoteHost,
|
||||
smpAgent,
|
||||
agentAsync,
|
||||
chatStore,
|
||||
chatStoreChanged,
|
||||
random,
|
||||
inputQ,
|
||||
outputQ,
|
||||
connNetworkStatuses,
|
||||
subscriptionMode,
|
||||
chatLock,
|
||||
sndFiles,
|
||||
rcvFiles,
|
||||
currentCalls,
|
||||
localDeviceName,
|
||||
multicastSubscribers,
|
||||
remoteSessionSeq,
|
||||
remoteHostSessions,
|
||||
remoteHostsFolder,
|
||||
remoteCtrlSession,
|
||||
config,
|
||||
filesFolder,
|
||||
expireCIThreads,
|
||||
expireCIFlags,
|
||||
cleanupManagerAsync,
|
||||
timedItemThreads,
|
||||
showLiveItems,
|
||||
encryptLocalFiles,
|
||||
userXFTPFileConfig,
|
||||
tempDirectory,
|
||||
logFilePath = logFile,
|
||||
contactMergeEnabled
|
||||
}
|
||||
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Bool -> IO ChatController
|
||||
newChatController
|
||||
ChatDatabase {chatStore, agentStore}
|
||||
user
|
||||
cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir, deviceNameForRemote}
|
||||
ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize}
|
||||
backgroundMode = do
|
||||
let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
|
||||
config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
|
||||
firstTime = dbNew chatStore
|
||||
currentUser <- newTVarIO user
|
||||
currentRemoteHost <- newTVarIO Nothing
|
||||
servers <- agentServers config
|
||||
smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore backgroundMode
|
||||
agentAsync <- newTVarIO Nothing
|
||||
random <- liftIO C.newRandom
|
||||
inputQ <- newTBQueueIO tbqSize
|
||||
outputQ <- newTBQueueIO tbqSize
|
||||
connNetworkStatuses <- atomically TM.empty
|
||||
subscriptionMode <- newTVarIO SMSubscribe
|
||||
chatLock <- newEmptyTMVarIO
|
||||
sndFiles <- newTVarIO M.empty
|
||||
rcvFiles <- newTVarIO M.empty
|
||||
currentCalls <- atomically TM.empty
|
||||
localDeviceName <- newTVarIO $ fromMaybe deviceNameForRemote deviceName
|
||||
multicastSubscribers <- newTMVarIO 0
|
||||
remoteSessionSeq <- newTVarIO 0
|
||||
remoteHostSessions <- atomically TM.empty
|
||||
remoteHostsFolder <- newTVarIO Nothing
|
||||
remoteCtrlSession <- newTVarIO Nothing
|
||||
filesFolder <- newTVarIO optFilesFolder
|
||||
chatStoreChanged <- newTVarIO False
|
||||
expireCIThreads <- newTVarIO M.empty
|
||||
expireCIFlags <- newTVarIO M.empty
|
||||
cleanupManagerAsync <- newTVarIO Nothing
|
||||
timedItemThreads <- atomically TM.empty
|
||||
showLiveItems <- newTVarIO False
|
||||
encryptLocalFiles <- newTVarIO False
|
||||
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
|
||||
tempDirectory <- newTVarIO tempDir
|
||||
contactMergeEnabled <- newTVarIO True
|
||||
pure
|
||||
ChatController
|
||||
{ firstTime,
|
||||
currentUser,
|
||||
currentRemoteHost,
|
||||
smpAgent,
|
||||
agentAsync,
|
||||
chatStore,
|
||||
chatStoreChanged,
|
||||
random,
|
||||
inputQ,
|
||||
outputQ,
|
||||
connNetworkStatuses,
|
||||
subscriptionMode,
|
||||
chatLock,
|
||||
sndFiles,
|
||||
rcvFiles,
|
||||
currentCalls,
|
||||
localDeviceName,
|
||||
multicastSubscribers,
|
||||
remoteSessionSeq,
|
||||
remoteHostSessions,
|
||||
remoteHostsFolder,
|
||||
remoteCtrlSession,
|
||||
config,
|
||||
filesFolder,
|
||||
expireCIThreads,
|
||||
expireCIFlags,
|
||||
cleanupManagerAsync,
|
||||
timedItemThreads,
|
||||
showLiveItems,
|
||||
encryptLocalFiles,
|
||||
userXFTPFileConfig,
|
||||
tempDirectory,
|
||||
logFilePath = logFile,
|
||||
contactMergeEnabled
|
||||
}
|
||||
where
|
||||
configServers :: DefaultAgentServers
|
||||
configServers =
|
||||
@ -601,7 +607,7 @@ processChatCommand = \case
|
||||
<$> withConnection st (readTVarIO . DB.slow)
|
||||
APIGetChats {userId, pendingConnections, pagination, query} -> withUserId' userId $ \user -> do
|
||||
(errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user pendingConnections pagination query)
|
||||
toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
|
||||
pure $ CRApiChats user previews
|
||||
APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
|
||||
-- TODO optimize queries calculating ChatStats, currently they're disabled
|
||||
@ -682,7 +688,7 @@ processChatCommand = \case
|
||||
withStore $ \db -> getDirectChatItem db user chatId quotedItemId
|
||||
(origQmc, qd, sent) <- quoteData qci
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
|
||||
qmc = quoteContent origQmc file
|
||||
qmc = quoteContent mc origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
|
||||
where
|
||||
@ -696,22 +702,22 @@ processChatCommand = \case
|
||||
assertUserGroupRole gInfo GRAuthor
|
||||
send g
|
||||
where
|
||||
send g@(Group gInfo@GroupInfo {groupId, membership} ms)
|
||||
send g@(Group gInfo@GroupInfo {groupId} ms)
|
||||
| isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
|
||||
| not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
|
||||
| otherwise = do
|
||||
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
|
||||
timed_ <- sndGroupCITimed live gInfo itemTTL
|
||||
(msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
|
||||
(msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
|
||||
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
|
||||
withStore' $ \db ->
|
||||
forM_ sentToMembers $ \GroupMember {groupMemberId} ->
|
||||
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
|
||||
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
|
||||
forM_ (timed_ >>= timedDeleteAt') $
|
||||
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
|
||||
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
|
||||
(fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
|
||||
timed_ <- sndGroupCITimed live gInfo itemTTL
|
||||
(msgContainer, quotedItem_) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ timed_ live
|
||||
(msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
|
||||
ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
|
||||
withStore' $ \db ->
|
||||
forM_ sentToMembers $ \GroupMember {groupMemberId} ->
|
||||
createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
|
||||
mapM_ (sendGroupFileInline ms sharedMsgId) ft_
|
||||
forM_ (timed_ >>= timedDeleteAt') $
|
||||
startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
|
||||
pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
|
||||
notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f))
|
||||
setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
|
||||
setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
|
||||
@ -742,51 +748,9 @@ processChatCommand = \case
|
||||
void . withStore' $ \db -> createSndGroupInlineFT db m conn ft
|
||||
sendMemberFileInline m conn ft sharedMsgId
|
||||
processMember _ = pure ()
|
||||
prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||
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
|
||||
(origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
|
||||
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 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
|
||||
quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
|
||||
quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
|
||||
quoteData _ _ = throwChatError CEInvalidQuote
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
where
|
||||
quoteContent :: forall d. MsgContent -> Maybe (CIFile d) -> MsgContent
|
||||
quoteContent qmc ciFile_
|
||||
| replaceContent = MCText qTextOrFile
|
||||
| otherwise = case qmc of
|
||||
MCImage _ image -> MCImage qTextOrFile image
|
||||
MCFile _ -> MCFile qTextOrFile
|
||||
-- consider same for voice messages
|
||||
-- MCVoice _ voice -> MCVoice qTextOrFile voice
|
||||
_ -> qmc
|
||||
where
|
||||
-- if the message we're quoting with is one of the "large" MsgContents
|
||||
-- we replace the quote's content with MCText
|
||||
replaceContent = case mc of
|
||||
MCText _ -> False
|
||||
MCFile _ -> False
|
||||
MCLink {} -> True
|
||||
MCImage {} -> True
|
||||
MCVideo {} -> True
|
||||
MCVoice {} -> False
|
||||
MCUnknown {} -> True
|
||||
qText = msgContentText qmc
|
||||
getFileName :: CIFile d -> String
|
||||
getFileName CIFile {fileName} = fileName
|
||||
qFileName = maybe qText (T.pack . getFileName) ciFile_
|
||||
qTextOrFile = if T.null qText then qFileName else qText
|
||||
xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
|
||||
xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do
|
||||
let fileName = takeFileName filePath
|
||||
@ -1831,7 +1795,7 @@ processChatCommand = \case
|
||||
LastChats count_ -> withUser' $ \user -> do
|
||||
let count = fromMaybe 5000 count_
|
||||
(errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user False (PTLast count) clqNoFilters)
|
||||
toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
|
||||
pure $ CRChats previews
|
||||
LastMessages (Just chatName) count search -> withUser $ \user -> do
|
||||
chatRef <- getChatRef user chatName
|
||||
@ -2301,7 +2265,7 @@ processChatCommand = \case
|
||||
tryChatError (withStore (`getUser` userId)) >>= \case
|
||||
Left _ -> throwChatError CEUserUnknown
|
||||
Right user -> pure user
|
||||
validateUserPassword :: User -> User -> Maybe UserPwd -> m ()
|
||||
validateUserPassword :: User -> User -> Maybe UserPwd -> m ()
|
||||
validateUserPassword = validateUserPassword_ . Just
|
||||
validateUserPassword_ :: Maybe User -> User -> Maybe UserPwd -> m ()
|
||||
validateUserPassword_ user_ User {userId = userId', viewPwdHash} viewPwd_ =
|
||||
@ -2429,6 +2393,50 @@ processChatCommand = \case
|
||||
cReqHashes = bimap hash hash cReqSchemas
|
||||
hash = ConnReqUriHash . C.sha256Hash . strEncode
|
||||
|
||||
prepareGroupMsg :: forall m. ChatMonad m => User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe FileInvitation -> Maybe CITimed -> Bool -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
|
||||
prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ fInv_ timed_ live = 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 groupId quotedItemId
|
||||
(origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
|
||||
let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
|
||||
qmc = quoteContent mc origQmc file
|
||||
quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
|
||||
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
|
||||
quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
|
||||
quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
|
||||
quoteData _ _ = throwChatError CEInvalidQuote
|
||||
|
||||
quoteContent :: forall d. MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent
|
||||
quoteContent mc qmc ciFile_
|
||||
| replaceContent = MCText qTextOrFile
|
||||
| otherwise = case qmc of
|
||||
MCImage _ image -> MCImage qTextOrFile image
|
||||
MCFile _ -> MCFile qTextOrFile
|
||||
-- consider same for voice messages
|
||||
-- MCVoice _ voice -> MCVoice qTextOrFile voice
|
||||
_ -> qmc
|
||||
where
|
||||
-- if the message we're quoting with is one of the "large" MsgContents
|
||||
-- we replace the quote's content with MCText
|
||||
replaceContent = case mc of
|
||||
MCText _ -> False
|
||||
MCFile _ -> False
|
||||
MCLink {} -> True
|
||||
MCImage {} -> True
|
||||
MCVideo {} -> True
|
||||
MCVoice {} -> False
|
||||
MCUnknown {} -> True
|
||||
qText = msgContentText qmc
|
||||
getFileName :: CIFile d -> String
|
||||
getFileName CIFile {fileName} = fileName
|
||||
qFileName = maybe qText (T.pack . getFileName) ciFile_
|
||||
qTextOrFile = if T.null qText then qFileName else qText
|
||||
|
||||
assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m ()
|
||||
assertDirectAllowed user dir ct event =
|
||||
unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $
|
||||
@ -2606,7 +2614,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
|
||||
-- marking file as accepted and reading description in the same transaction
|
||||
-- to prevent race condition with appending description
|
||||
ci <- xftpAcceptRcvFT db user fileId filePath
|
||||
rfd <- getRcvFileDescrByFileId db fileId
|
||||
rfd <- getRcvFileDescrByRcvFileId db fileId
|
||||
pure (ci, rfd)
|
||||
receiveViaCompleteFD user fileId rfd cryptoArgs
|
||||
pure ci
|
||||
@ -3184,17 +3192,29 @@ processAgentMsgSndFile _corrId aFileId msg =
|
||||
sendFileDescription sft rfd msgId sendMsg = do
|
||||
let rfdText = fileDescrText rfd
|
||||
withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText
|
||||
partSize <- asks $ xftpDescrPartSize . config
|
||||
sendParts 1 partSize rfdText
|
||||
parts <- splitFileDescr rfdText
|
||||
loopSend parts
|
||||
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}
|
||||
-- returns msgDeliveryId of the last file description message
|
||||
loopSend :: NonEmpty FileDescr -> m Int64
|
||||
loopSend (fileDescr :| fds) = do
|
||||
(_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr}
|
||||
if complete
|
||||
then pure msgDeliveryId
|
||||
else sendParts (partNo + 1) partSize rest
|
||||
case L.nonEmpty fds of
|
||||
Just fds' -> loopSend fds'
|
||||
Nothing -> pure msgDeliveryId
|
||||
|
||||
splitFileDescr :: ChatMonad m => RcvFileDescrText -> m (NonEmpty FileDescr)
|
||||
splitFileDescr rfdText = do
|
||||
partSize <- asks $ xftpDescrPartSize . config
|
||||
pure $ splitParts 1 partSize rfdText
|
||||
where
|
||||
splitParts partNo partSize remText =
|
||||
let (part, rest) = T.splitAt partSize remText
|
||||
complete = T.null rest
|
||||
fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
|
||||
in if complete
|
||||
then fileDescr :| []
|
||||
else fileDescr <| splitParts (partNo + 1) partSize rest
|
||||
|
||||
processAgentMsgRcvFile :: forall m. ChatMonad m => ACorrId -> RcvFileId -> ACommand 'Agent 'AERcvFile -> m ()
|
||||
processAgentMsgRcvFile _corrId aFileId msg =
|
||||
@ -3289,6 +3309,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
pure ()
|
||||
MSG meta _msgFlags msgBody -> do
|
||||
cmdId <- createAckCmd conn
|
||||
-- TODO only acknowledge without saving message?
|
||||
-- probably this branch is never executed, so there should be no reason
|
||||
-- to save message if contact hasn't been created yet - chat item isn't created anyway
|
||||
withAckMessage agentConnId cmdId meta $ do
|
||||
(_conn', _) <- saveDirectRcvMSG conn meta cmdId msgBody
|
||||
pure False
|
||||
@ -3564,21 +3587,105 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
let Connection {viaUserContactLink} = conn
|
||||
when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
|
||||
members <- withStore' $ \db -> getGroupMembers db user gInfo
|
||||
intros <- withStore' $ \db -> createIntroductions db members m
|
||||
void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
|
||||
shuffledIntros <- liftIO $ shuffleMembers intros $ \GroupMemberIntro {reMember = GroupMember {memberRole}} -> memberRole
|
||||
forM_ shuffledIntros $ \intro ->
|
||||
processIntro intro `catchChatError` (toView . CRChatError (Just user))
|
||||
sendIntroductions members
|
||||
when (groupFeatureAllowed SGFHistory gInfo) sendHistory
|
||||
where
|
||||
sendXGrpLinkMem = do
|
||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||
profileToSend = profileToSendOnAccept user profileMode
|
||||
void $ sendDirectMessage conn (XGrpLinkMem profileToSend) (GroupId groupId)
|
||||
sendIntroductions members = do
|
||||
intros <- withStore' $ \db -> createIntroductions db members m
|
||||
shuffledIntros <- liftIO $ shuffleIntros intros
|
||||
if isCompatibleRange (memberChatVRange' m) batchSendVRange
|
||||
then do
|
||||
let events = map (XGrpMemIntro . memberInfo . reMember) shuffledIntros
|
||||
forM_ (L.nonEmpty events) $ \events' ->
|
||||
sendGroupMemberMessages user conn events' groupId
|
||||
else forM_ shuffledIntros $ \intro ->
|
||||
processIntro intro `catchChatError` (toView . CRChatError (Just user))
|
||||
shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
|
||||
shuffleIntros intros = do
|
||||
let (admins, others) = partition isAdmin intros
|
||||
(admPics, admNoPics) = partition hasPicture admins
|
||||
(othPics, othNoPics) = partition hasPicture others
|
||||
mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics]
|
||||
where
|
||||
isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin
|
||||
hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image
|
||||
processIntro intro@GroupMemberIntro {introId} = do
|
||||
void $ sendDirectMessage conn (XGrpMemIntro $ memberInfo (reMember intro)) (GroupId groupId)
|
||||
withStore' $ \db -> updateIntroStatus db introId GMIntroSent
|
||||
sendHistory =
|
||||
when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do
|
||||
(errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo 100)
|
||||
(errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
|
||||
let errors = map ChatErrorStore errs <> errs'
|
||||
unless (null errors) $ toView $ CRChatErrors (Just user) errors
|
||||
forM_ (L.nonEmpty $ concat events) $ \events' ->
|
||||
sendGroupMemberMessages user conn events' groupId
|
||||
itemForwardEvents :: CChatItem 'CTGroup -> m [ChatMsgEvent 'Json]
|
||||
itemForwardEvents cci = case cci of
|
||||
(CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file}) -> do
|
||||
fInvDescr_ <- join <$> forM file getRcvFileInvDescr
|
||||
processContentItem sender ci mc fInvDescr_
|
||||
(CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
|
||||
fInvDescr_ <- join <$> forM file getSndFileInvDescr
|
||||
processContentItem membership ci mc fInvDescr_
|
||||
_ -> pure []
|
||||
where
|
||||
getRcvFileInvDescr :: CIFile 'MDRcv -> m (Maybe (FileInvitation, RcvFileDescrText))
|
||||
getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
|
||||
expired <- fileExpired
|
||||
if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired
|
||||
then pure Nothing
|
||||
else do
|
||||
rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
|
||||
pure $ invCompleteDescr ciFile rfd
|
||||
getSndFileInvDescr :: CIFile 'MDSnd -> m (Maybe (FileInvitation, RcvFileDescrText))
|
||||
getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
|
||||
expired <- fileExpired
|
||||
if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired
|
||||
then pure Nothing
|
||||
else do
|
||||
-- can also lookup in extra_xftp_file_descriptions, though it can be empty;
|
||||
-- would be best if snd file had a single rcv description for all members saved in files table
|
||||
rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
|
||||
pure $ invCompleteDescr ciFile rfd
|
||||
fileExpired :: m Bool
|
||||
fileExpired = do
|
||||
ttl <- asks $ rcvFilesTTL . agentConfig . config
|
||||
cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
|
||||
pure $ chatItemTs cci < cutoffTs
|
||||
invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText)
|
||||
invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete}
|
||||
| fileDescrComplete =
|
||||
let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
|
||||
fInv = xftpFileInvitation fileName fileSize fInvDescr
|
||||
in Just (fInv, fileDescrText)
|
||||
| otherwise = Nothing
|
||||
processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> m [ChatMsgEvent Json]
|
||||
processContentItem sender ChatItem {meta, quotedItem} mc fInvDescr_ =
|
||||
if isNothing fInvDescr_ && not (msgContentHasText mc)
|
||||
then pure []
|
||||
else do
|
||||
let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
|
||||
quotedItemId_ = quoteItemId =<< quotedItem
|
||||
fInv_ = fst <$> fInvDescr_
|
||||
(msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ itemTimed False
|
||||
let senderVRange = memberChatVRange' sender
|
||||
xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer}
|
||||
fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
|
||||
(Just fileDescrText, Just msgId) -> do
|
||||
parts <- splitFileDescr fileDescrText
|
||||
pure . toList $ L.map (XMsgFileDescr msgId) parts
|
||||
_ -> pure []
|
||||
let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
|
||||
GroupMember {memberId} = sender
|
||||
msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
|
||||
pure msgForwardEvents
|
||||
_ -> do
|
||||
-- TODO notify member who forwarded introduction - question - where it is stored? There is via_contact but probably there should be via_member in group_members table
|
||||
let memCategory = memberCategory m
|
||||
withStore' (\db -> getViaGroupContact db user m) >>= \case
|
||||
Nothing -> do
|
||||
@ -3606,41 +3713,27 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
void $ sendDirectMessage imConn (XGrpMemCon $ memberId (m :: GroupMember)) (GroupId groupId)
|
||||
_ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected"
|
||||
MSG msgMeta _msgFlags msgBody -> do
|
||||
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure ()
|
||||
cmdId <- createAckCmd conn
|
||||
tryChatError (processChatMessage cmdId) >>= \case
|
||||
Right (ACMsg _ chatMsg, withRcpt) -> do
|
||||
ackMsg agentConnId cmdId msgMeta $ if withRcpt then Just "" else Nothing
|
||||
when (memberRole (membership :: GroupMember) >= GRAdmin) $ forwardMsg_ chatMsg
|
||||
Left e -> ackMsg agentConnId cmdId msgMeta Nothing >> throwError e
|
||||
let aChatMsgs = parseChatMessages msgBody
|
||||
withAckMessage agentConnId cmdId msgMeta $ do
|
||||
forM_ aChatMsgs $ \case
|
||||
Right (ACMsg _ chatMsg) ->
|
||||
processEvent cmdId chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e
|
||||
Left e -> toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e)
|
||||
checkSendRcpt $ rights aChatMsgs
|
||||
-- currently only a single message is forwarded
|
||||
when (memberRole (membership :: GroupMember) >= GRAdmin) $ case aChatMsgs of
|
||||
[Right (ACMsg _ chatMsg)] -> forwardMsg_ chatMsg
|
||||
_ -> pure ()
|
||||
where
|
||||
processChatMessage :: Int64 -> m (AChatMessage, Bool)
|
||||
processChatMessage cmdId = do
|
||||
msg@(ACMsg _ chatMsg) <- parseAChatMessage conn msgMeta msgBody
|
||||
checkIntegrity chatMsg `catchChatError` \_ -> pure ()
|
||||
(msg,) <$> processEvent cmdId chatMsg
|
||||
brokerTs = metaBrokerTs msgMeta
|
||||
checkIntegrity :: ChatMessage e -> m ()
|
||||
checkIntegrity ChatMessage {chatMsgEvent} = do
|
||||
when checkForEvent $ checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
|
||||
where
|
||||
checkForEvent = case chatMsgEvent of
|
||||
XMsgNew _ -> True
|
||||
XFileCancel _ -> True
|
||||
XFileAcptInv {} -> True
|
||||
XGrpMemNew _ -> True
|
||||
XGrpMemRole {} -> True
|
||||
XGrpMemDel _ -> True
|
||||
XGrpLeave -> True
|
||||
XGrpDel -> True
|
||||
XGrpInfo _ -> True
|
||||
XGrpDirectInv {} -> True
|
||||
_ -> False
|
||||
processEvent :: MsgEncodingI e => CommandId -> ChatMessage e -> m Bool
|
||||
processEvent :: MsgEncodingI e => CommandId -> ChatMessage e -> m ()
|
||||
processEvent cmdId chatMsg = do
|
||||
(m', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m conn msgMeta cmdId msgBody chatMsg
|
||||
updateChatLock "groupMessage" event
|
||||
case event of
|
||||
XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs
|
||||
XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False
|
||||
XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg brokerTs ttl live
|
||||
XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg brokerTs
|
||||
@ -3668,15 +3761,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe
|
||||
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
|
||||
_ -> messageError $ "unsupported message: " <> T.pack (show event)
|
||||
checkSendRcpt event
|
||||
checkSendRcpt :: ChatMsgEvent e -> m Bool
|
||||
checkSendRcpt event = do
|
||||
checkSendRcpt :: [AChatMessage] -> m Bool
|
||||
checkSendRcpt aChatMsgs = do
|
||||
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
|
||||
let GroupInfo {chatSettings = ChatSettings {sendRcpts}} = gInfo
|
||||
pure $
|
||||
fromMaybe (sendRcptsSmallGroups user) sendRcpts
|
||||
&& hasDeliveryReceipt (toCMEventTag event)
|
||||
&& any aChatMsgHasReceipt aChatMsgs
|
||||
&& currentMemCount <= smallGroupsRcptsMemLimit
|
||||
where
|
||||
aChatMsgHasReceipt (ACMsg _ ChatMessage {chatMsgEvent}) =
|
||||
hasDeliveryReceipt (toCMEventTag chatMsgEvent)
|
||||
forwardMsg_ :: MsgEncodingI e => ChatMessage e -> m ()
|
||||
forwardMsg_ chatMsg =
|
||||
forM_ (forwardedGroupMsg chatMsg) $ \chatMsg' -> do
|
||||
@ -4013,15 +4108,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
|
||||
ackMsgDeliveryEvent :: Connection -> CommandId -> m ()
|
||||
ackMsgDeliveryEvent Connection {connId} ackCmdId =
|
||||
withStoreCtx'
|
||||
(Just $ "createRcvMsgDeliveryEvent, connId: " <> show connId <> ", ackCmdId: " <> show ackCmdId <> ", msgDeliveryStatus: MDSRcvAcknowledged")
|
||||
$ \db -> createRcvMsgDeliveryEvent db connId ackCmdId MDSRcvAcknowledged
|
||||
withStore' $ \db -> updateRcvMsgDeliveryStatus db connId ackCmdId MDSRcvAcknowledged
|
||||
|
||||
sentMsgDeliveryEvent :: Connection -> AgentMsgId -> m ()
|
||||
sentMsgDeliveryEvent Connection {connId} msgId =
|
||||
withStoreCtx
|
||||
(Just $ "createSndMsgDeliveryEvent, connId: " <> show connId <> ", msgId: " <> show msgId <> ", msgDeliveryStatus: MDSSndSent")
|
||||
$ \db -> createSndMsgDeliveryEvent db connId msgId MDSSndSent
|
||||
withStore' $ \db -> updateSndMsgDeliveryStatus db connId msgId MDSSndSent
|
||||
|
||||
agentErrToItemStatus :: AgentErrorType -> CIStatus 'MDSnd
|
||||
agentErrToItemStatus (SMP AUTH) = CISSndErrorAuth
|
||||
@ -4283,20 +4374,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId
|
||||
e -> throwError e
|
||||
|
||||
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> m ()
|
||||
newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs
|
||||
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> m ()
|
||||
newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded
|
||||
| isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
|
||||
| not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
|
||||
| otherwise = do
|
||||
-- TODO integrity message check
|
||||
-- check if message moderation event was received ahead of message
|
||||
let timed_ = rcvGroupCITimed gInfo itemTTL
|
||||
live = fromMaybe False live_
|
||||
withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
|
||||
Just ciModeration -> do
|
||||
applyModeration timed_ live ciModeration
|
||||
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
|
||||
Nothing -> createItem timed_ live
|
||||
let timed_ =
|
||||
if forwarded
|
||||
then rcvCITimed_ (Just Nothing) itemTTL
|
||||
else rcvGroupCITimed gInfo itemTTL
|
||||
live = fromMaybe False live_
|
||||
withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
|
||||
Just ciModeration -> do
|
||||
applyModeration timed_ live ciModeration
|
||||
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
|
||||
Nothing -> createItem timed_ live
|
||||
where
|
||||
rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
|
||||
ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
|
||||
@ -5217,7 +5309,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
let body = LB.toStrict $ J.encode msg
|
||||
rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} <- saveGroupFwdRcvMsg user groupId m author body chatMsg
|
||||
case event of
|
||||
XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs
|
||||
XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs True
|
||||
XMsgFileDescr sharedMsgId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr
|
||||
XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent rcvMsg msgTs ttl live
|
||||
XMsgDel sharedMsgId memId -> groupMessageDelete gInfo author sharedMsgId memId rcvMsg msgTs
|
||||
@ -5236,14 +5328,19 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
|
||||
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
|
||||
withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus
|
||||
updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
|
||||
|
||||
-- TODO [batch send] update status of all messages in batch
|
||||
-- - this is for when we implement identifying inactive connections
|
||||
-- - regular messages sent in batch would all be marked as delivered by a single receipt
|
||||
-- - repeat for directMsgReceived if same logic is applied to direct messages
|
||||
-- - getChatItemIdByAgentMsgId to return [ChatItemId]
|
||||
groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
|
||||
groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do
|
||||
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
|
||||
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
|
||||
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
|
||||
withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus
|
||||
updateGroupItemStatus gInfo m conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
|
||||
|
||||
updateDirectItemStatus :: Contact -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> m ()
|
||||
@ -5334,17 +5431,13 @@ sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg =
|
||||
chSize = fromIntegral chunkSize
|
||||
|
||||
parseChatMessage :: ChatMonad m => Connection -> ByteString -> m (ChatMessage 'Json)
|
||||
parseChatMessage conn = parseChatMessage_ conn Nothing
|
||||
{-# INLINE parseChatMessage #-}
|
||||
|
||||
parseAChatMessage :: ChatMonad m => Connection -> MsgMeta -> ByteString -> m AChatMessage
|
||||
parseAChatMessage conn msgMeta = parseChatMessage_ conn (Just msgMeta)
|
||||
{-# INLINE parseAChatMessage #-}
|
||||
|
||||
parseChatMessage_ :: (ChatMonad m, StrEncoding s) => Connection -> Maybe MsgMeta -> ByteString -> m s
|
||||
parseChatMessage_ conn msgMeta s = liftEither . first (ChatError . errType) $ strDecode s
|
||||
parseChatMessage conn s = do
|
||||
case parseChatMessages s of
|
||||
[msg] -> liftEither . first (ChatError . errType) $ (\(ACMsg _ m) -> checkEncoding m) =<< msg
|
||||
_ -> throwChatError $ CEException "parseChatMessage: single message is expected"
|
||||
where
|
||||
errType = CEInvalidChatMessage conn (msgMetaToJson <$> msgMeta) (safeDecodeUtf8 s)
|
||||
errType = CEInvalidChatMessage conn Nothing (safeDecodeUtf8 s)
|
||||
{-# INLINE parseChatMessage #-}
|
||||
|
||||
sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m ()
|
||||
sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} =
|
||||
@ -5521,40 +5614,77 @@ createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGro
|
||||
createSndMessage chatMsgEvent connOrGroupId = do
|
||||
gVar <- asks random
|
||||
ChatConfig {chatVRange} <- asks config
|
||||
withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId ->
|
||||
let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
|
||||
in NewMessage {chatMsgEvent, msgBody}
|
||||
withStore $ \db -> createNewSndMessage db gVar connOrGroupId chatMsgEvent (encodeMessage chatVRange)
|
||||
where
|
||||
encodeMessage chatVRange sharedMsgId =
|
||||
encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
|
||||
|
||||
sendGroupMemberMessages :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> m ()
|
||||
sendGroupMemberMessages user conn@Connection {connId} events groupId = do
|
||||
when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn)
|
||||
(errs, msgs) <- partitionEithers <$> createSndMessages
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
unless (null msgs) $ do
|
||||
let (errs', msgBatches) = partitionEithers $ batchMessages maxChatMsgSize msgs
|
||||
-- shouldn't happen, as large messages would have caused createNewSndMessage to throw SELargeMsg
|
||||
unless (null errs') $ toView $ CRChatErrors (Just user) errs'
|
||||
forM_ msgBatches $ \batch ->
|
||||
processBatch batch `catchChatError` (toView . CRChatError (Just user))
|
||||
where
|
||||
processBatch :: MsgBatch -> m ()
|
||||
processBatch (MsgBatch builder sndMsgs) = do
|
||||
let batchBody = LB.toStrict $ toLazyByteString builder
|
||||
agentMsgId <- withAgent $ \a -> sendMessage a (aConnId conn) MsgFlags {notification = True} batchBody
|
||||
let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId}
|
||||
void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs
|
||||
createSndMessages :: m [Either ChatError SndMessage]
|
||||
createSndMessages = do
|
||||
gVar <- asks random
|
||||
ChatConfig {chatVRange} <- asks config
|
||||
withStoreBatch $ \db -> map (createMsg db gVar chatVRange) (toList events)
|
||||
createMsg db gVar chatVRange evnt = do
|
||||
r <- runExceptT $ createNewSndMessage db gVar (GroupId groupId) evnt (encodeMessage chatVRange evnt)
|
||||
pure $ first ChatErrorStore r
|
||||
encodeMessage chatVRange evnt sharedMsgId =
|
||||
encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent = evnt}
|
||||
|
||||
directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString
|
||||
directMessage chatMsgEvent = do
|
||||
ChatConfig {chatVRange} <- asks config
|
||||
pure $ strEncode ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
|
||||
let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
|
||||
case r of
|
||||
ECMEncoded encodedBody -> pure . LB.toStrict $ encodedBody
|
||||
ECMLarge -> throwChatError $ CEException "large message"
|
||||
|
||||
deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64
|
||||
deliverMessage conn cmEventTag msgBody msgId =
|
||||
deliverMessages [(conn, cmEventTag, msgBody, msgId)] >>= \case
|
||||
deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> LazyMsgBody -> MessageId -> m Int64
|
||||
deliverMessage conn cmEventTag msgBody msgId = do
|
||||
let msgFlags = MsgFlags {notification = hasNotification cmEventTag}
|
||||
deliverMessage' conn msgFlags msgBody msgId
|
||||
|
||||
deliverMessage' :: ChatMonad m => Connection -> MsgFlags -> LazyMsgBody -> MessageId -> m Int64
|
||||
deliverMessage' conn msgFlags msgBody msgId =
|
||||
deliverMessages [(conn, msgFlags, msgBody, msgId)] >>= \case
|
||||
[r] -> liftEither r
|
||||
rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs)
|
||||
|
||||
deliverMessages :: ChatMonad' m => [(Connection, CMEventTag e, MsgBody, MessageId)] -> m [Either ChatError Int64]
|
||||
deliverMessages :: ChatMonad' m => [(Connection, MsgFlags, LazyMsgBody, MessageId)] -> m [Either ChatError Int64]
|
||||
deliverMessages msgReqs = do
|
||||
sent <- zipWith prepareBatch msgReqs <$> withAgent' (`sendMessages` aReqs)
|
||||
withStoreBatch $ \db -> map (bindRight $ createDelivery db) sent
|
||||
where
|
||||
aReqs = map (\(conn, cmEvTag, msgBody, _msgId) -> (aConnId conn, msgFlags cmEvTag, msgBody)) msgReqs
|
||||
msgFlags cmEvTag = MsgFlags {notification = hasNotification cmEvTag}
|
||||
aReqs = map (\(conn, msgFlags, msgBody, _msgId) -> (aConnId conn, msgFlags, LB.toStrict msgBody)) msgReqs
|
||||
prepareBatch req = bimap (`ChatErrorAgent` Nothing) (req,)
|
||||
createDelivery :: DB.Connection -> ((Connection, CMEventTag e, MsgBody, MessageId), AgentMsgId) -> IO (Either ChatError Int64)
|
||||
createDelivery :: DB.Connection -> ((Connection, MsgFlags, LazyMsgBody, MessageId), AgentMsgId) -> IO (Either ChatError Int64)
|
||||
createDelivery db ((Connection {connId}, _, _, msgId), agentMsgId) =
|
||||
Right <$> createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId}) msgId
|
||||
|
||||
sendGroupMessage :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember])
|
||||
sendGroupMessage user GroupInfo {groupId} members chatMsgEvent = do
|
||||
msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId)
|
||||
recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) $ \GroupMember {memberRole} -> memberRole
|
||||
let tag = toCMEventTag chatMsgEvent
|
||||
recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members)
|
||||
let msgFlags = MsgFlags {notification = hasNotification $ toCMEventTag chatMsgEvent}
|
||||
(toSend, pending) = foldr addMember ([], []) recipientMembers
|
||||
msgReqs = map (\(_, conn) -> (conn, tag, msgBody, msgId)) toSend
|
||||
msgReqs = map (\(_, conn) -> (conn, msgFlags, msgBody, msgId)) toSend
|
||||
delivered <- deliverMessages msgReqs
|
||||
let errors = lefts delivered
|
||||
unless (null errors) $ toView $ CRChatErrors (Just user) errors
|
||||
@ -5562,6 +5692,12 @@ sendGroupMessage user GroupInfo {groupId} members chatMsgEvent = do
|
||||
let sentToMembers = filterSent delivered toSend fst <> filterSent stored pending id
|
||||
pure (msg, sentToMembers)
|
||||
where
|
||||
shuffleMembers :: [GroupMember] -> IO [GroupMember]
|
||||
shuffleMembers ms = do
|
||||
let (adminMs, otherMs) = partition isAdmin ms
|
||||
liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
|
||||
where
|
||||
isAdmin GroupMember {memberRole} = memberRole >= GRAdmin
|
||||
addMember m (toSend, pending) = case memberSendAction chatMsgEvent members m of
|
||||
Just (MSASend conn) -> ((m, conn) : toSend, pending)
|
||||
Just MSAPending -> (toSend, m : pending)
|
||||
@ -5610,15 +5746,6 @@ sendGroupMemberMessage user m@GroupMember {groupMemberId} chatMsgEvent groupId i
|
||||
MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver
|
||||
MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
|
||||
|
||||
shuffleMembers :: [a] -> (a -> GroupMemberRole) -> IO [a]
|
||||
shuffleMembers ms role = do
|
||||
let (adminMs, otherMs) = partition ((GRAdmin <=) . role) ms
|
||||
liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
|
||||
where
|
||||
random :: IO Word16
|
||||
random = randomRIO (0, 65535)
|
||||
shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) xs
|
||||
|
||||
sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m ()
|
||||
sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do
|
||||
pendingMessages <- withStore' $ \db -> getPendingGroupMessages db groupMemberId
|
||||
@ -5635,21 +5762,25 @@ sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn
|
||||
_ -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName
|
||||
_ -> pure ()
|
||||
|
||||
-- TODO [batch send] refactor direct message processing same as groups (e.g. checkIntegrity before processing)
|
||||
saveDirectRcvMSG :: ChatMonad m => Connection -> MsgMeta -> CommandId -> MsgBody -> m (Connection, RcvMessage)
|
||||
saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody = do
|
||||
ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} <- parseAChatMessage conn agentMsgMeta msgBody
|
||||
conn' <- updatePeerChatVRange conn chatVRange
|
||||
let agentMsgId = fst $ recipient agentMsgMeta
|
||||
newMsg = NewMessage {chatMsgEvent, msgBody}
|
||||
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
|
||||
msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing
|
||||
pure (conn', msg)
|
||||
saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody =
|
||||
case parseChatMessages msgBody of
|
||||
[Right (ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent})] -> do
|
||||
conn' <- updatePeerChatVRange conn chatVRange
|
||||
let agentMsgId = fst $ recipient agentMsgMeta
|
||||
newMsg = NewRcvMessage {chatMsgEvent, msgBody}
|
||||
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
|
||||
msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing
|
||||
pure (conn', msg)
|
||||
[Left e] -> error $ "saveDirectRcvMSG: error parsing chat message: " <> e
|
||||
_ -> error "saveDirectRcvMSG: batching not supported"
|
||||
|
||||
saveGroupRcvMsg :: (MsgEncodingI e, ChatMonad m) => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> CommandId -> MsgBody -> ChatMessage e -> m (GroupMember, Connection, RcvMessage)
|
||||
saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do
|
||||
(am', conn') <- updateMemberChatVRange authorMember conn chatVRange
|
||||
let agentMsgId = fst $ recipient agentMsgMeta
|
||||
newMsg = NewMessage {chatMsgEvent, msgBody}
|
||||
newMsg = NewRcvMessage {chatMsgEvent, msgBody}
|
||||
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
|
||||
amId = Just $ groupMemberId' am'
|
||||
msg <-
|
||||
@ -5665,7 +5796,7 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta
|
||||
|
||||
saveGroupFwdRcvMsg :: (MsgEncodingI e, ChatMonad m) => User -> GroupId -> GroupMember -> GroupMember -> MsgBody -> ChatMessage e -> m RcvMessage
|
||||
saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember msgBody ChatMessage {msgId = sharedMsgId_, chatMsgEvent} = do
|
||||
let newMsg = NewMessage {chatMsgEvent, msgBody}
|
||||
let newMsg = NewRcvMessage {chatMsgEvent, msgBody}
|
||||
fwdMemberId = Just $ groupMemberId' forwardingMember
|
||||
refAuthorId = Just $ groupMemberId' refAuthorMember
|
||||
withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId)
|
||||
@ -6229,6 +6360,7 @@ chatCommandP =
|
||||
"/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)),
|
||||
"/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP),
|
||||
"/set files #" *> (SetGroupFeature (AGF SGFFiles) <$> displayName <*> (A.space *> strP)),
|
||||
"/set history #" *> (SetGroupFeature (AGF SGFHistory) <$> displayName <*> (A.space *> strP)),
|
||||
"/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayName <*> optional (A.space *> strP)),
|
||||
"/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP),
|
||||
"/set delete #" *> (SetGroupFeature (AGF SGFFullDelete) <$> displayName <*> (A.space *> strP)),
|
||||
@ -6316,7 +6448,12 @@ chatCommandP =
|
||||
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
|
||||
groupProfile = do
|
||||
(gName, fullName) <- profileNames
|
||||
let groupPreferences = Just (emptyGroupPrefs :: GroupPreferences) {directMessages = Just DirectMessagesGroupPreference {enable = FEOn}}
|
||||
let groupPreferences =
|
||||
Just
|
||||
(emptyGroupPrefs :: GroupPreferences)
|
||||
{ directMessages = Just DirectMessagesGroupPreference {enable = FEOn},
|
||||
history = Just HistoryGroupPreference {enable = FEOn}
|
||||
}
|
||||
pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences}
|
||||
fullNameP = A.space *> textP <|> pure ""
|
||||
textP = safeDecodeUtf8 <$> A.takeByteString
|
||||
@ -6354,6 +6491,7 @@ chatCommandP =
|
||||
<|> ("day" $> 86400)
|
||||
<|> ("week" $> (7 * 86400))
|
||||
<|> ("month" $> (30 * 86400))
|
||||
<|> A.decimal
|
||||
timedTTLOnOffP =
|
||||
optional ("on" *> A.space) *> (Just <$> timedTTLP)
|
||||
<|> ("off" $> Nothing)
|
||||
|
@ -28,7 +28,7 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {core
|
||||
exitFailure
|
||||
run db@ChatDatabase {chatStore} = do
|
||||
u <- getCreateActiveUser chatStore testView
|
||||
cc <- newChatController db (Just u) cfg opts
|
||||
cc <- newChatController db (Just u) cfg opts False
|
||||
runSimplexChat opts u cc chat
|
||||
|
||||
runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
|
||||
|
@ -155,7 +155,8 @@ groupsHelpInfo =
|
||||
"",
|
||||
green "Group chat preferences:",
|
||||
indent <> highlight "/set voice #<group> on/off " <> " - enable/disable voice messages",
|
||||
-- indent <> highlight "/set files #<group> on/off " <> " - enable/disable files and media (other than voice)",
|
||||
indent <> highlight "/set files #<group> on/off " <> " - enable/disable files and media (other than voice)",
|
||||
indent <> highlight "/set history #<group> on/off " <> " - enable/disable sending recent history to new members",
|
||||
indent <> highlight "/set delete #<group> on/off " <> " - enable/disable full message deletion",
|
||||
indent <> highlight "/set direct #<group> on/off " <> " - enable/disable direct messages to other members",
|
||||
indent <> highlight "/set disappear #<group> on <time> " <> " - enable disappearing messages with <time>:",
|
||||
|
@ -21,6 +21,7 @@ import qualified Data.Aeson.Encoding as JE
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Char (isSpace)
|
||||
import Data.Int (Int64)
|
||||
@ -369,6 +370,9 @@ data CIQuote (c :: ChatType) = CIQuote
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
quoteItemId :: CIQuote c -> Maybe ChatItemId
|
||||
quoteItemId CIQuote {itemId} = itemId
|
||||
|
||||
data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
|
||||
{ chatDir :: CIDirection c d,
|
||||
chatItem :: CChatItem c,
|
||||
@ -759,17 +763,20 @@ checkChatType x = case testEquality (chatTypeI @c) (chatTypeI @c') of
|
||||
Just Refl -> Right x
|
||||
Nothing -> Left "bad chat type"
|
||||
|
||||
data NewMessage e = NewMessage
|
||||
{ chatMsgEvent :: ChatMsgEvent e,
|
||||
msgBody :: MsgBody
|
||||
}
|
||||
deriving (Show)
|
||||
type LazyMsgBody = L.ByteString
|
||||
|
||||
data SndMessage = SndMessage
|
||||
{ msgId :: MessageId,
|
||||
sharedMsgId :: SharedMsgId,
|
||||
msgBody :: LazyMsgBody
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data NewRcvMessage e = NewRcvMessage
|
||||
{ chatMsgEvent :: ChatMsgEvent e,
|
||||
msgBody :: MsgBody
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data RcvMessage = RcvMessage
|
||||
{ msgId :: MessageId,
|
||||
@ -783,7 +790,7 @@ data RcvMessage = RcvMessage
|
||||
data PendingGroupMessage = PendingGroupMessage
|
||||
{ msgId :: MessageId,
|
||||
cmEventTag :: ACMEventTag,
|
||||
msgBody :: MsgBody,
|
||||
msgBody :: LazyMsgBody,
|
||||
introId_ :: Maybe Int64
|
||||
}
|
||||
|
||||
|
52
src/Simplex/Chat/Messages/Batch.hs
Normal file
52
src/Simplex/Chat/Messages/Batch.hs
Normal file
@ -0,0 +1,52 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Simplex.Chat.Messages.Batch
|
||||
( MsgBatch (..),
|
||||
batchMessages,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.ByteString.Builder (Builder, charUtf8, lazyByteString)
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Int (Int64)
|
||||
import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
|
||||
import Simplex.Chat.Messages
|
||||
|
||||
data MsgBatch = MsgBatch Builder [SndMessage]
|
||||
|
||||
-- | Batches [SndMessage] into batches of ByteString builders in form of JSON arrays.
|
||||
-- Does not check if the resulting batch is a valid JSON.
|
||||
-- If a single element is passed, it is returned as is (a JSON string).
|
||||
-- If an element exceeds maxLen, it is returned as ChatError.
|
||||
batchMessages :: Int64 -> [SndMessage] -> [Either ChatError MsgBatch]
|
||||
batchMessages maxLen msgs =
|
||||
let (batches, batch, _, n) = foldr addToBatch ([], [], 0, 0) msgs
|
||||
in if n == 0 then batches else msgBatch batch : batches
|
||||
where
|
||||
msgBatch batch = Right (MsgBatch (encodeMessages batch) batch)
|
||||
addToBatch :: SndMessage -> ([Either ChatError MsgBatch], [SndMessage], Int64, Int) -> ([Either ChatError MsgBatch], [SndMessage], Int64, Int)
|
||||
addToBatch msg@SndMessage {msgBody} (batches, batch, len, n)
|
||||
| batchLen <= maxLen = (batches, msg : batch, len', n + 1)
|
||||
| msgLen <= maxLen = (batches', [msg], msgLen, 1)
|
||||
| otherwise = (errLarge msg : (if n == 0 then batches else batches'), [], 0, 0)
|
||||
where
|
||||
msgLen = LB.length msgBody
|
||||
batches' = msgBatch batch : batches
|
||||
len'
|
||||
| n == 0 = msgLen
|
||||
| otherwise = msgLen + len + 1 -- 1 accounts for comma
|
||||
batchLen
|
||||
| n == 0 = len'
|
||||
| otherwise = len' + 2 -- 2 accounts for opening and closing brackets
|
||||
errLarge SndMessage {msgId} = Left $ ChatError $ CEInternalError ("large message " <> show msgId)
|
||||
|
||||
encodeMessages :: [SndMessage] -> Builder
|
||||
encodeMessages = \case
|
||||
[] -> mempty
|
||||
[msg] -> encodeMsg msg
|
||||
(msg : msgs) -> charUtf8 '[' <> encodeMsg msg <> mconcat [charUtf8 ',' <> encodeMsg msg' | msg' <- msgs] <> charUtf8 ']'
|
||||
where
|
||||
encodeMsg SndMessage {msgBody} = lazyByteString msgBody
|
@ -575,10 +575,16 @@ dbParseACIContent = fmap aciContentDBJSON . J.eitherDecodeStrict' . encodeUtf8
|
||||
instance FromJSON ACIContent where
|
||||
parseJSON = fmap aciContentJSON . J.parseJSON
|
||||
|
||||
sndMsgContentTag :: Text
|
||||
sndMsgContentTag = "sndMsgContent"
|
||||
|
||||
rcvMsgContentTag :: Text
|
||||
rcvMsgContentTag = "rcvMsgContent"
|
||||
|
||||
toCIContentTag :: CIContent e -> Text
|
||||
toCIContentTag ciContent = case ciContent of
|
||||
CISndMsgContent _ -> "sndMsgContent"
|
||||
CIRcvMsgContent _ -> "rcvMsgContent"
|
||||
CISndMsgContent _ -> sndMsgContentTag
|
||||
CIRcvMsgContent _ -> rcvMsgContentTag
|
||||
CISndDeleted _ -> "sndDeleted"
|
||||
CIRcvDeleted _ -> "rcvDeleted"
|
||||
CISndCall {} -> "sndCall"
|
||||
|
100
src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs
Normal file
100
src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs
Normal file
@ -0,0 +1,100 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20231215_recreate_msg_deliveries :: Query
|
||||
m20231215_recreate_msg_deliveries =
|
||||
[sql|
|
||||
DROP INDEX msg_delivery_events_msg_delivery_id;
|
||||
DROP TABLE msg_delivery_events;
|
||||
|
||||
DROP INDEX idx_msg_deliveries_message_id;
|
||||
DROP INDEX idx_msg_deliveries_agent_ack_cmd_id;
|
||||
|
||||
CREATE TABLE new_msg_deliveries(
|
||||
msg_delivery_id INTEGER PRIMARY KEY,
|
||||
message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages and for batched messages
|
||||
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
|
||||
agent_msg_id INTEGER, -- internal agent message ID (NULL while pending), non UNIQUE for batched messages
|
||||
agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
|
||||
chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
created_at TEXT CHECK(created_at NOT NULL),
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
|
||||
delivery_status TEXT -- MsgDeliveryStatus
|
||||
);
|
||||
|
||||
INSERT INTO new_msg_deliveries (
|
||||
msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
|
||||
chat_ts, created_at, updated_at, agent_ack_cmd_id
|
||||
)
|
||||
SELECT
|
||||
msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
|
||||
chat_ts, created_at, updated_at, agent_ack_cmd_id
|
||||
FROM msg_deliveries;
|
||||
|
||||
DROP TABLE msg_deliveries;
|
||||
ALTER TABLE new_msg_deliveries RENAME TO msg_deliveries;
|
||||
|
||||
CREATE INDEX idx_msg_deliveries_message_id ON "msg_deliveries"(message_id);
|
||||
CREATE INDEX idx_msg_deliveries_agent_ack_cmd_id ON "msg_deliveries"(connection_id, agent_ack_cmd_id);
|
||||
CREATE INDEX idx_msg_deliveries_agent_msg_id ON "msg_deliveries"(connection_id, agent_msg_id);
|
||||
|]
|
||||
|
||||
down_m20231215_recreate_msg_deliveries :: Query
|
||||
down_m20231215_recreate_msg_deliveries =
|
||||
[sql|
|
||||
DROP INDEX idx_msg_deliveries_message_id;
|
||||
DROP INDEX idx_msg_deliveries_agent_ack_cmd_id;
|
||||
DROP INDEX idx_msg_deliveries_agent_msg_id;
|
||||
|
||||
CREATE TABLE old_msg_deliveries(
|
||||
msg_delivery_id INTEGER PRIMARY KEY,
|
||||
message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages
|
||||
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
|
||||
agent_msg_id INTEGER, -- internal agent message ID(NULL while pending)
|
||||
agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
|
||||
chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
created_at TEXT CHECK(created_at NOT NULL),
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
|
||||
UNIQUE(connection_id, agent_msg_id)
|
||||
);
|
||||
|
||||
INSERT INTO old_msg_deliveries (
|
||||
msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
|
||||
chat_ts, created_at, updated_at, agent_ack_cmd_id
|
||||
)
|
||||
WITH unique_msg_deliveries AS (
|
||||
SELECT
|
||||
msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
|
||||
chat_ts, created_at, updated_at, agent_ack_cmd_id,
|
||||
row_number() OVER connection_id_agent_msg_id_win AS row_number
|
||||
FROM msg_deliveries
|
||||
WINDOW connection_id_agent_msg_id_win AS (PARTITION BY connection_id, agent_msg_id ORDER BY created_at ASC, msg_delivery_id ASC)
|
||||
)
|
||||
SELECT
|
||||
msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
|
||||
chat_ts, created_at, updated_at, agent_ack_cmd_id
|
||||
FROM unique_msg_deliveries
|
||||
WHERE row_number = 1;
|
||||
|
||||
DROP TABLE msg_deliveries;
|
||||
ALTER TABLE old_msg_deliveries RENAME TO msg_deliveries;
|
||||
|
||||
CREATE INDEX idx_msg_deliveries_message_id ON "msg_deliveries"(message_id);
|
||||
CREATE INDEX idx_msg_deliveries_agent_ack_cmd_id ON "msg_deliveries"(connection_id, agent_ack_cmd_id);
|
||||
|
||||
CREATE TABLE msg_delivery_events (
|
||||
msg_delivery_event_id INTEGER PRIMARY KEY,
|
||||
msg_delivery_id INTEGER NOT NULL REFERENCES msg_deliveries ON DELETE CASCADE, -- non UNIQUE for multiple events per msg delivery
|
||||
delivery_status TEXT NOT NULL, -- see MsgDeliveryStatus for allowed values
|
||||
created_at TEXT NOT NULL DEFAULT (datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT (datetime('now')),
|
||||
UNIQUE (msg_delivery_id, delivery_status)
|
||||
);
|
||||
CREATE INDEX msg_delivery_events_msg_delivery_id ON msg_delivery_events(msg_delivery_id);
|
||||
|]
|
@ -330,18 +330,6 @@ CREATE TABLE messages(
|
||||
author_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
|
||||
forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL
|
||||
);
|
||||
CREATE TABLE msg_deliveries(
|
||||
msg_delivery_id INTEGER PRIMARY KEY,
|
||||
message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages
|
||||
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
|
||||
agent_msg_id INTEGER, -- internal agent message ID(NULL while pending)
|
||||
agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
|
||||
chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
created_at TEXT CHECK(created_at NOT NULL),
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
|
||||
UNIQUE(connection_id, agent_msg_id)
|
||||
);
|
||||
CREATE TABLE pending_group_messages(
|
||||
pending_group_message_id INTEGER PRIMARY KEY,
|
||||
group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
|
||||
@ -450,13 +438,6 @@ CREATE TABLE extra_xftp_file_descriptions(
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE TABLE msg_delivery_events(
|
||||
msg_delivery_event_id INTEGER PRIMARY KEY,
|
||||
msg_delivery_id INTEGER NOT NULL REFERENCES msg_deliveries ON DELETE CASCADE,
|
||||
delivery_status TEXT NOT NULL,
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE TABLE chat_item_versions(
|
||||
-- contains versions only for edited chat items, including current version
|
||||
chat_item_version_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
@ -554,6 +535,18 @@ CREATE TABLE remote_controllers(
|
||||
dh_priv_key BLOB NOT NULL, -- last session DH key
|
||||
prev_dh_priv_key BLOB -- previous session DH key
|
||||
);
|
||||
CREATE TABLE IF NOT EXISTS "msg_deliveries"(
|
||||
msg_delivery_id INTEGER PRIMARY KEY,
|
||||
message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages and for batched messages
|
||||
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
|
||||
agent_msg_id INTEGER, -- internal agent message ID(NULL while pending), non UNIQUE for batched messages
|
||||
agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
|
||||
chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
created_at TEXT CHECK(created_at NOT NULL),
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
|
||||
delivery_status TEXT -- MsgDeliveryStatus
|
||||
);
|
||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||
display_name,
|
||||
full_name
|
||||
@ -585,7 +578,6 @@ CREATE UNIQUE INDEX idx_chat_items_group_shared_msg_id ON chat_items(
|
||||
group_member_id,
|
||||
shared_msg_id
|
||||
);
|
||||
CREATE INDEX idx_msg_deliveries_message_id ON msg_deliveries(message_id);
|
||||
CREATE UNIQUE INDEX idx_user_contact_links_group_id ON user_contact_links(
|
||||
group_id
|
||||
);
|
||||
@ -717,13 +709,6 @@ CREATE INDEX idx_chat_items_timed_delete_at ON chat_items(
|
||||
timed_delete_at
|
||||
);
|
||||
CREATE INDEX idx_group_members_group_id ON group_members(user_id, group_id);
|
||||
CREATE INDEX idx_msg_deliveries_agent_ack_cmd_id ON msg_deliveries(
|
||||
connection_id,
|
||||
agent_ack_cmd_id
|
||||
);
|
||||
CREATE INDEX msg_delivery_events_msg_delivery_id ON msg_delivery_events(
|
||||
msg_delivery_id
|
||||
);
|
||||
CREATE INDEX idx_chat_item_moderations_group_id ON chat_item_moderations(
|
||||
group_id
|
||||
);
|
||||
@ -818,3 +803,12 @@ CREATE INDEX idx_contact_requests_updated_at ON contact_requests(
|
||||
updated_at
|
||||
);
|
||||
CREATE INDEX idx_connections_updated_at ON connections(user_id, updated_at);
|
||||
CREATE INDEX idx_msg_deliveries_message_id ON "msg_deliveries"(message_id);
|
||||
CREATE INDEX idx_msg_deliveries_agent_ack_cmd_id ON "msg_deliveries"(
|
||||
connection_id,
|
||||
agent_ack_cmd_id
|
||||
);
|
||||
CREATE INDEX idx_msg_deliveries_agent_msg_id ON "msg_deliveries"(
|
||||
connection_id,
|
||||
agent_msg_id
|
||||
);
|
||||
|
@ -72,7 +72,7 @@ $(JQ.deriveToJSON defaultJSON ''APIResponse)
|
||||
|
||||
foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
|
||||
foreign export ccall "chat_migrate_init_key" cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
foreign export ccall "chat_migrate_init_key" cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> CInt -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
|
||||
foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString
|
||||
|
||||
@ -108,10 +108,10 @@ foreign export ccall "chat_decrypt_file" cChatDecryptFile :: CString -> CString
|
||||
|
||||
-- | check / migrate database and initialize chat controller on success
|
||||
cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
cChatMigrateInit fp key = cChatMigrateInitKey fp key 0
|
||||
cChatMigrateInit fp key conf = cChatMigrateInitKey fp key 0 conf 0
|
||||
|
||||
cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
cChatMigrateInitKey fp key keepKey conf ctrl = do
|
||||
cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> CInt -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
cChatMigrateInitKey fp key keepKey conf background ctrl = do
|
||||
-- ensure we are set to UTF-8; iOS does not have locale, and will default to
|
||||
-- US-ASCII all the time.
|
||||
setLocaleEncoding utf8
|
||||
@ -122,7 +122,7 @@ cChatMigrateInitKey fp key keepKey conf ctrl = do
|
||||
dbKey <- BA.convert <$> B.packCString key
|
||||
confirm <- peekCAString conf
|
||||
r <-
|
||||
chatMigrateInitKey dbPath dbKey (keepKey /= 0) confirm >>= \case
|
||||
chatMigrateInitKey dbPath dbKey (keepKey /= 0) confirm (background /= 0) >>= \case
|
||||
Right cc -> (newStablePtr cc >>= poke ctrl) $> DBMOk
|
||||
Left e -> pure e
|
||||
newCStringFromLazyBS $ J.encode r
|
||||
@ -220,10 +220,10 @@ getActiveUser_ :: SQLiteStore -> IO (Maybe User)
|
||||
getActiveUser_ st = find activeUser <$> withTransaction st getUsers
|
||||
|
||||
chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController)
|
||||
chatMigrateInit dbFilePrefix dbKey = chatMigrateInitKey dbFilePrefix dbKey False
|
||||
chatMigrateInit dbFilePrefix dbKey confirm = chatMigrateInitKey dbFilePrefix dbKey False confirm False
|
||||
|
||||
chatMigrateInitKey :: String -> ScrubbedBytes -> Bool -> String -> IO (Either DBMigrationResult ChatController)
|
||||
chatMigrateInitKey dbFilePrefix dbKey keepKey confirm = runExceptT $ do
|
||||
chatMigrateInitKey :: String -> ScrubbedBytes -> Bool -> String -> Bool -> IO (Either DBMigrationResult ChatController)
|
||||
chatMigrateInitKey dbFilePrefix dbKey keepKey confirm backgroundMode = runExceptT $ do
|
||||
confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
|
||||
chatStore <- migrate createChatStore (chatStoreFile dbFilePrefix) confirmMigrations
|
||||
agentStore <- migrate createAgentStore (agentStoreFile dbFilePrefix) confirmMigrations
|
||||
@ -231,7 +231,7 @@ chatMigrateInitKey dbFilePrefix dbKey keepKey confirm = runExceptT $ do
|
||||
where
|
||||
initialize st db = do
|
||||
user_ <- getActiveUser_ st
|
||||
newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix)
|
||||
newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix) backgroundMode
|
||||
migrate createStore dbFile confirmMigrations =
|
||||
ExceptT $
|
||||
(first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey keepKey confirmMigrations)
|
||||
|
@ -29,7 +29,9 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.ByteString.Internal (c2w, w2c)
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
@ -51,7 +53,7 @@ import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
|
||||
import Simplex.Messaging.Version hiding (version)
|
||||
|
||||
currentChatVersion :: Version
|
||||
currentChatVersion = 4
|
||||
currentChatVersion = 5
|
||||
|
||||
supportedChatVRange :: VersionRange
|
||||
supportedChatVRange = mkVersionRange 1 currentChatVersion
|
||||
@ -72,6 +74,10 @@ groupLinkNoContactVRange = mkVersionRange 3 currentChatVersion
|
||||
groupForwardVRange :: VersionRange
|
||||
groupForwardVRange = mkVersionRange 4 currentChatVersion
|
||||
|
||||
-- version range that supports batch sending in groups
|
||||
batchSendVRange :: VersionRange
|
||||
batchSendVRange = mkVersionRange 5 currentChatVersion
|
||||
|
||||
data ConnectionEntity
|
||||
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
|
||||
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
|
||||
@ -447,6 +453,18 @@ durationText duration =
|
||||
| n <= 9 = '0' : show n
|
||||
| otherwise = show n
|
||||
|
||||
msgContentHasText :: MsgContent -> Bool
|
||||
msgContentHasText = \case
|
||||
MCText t -> hasText t
|
||||
MCLink {text} -> hasText text
|
||||
MCImage {text} -> hasText text
|
||||
MCVideo {text} -> hasText text
|
||||
MCVoice {text} -> hasText text
|
||||
MCFile t -> hasText t
|
||||
MCUnknown {text} -> hasText text
|
||||
where
|
||||
hasText = not . T.null
|
||||
|
||||
isVoice :: MsgContent -> Bool
|
||||
isVoice = \case
|
||||
MCVoice {} -> True
|
||||
@ -467,18 +485,34 @@ data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInv
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''QuotedMsg)
|
||||
|
||||
instance MsgEncodingI e => StrEncoding (ChatMessage e) where
|
||||
strEncode msg = case chatToAppMessage msg of
|
||||
AMJson m -> LB.toStrict $ J.encode m
|
||||
AMBinary m -> strEncode m
|
||||
strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
|
||||
-- this limit reserves space for metadata in forwarded messages
|
||||
-- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610
|
||||
maxChatMsgSize :: Int64
|
||||
maxChatMsgSize = 15610
|
||||
|
||||
instance StrEncoding AChatMessage where
|
||||
strEncode (ACMsg _ m) = strEncode m
|
||||
strP =
|
||||
A.peekChar' >>= \case
|
||||
'{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
|
||||
_ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
|
||||
data EncodedChatMessage = ECMEncoded L.ByteString | ECMLarge
|
||||
|
||||
encodeChatMessage :: MsgEncodingI e => ChatMessage e -> EncodedChatMessage
|
||||
encodeChatMessage msg = do
|
||||
case chatToAppMessage msg of
|
||||
AMJson m -> do
|
||||
let body = J.encode m
|
||||
if LB.length body > maxChatMsgSize
|
||||
then ECMLarge
|
||||
else ECMEncoded body
|
||||
AMBinary m -> ECMEncoded . LB.fromStrict $ strEncode m
|
||||
|
||||
parseChatMessages :: ByteString -> [Either String AChatMessage]
|
||||
parseChatMessages "" = [Left "empty string"]
|
||||
parseChatMessages s = case B.head s of
|
||||
'{' -> [ACMsg SJson <$> J.eitherDecodeStrict' s]
|
||||
'[' -> case J.eitherDecodeStrict' s of
|
||||
Right v -> map parseItem v
|
||||
Left e -> [Left e]
|
||||
_ -> [ACMsg SBinary <$> (appBinaryToCM =<< strDecode s)]
|
||||
where
|
||||
parseItem :: J.Value -> Either String AChatMessage
|
||||
parseItem v = ACMsg SJson <$> JT.parseEither parseJSON v
|
||||
|
||||
parseMsgContainer :: J.Object -> JT.Parser MsgContainer
|
||||
parseMsgContainer v =
|
||||
|
@ -46,7 +46,8 @@ module Simplex.Chat.Store.Files
|
||||
createRcvFileTransfer,
|
||||
createRcvGroupFileTransfer,
|
||||
appendRcvFD,
|
||||
getRcvFileDescrByFileId,
|
||||
getRcvFileDescrByRcvFileId,
|
||||
getRcvFileDescrBySndFileId,
|
||||
updateRcvFileAgentId,
|
||||
getRcvFileTransferById,
|
||||
getRcvFileTransfer,
|
||||
@ -542,7 +543,7 @@ createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, file
|
||||
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
|
||||
liftIO (getRcvFileDescrByRcvFileId_ db fileId) >>= \case
|
||||
Nothing -> do
|
||||
rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId currentTs fd
|
||||
liftIO $
|
||||
@ -571,14 +572,14 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD
|
||||
(fileDescrText', fileDescrPartNo, fileDescrComplete, fileDescrId)
|
||||
pure RcvFileDescr {fileDescrId, fileDescrText = fileDescrText', fileDescrPartNo, fileDescrComplete}
|
||||
|
||||
getRcvFileDescrByFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
|
||||
getRcvFileDescrByFileId db fileId = do
|
||||
liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
|
||||
getRcvFileDescrByRcvFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
|
||||
getRcvFileDescrByRcvFileId db fileId = do
|
||||
liftIO (getRcvFileDescrByRcvFileId_ db fileId) >>= \case
|
||||
Nothing -> throwError $ SERcvFileDescrNotFound fileId
|
||||
Just rfd -> pure rfd
|
||||
|
||||
getRcvFileDescrByFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
|
||||
getRcvFileDescrByFileId_ db fileId =
|
||||
getRcvFileDescrByRcvFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
|
||||
getRcvFileDescrByRcvFileId_ db fileId =
|
||||
maybeFirstRow toRcvFileDescr $
|
||||
DB.query
|
||||
db
|
||||
@ -590,10 +591,30 @@ getRcvFileDescrByFileId_ db fileId =
|
||||
LIMIT 1
|
||||
|]
|
||||
(Only fileId)
|
||||
where
|
||||
toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
|
||||
toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
|
||||
RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
|
||||
|
||||
getRcvFileDescrBySndFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
|
||||
getRcvFileDescrBySndFileId db fileId = do
|
||||
liftIO (getRcvFileDescrBySndFileId_ db fileId) >>= \case
|
||||
Nothing -> throwError $ SERcvFileDescrNotFound fileId
|
||||
Just rfd -> pure rfd
|
||||
|
||||
getRcvFileDescrBySndFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
|
||||
getRcvFileDescrBySndFileId_ 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 snd_files f ON f.file_descr_id = d.file_descr_id
|
||||
WHERE f.file_id = ?
|
||||
LIMIT 1
|
||||
|]
|
||||
(Only fileId)
|
||||
|
||||
toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
|
||||
toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
|
||||
RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
|
||||
|
||||
updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO ()
|
||||
updateRcvFileAgentId db fileId aFileId = do
|
||||
@ -626,7 +647,7 @@ getRcvFileTransfer_ db userId fileId = do
|
||||
WHERE f.user_id = ? AND f.file_id = ?
|
||||
|]
|
||||
(userId, fileId)
|
||||
rfd_ <- liftIO $ getRcvFileDescrByFileId_ db fileId
|
||||
rfd_ <- liftIO $ getRcvFileDescrByRcvFileId_ db fileId
|
||||
rcvFileTransfer rfd_ rftRow
|
||||
where
|
||||
rcvFileTransfer ::
|
||||
|
@ -149,7 +149,7 @@ type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Ver
|
||||
|
||||
toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
|
||||
let membership = toGroupMember userContactId userMemberRow
|
||||
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange supportedChatVRange}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
|
||||
fullGroupPreferences = mergeGroupPreferences groupPreferences
|
||||
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
|
||||
|
@ -24,8 +24,8 @@ module Simplex.Chat.Store.Messages
|
||||
createSndMsgDelivery,
|
||||
createNewMessageAndRcvMsgDelivery,
|
||||
createNewRcvMessage,
|
||||
createSndMsgDeliveryEvent,
|
||||
createRcvMsgDeliveryEvent,
|
||||
updateSndMsgDeliveryStatus,
|
||||
updateRcvMsgDeliveryStatus,
|
||||
createPendingGroupMessage,
|
||||
getPendingGroupMessages,
|
||||
deletePendingGroupMessage,
|
||||
@ -99,6 +99,7 @@ module Simplex.Chat.Store.Messages
|
||||
updateGroupSndStatus,
|
||||
getGroupSndStatuses,
|
||||
getGroupSndStatusCounts,
|
||||
getGroupHistoryItems,
|
||||
)
|
||||
where
|
||||
|
||||
@ -159,49 +160,59 @@ deleteGroupCIs db User {userId} GroupInfo {groupId} = do
|
||||
DB.execute db "DELETE FROM chat_item_reactions WHERE group_id = ?" (Only groupId)
|
||||
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
|
||||
createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> (SharedMsgId -> NewMessage e) -> ExceptT StoreError IO SndMessage
|
||||
createNewSndMessage db gVar connOrGroupId mkMessage =
|
||||
createWithRandomId gVar $ \sharedMsgId -> do
|
||||
let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId
|
||||
createdAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO messages (
|
||||
msg_sent, chat_msg_event, msg_body, connection_id, group_id,
|
||||
shared_msg_id, shared_msg_id_user, created_at, updated_at
|
||||
) VALUES (?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
|
||||
msgId <- insertedRowId db
|
||||
pure SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
|
||||
createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage
|
||||
createNewSndMessage db gVar connOrGroupId chatMsgEvent encodeMessage =
|
||||
createWithRandomId' gVar $ \sharedMsgId ->
|
||||
case encodeMessage (SharedMsgId sharedMsgId) of
|
||||
ECMLarge -> pure $ Left SELargeMsg
|
||||
ECMEncoded msgBody -> do
|
||||
createdAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO messages (
|
||||
msg_sent, chat_msg_event, msg_body, connection_id, group_id,
|
||||
shared_msg_id, shared_msg_id_user, created_at, updated_at
|
||||
) VALUES (?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
|
||||
msgId <- insertedRowId db
|
||||
pure $ Right SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
|
||||
where
|
||||
(connId_, groupId_) = case connOrGroupId of
|
||||
ConnectionId connId -> (Just connId, Nothing)
|
||||
GroupId groupId -> (Nothing, Just groupId)
|
||||
|
||||
createSndMsgDelivery :: DB.Connection -> SndMsgDelivery -> MessageId -> IO Int64
|
||||
createSndMsgDelivery db sndMsgDelivery messageId = do
|
||||
createSndMsgDelivery db SndMsgDelivery {connId, agentMsgId} messageId = do
|
||||
currentTs <- getCurrentTime
|
||||
msgDeliveryId <- createSndMsgDelivery_ db sndMsgDelivery messageId currentTs
|
||||
createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs
|
||||
pure msgDeliveryId
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO msg_deliveries
|
||||
(message_id, connection_id, agent_msg_id, chat_ts, created_at, updated_at, delivery_status)
|
||||
VALUES (?,?,?,?,?,?,?)
|
||||
|]
|
||||
(messageId, connId, agentMsgId, currentTs, currentTs, currentTs, MDSSndAgent)
|
||||
insertedRowId db
|
||||
|
||||
createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
||||
createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewRcvMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
||||
createNewMessageAndRcvMsgDelivery db connOrGroupId newMessage sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} authorGroupMemberId_ = do
|
||||
msg@RcvMessage {msgId} <- createNewRcvMessage db connOrGroupId newMessage sharedMsgId_ authorGroupMemberId_ Nothing
|
||||
liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO msg_deliveries (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
|
||||
msgDeliveryId <- insertedRowId db
|
||||
createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
|
||||
[sql|
|
||||
INSERT INTO msg_deliveries
|
||||
(message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at, delivery_status)
|
||||
VALUES (?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs, MDSRcvAgent)
|
||||
pure msg
|
||||
|
||||
createNewRcvMessage :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
||||
createNewRcvMessage db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ authorMember forwardedByMember =
|
||||
createNewRcvMessage :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewRcvMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
||||
createNewRcvMessage db connOrGroupId NewRcvMessage {chatMsgEvent, msgBody} sharedMsgId_ authorMember forwardedByMember =
|
||||
case connOrGroupId of
|
||||
ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing
|
||||
GroupId groupId -> case sharedMsgId_ of
|
||||
@ -236,68 +247,29 @@ createNewRcvMessage db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMs
|
||||
msgId <- insertedRowId db
|
||||
pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorMember, forwardedByMember}
|
||||
|
||||
createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO ()
|
||||
createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
|
||||
msgDeliveryId <- getMsgDeliveryId_ db connId agentMsgId
|
||||
liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
createMsgDeliveryEvent_ db msgDeliveryId sndMsgDeliveryStatus currentTs
|
||||
|
||||
createRcvMsgDeliveryEvent :: DB.Connection -> Int64 -> CommandId -> MsgDeliveryStatus 'MDRcv -> IO ()
|
||||
createRcvMsgDeliveryEvent db connId cmdId rcvMsgDeliveryStatus = do
|
||||
msgDeliveryId <- getMsgDeliveryIdByCmdId_ db connId cmdId
|
||||
forM_ msgDeliveryId $ \mdId -> do
|
||||
currentTs <- getCurrentTime
|
||||
createMsgDeliveryEvent_ db mdId rcvMsgDeliveryStatus currentTs
|
||||
|
||||
createSndMsgDelivery_ :: DB.Connection -> SndMsgDelivery -> MessageId -> UTCTime -> IO Int64
|
||||
createSndMsgDelivery_ db SndMsgDelivery {connId, agentMsgId} messageId createdAt = do
|
||||
updateSndMsgDeliveryStatus :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> IO ()
|
||||
updateSndMsgDeliveryStatus db connId agentMsgId sndMsgDeliveryStatus = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO msg_deliveries
|
||||
(message_id, connection_id, agent_msg_id, agent_msg_meta, chat_ts, created_at, updated_at)
|
||||
VALUES (?,?,?,NULL,?,?,?)
|
||||
UPDATE msg_deliveries
|
||||
SET delivery_status = ?, updated_at = ?
|
||||
WHERE connection_id = ? AND agent_msg_id = ?
|
||||
|]
|
||||
(messageId, connId, agentMsgId, createdAt, createdAt, createdAt)
|
||||
insertedRowId db
|
||||
(sndMsgDeliveryStatus, currentTs, connId, agentMsgId)
|
||||
|
||||
createMsgDeliveryEvent_ :: DB.Connection -> Int64 -> MsgDeliveryStatus d -> UTCTime -> IO ()
|
||||
createMsgDeliveryEvent_ db msgDeliveryId msgDeliveryStatus createdAt = do
|
||||
updateRcvMsgDeliveryStatus :: DB.Connection -> Int64 -> CommandId -> MsgDeliveryStatus 'MDRcv -> IO ()
|
||||
updateRcvMsgDeliveryStatus db connId cmdId rcvMsgDeliveryStatus = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO msg_delivery_events
|
||||
(msg_delivery_id, delivery_status, created_at, updated_at)
|
||||
VALUES (?,?,?,?)
|
||||
UPDATE msg_deliveries
|
||||
SET delivery_status = ?, updated_at = ?
|
||||
WHERE connection_id = ? AND agent_ack_cmd_id = ?
|
||||
|]
|
||||
(msgDeliveryId, msgDeliveryStatus, createdAt, createdAt)
|
||||
|
||||
getMsgDeliveryId_ :: DB.Connection -> Int64 -> AgentMsgId -> ExceptT StoreError IO Int64
|
||||
getMsgDeliveryId_ db connId agentMsgId =
|
||||
ExceptT . firstRow fromOnly (SENoMsgDelivery connId agentMsgId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT msg_delivery_id
|
||||
FROM msg_deliveries m
|
||||
WHERE m.connection_id = ? AND m.agent_msg_id = ?
|
||||
LIMIT 1
|
||||
|]
|
||||
(connId, agentMsgId)
|
||||
|
||||
getMsgDeliveryIdByCmdId_ :: DB.Connection -> Int64 -> CommandId -> IO (Maybe AgentMsgId)
|
||||
getMsgDeliveryIdByCmdId_ db connId cmdId =
|
||||
maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT msg_delivery_id
|
||||
FROM msg_deliveries
|
||||
WHERE connection_id = ? AND agent_ack_cmd_id = ?
|
||||
LIMIT 1
|
||||
|]
|
||||
(connId, cmdId)
|
||||
(rcvMsgDeliveryStatus, currentTs, connId, cmdId)
|
||||
|
||||
createPendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> Maybe Int64 -> IO ()
|
||||
createPendingGroupMessage db groupMemberId messageId introId_ = do
|
||||
@ -2107,3 +2079,25 @@ getGroupSndStatusCounts db itemId =
|
||||
GROUP BY group_snd_item_status
|
||||
|]
|
||||
(Only itemId)
|
||||
|
||||
getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
|
||||
getGroupHistoryItems db user@User {userId} GroupInfo {groupId} count = do
|
||||
chatItemIds <- getLastItemIds_
|
||||
-- use getGroupCIWithReactions to read reactions data
|
||||
reverse <$> mapM (runExceptT . getGroupChatItem db user groupId) chatItemIds
|
||||
where
|
||||
getLastItemIds_ :: IO [ChatItemId]
|
||||
getLastItemIds_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
AND item_content_tag IN (?,?)
|
||||
AND item_deleted = 0
|
||||
ORDER BY item_ts DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, groupId, rcvMsgContentTag, sndMsgContentTag, count)
|
||||
|
@ -93,6 +93,7 @@ import Simplex.Chat.Migrations.M20231114_remote_control
|
||||
import Simplex.Chat.Migrations.M20231126_remote_ctrl_address
|
||||
import Simplex.Chat.Migrations.M20231207_chat_list_pagination
|
||||
import Simplex.Chat.Migrations.M20231214_item_content_tag
|
||||
import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@ -185,7 +186,8 @@ schemaMigrations =
|
||||
("20231114_remote_control", m20231114_remote_control, Just down_m20231114_remote_control),
|
||||
("20231126_remote_ctrl_address", m20231126_remote_ctrl_address, Just down_m20231126_remote_ctrl_address),
|
||||
("20231207_chat_list_pagination", m20231207_chat_list_pagination, Just down_m20231207_chat_list_pagination),
|
||||
("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag)
|
||||
("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag),
|
||||
("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
@ -32,7 +32,7 @@ import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Remote.Types
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
@ -86,8 +86,8 @@ data StoreError
|
||||
| SEPendingConnectionNotFound {connId :: Int64}
|
||||
| SEIntroNotFound
|
||||
| SEUniqueID
|
||||
| SELargeMsg
|
||||
| SEInternalError {message :: String}
|
||||
| SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId}
|
||||
| SEBadChatItem {itemId :: ChatItemId}
|
||||
| SEChatItemNotFound {itemId :: ChatItemId}
|
||||
| SEChatItemNotFoundByText {text :: Text}
|
||||
@ -376,15 +376,21 @@ withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreate
|
||||
createWithRandomId :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
|
||||
createWithRandomId = createWithRandomBytes 12
|
||||
|
||||
createWithRandomId' :: forall a. TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
|
||||
createWithRandomId' = createWithRandomBytes' 12
|
||||
|
||||
createWithRandomBytes :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
|
||||
createWithRandomBytes size gVar create = tryCreate 3
|
||||
createWithRandomBytes size gVar create = createWithRandomBytes' size gVar (fmap Right . create)
|
||||
|
||||
createWithRandomBytes' :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
|
||||
createWithRandomBytes' size gVar create = tryCreate 3
|
||||
where
|
||||
tryCreate :: Int -> ExceptT StoreError IO a
|
||||
tryCreate 0 = throwError SEUniqueID
|
||||
tryCreate n = do
|
||||
id' <- liftIO $ encodedRandomBytes gVar size
|
||||
liftIO (E.try $ create id') >>= \case
|
||||
Right x -> pure x
|
||||
Right x -> liftEither x
|
||||
Left e
|
||||
| SQL.sqlError e == SQL.ErrorConstraint -> tryCreate (n - 1)
|
||||
| otherwise -> throwError . SEInternalError $ show e
|
||||
|
@ -626,7 +626,8 @@ data GroupMember = GroupMember
|
||||
memberContactProfileId :: ProfileId,
|
||||
activeConn :: Maybe Connection,
|
||||
-- member chat protocol version range; if member has active connection, its version range is preferred;
|
||||
-- for membership current supportedChatVRange is set, it's not updated on protocol version increase
|
||||
-- for membership current supportedChatVRange is set, it's not updated on protocol version increase in database,
|
||||
-- but it's correctly set on read (see toGroupInfo)
|
||||
memberChatVRange :: JVersionRange
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
@ -1011,9 +1012,11 @@ data XFTPRcvFile = XFTPRcvFile
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
type RcvFileDescrText = Text
|
||||
|
||||
data RcvFileDescr = RcvFileDescr
|
||||
{ fileDescrId :: Int64,
|
||||
fileDescrText :: Text,
|
||||
fileDescrText :: RcvFileDescrText,
|
||||
fileDescrPartNo :: Int,
|
||||
fileDescrComplete :: Bool
|
||||
}
|
||||
|
@ -147,6 +147,7 @@ data GroupFeature
|
||||
| GFReactions
|
||||
| GFVoice
|
||||
| GFFiles
|
||||
| GFHistory
|
||||
deriving (Show)
|
||||
|
||||
data SGroupFeature (f :: GroupFeature) where
|
||||
@ -156,6 +157,7 @@ data SGroupFeature (f :: GroupFeature) where
|
||||
SGFReactions :: SGroupFeature 'GFReactions
|
||||
SGFVoice :: SGroupFeature 'GFVoice
|
||||
SGFFiles :: SGroupFeature 'GFFiles
|
||||
SGFHistory :: SGroupFeature 'GFHistory
|
||||
|
||||
deriving instance Show (SGroupFeature f)
|
||||
|
||||
@ -171,6 +173,7 @@ groupFeatureNameText = \case
|
||||
GFReactions -> "Message reactions"
|
||||
GFVoice -> "Voice messages"
|
||||
GFFiles -> "Files and media"
|
||||
GFHistory -> "Recent history"
|
||||
|
||||
groupFeatureNameText' :: SGroupFeature f -> Text
|
||||
groupFeatureNameText' = groupFeatureNameText . toGroupFeature
|
||||
@ -186,7 +189,8 @@ allGroupFeatures =
|
||||
AGF SGFFullDelete,
|
||||
AGF SGFReactions,
|
||||
AGF SGFVoice,
|
||||
AGF SGFFiles
|
||||
AGF SGFFiles,
|
||||
AGF SGFHistory
|
||||
]
|
||||
|
||||
groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
|
||||
@ -197,6 +201,7 @@ groupPrefSel = \case
|
||||
SGFReactions -> reactions
|
||||
SGFVoice -> voice
|
||||
SGFFiles -> files
|
||||
SGFHistory -> history
|
||||
|
||||
toGroupFeature :: SGroupFeature f -> GroupFeature
|
||||
toGroupFeature = \case
|
||||
@ -206,6 +211,7 @@ toGroupFeature = \case
|
||||
SGFReactions -> GFReactions
|
||||
SGFVoice -> GFVoice
|
||||
SGFFiles -> GFFiles
|
||||
SGFHistory -> GFHistory
|
||||
|
||||
class GroupPreferenceI p where
|
||||
getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
|
||||
@ -224,6 +230,7 @@ instance GroupPreferenceI FullGroupPreferences where
|
||||
SGFReactions -> reactions
|
||||
SGFVoice -> voice
|
||||
SGFFiles -> files
|
||||
SGFHistory -> history
|
||||
{-# INLINE getGroupPreference #-}
|
||||
|
||||
-- collection of optional group preferences
|
||||
@ -233,7 +240,8 @@ data GroupPreferences = GroupPreferences
|
||||
fullDelete :: Maybe FullDeleteGroupPreference,
|
||||
reactions :: Maybe ReactionsGroupPreference,
|
||||
voice :: Maybe VoiceGroupPreference,
|
||||
files :: Maybe FilesGroupPreference
|
||||
files :: Maybe FilesGroupPreference,
|
||||
history :: Maybe HistoryGroupPreference
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@ -258,6 +266,7 @@ setGroupPreference_ f pref prefs =
|
||||
SGFReactions -> prefs {reactions = pref}
|
||||
SGFVoice -> prefs {voice = pref}
|
||||
SGFFiles -> prefs {files = pref}
|
||||
SGFHistory -> prefs {history = pref}
|
||||
|
||||
setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
|
||||
setGroupTimedMessagesPreference pref prefs_ =
|
||||
@ -284,7 +293,8 @@ data FullGroupPreferences = FullGroupPreferences
|
||||
fullDelete :: FullDeleteGroupPreference,
|
||||
reactions :: ReactionsGroupPreference,
|
||||
voice :: VoiceGroupPreference,
|
||||
files :: FilesGroupPreference
|
||||
files :: FilesGroupPreference,
|
||||
history :: HistoryGroupPreference
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@ -339,11 +349,12 @@ defaultGroupPrefs =
|
||||
fullDelete = FullDeleteGroupPreference {enable = FEOff},
|
||||
reactions = ReactionsGroupPreference {enable = FEOn},
|
||||
voice = VoiceGroupPreference {enable = FEOn},
|
||||
files = FilesGroupPreference {enable = FEOn}
|
||||
files = FilesGroupPreference {enable = FEOn},
|
||||
history = HistoryGroupPreference {enable = FEOff}
|
||||
}
|
||||
|
||||
emptyGroupPrefs :: GroupPreferences
|
||||
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
data TimedMessagesPreference = TimedMessagesPreference
|
||||
{ allow :: FeatureAllowed,
|
||||
@ -438,6 +449,10 @@ data FilesGroupPreference = FilesGroupPreference
|
||||
{enable :: GroupFeatureEnabled}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data HistoryGroupPreference = HistoryGroupPreference
|
||||
{enable :: GroupFeatureEnabled}
|
||||
deriving (Eq, Show)
|
||||
|
||||
class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
|
||||
type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
|
||||
sGroupFeature :: SGroupFeature f
|
||||
@ -464,6 +479,9 @@ instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
|
||||
instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
|
||||
hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference))
|
||||
|
||||
instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
|
||||
hasField p = (\enable -> p {enable}, enable (p :: HistoryGroupPreference))
|
||||
|
||||
instance GroupFeatureI 'GFTimedMessages where
|
||||
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
|
||||
sGroupFeature = SGFTimedMessages
|
||||
@ -494,6 +512,11 @@ instance GroupFeatureI 'GFFiles where
|
||||
sGroupFeature = SGFFiles
|
||||
groupPrefParam _ = Nothing
|
||||
|
||||
instance GroupFeatureI 'GFHistory where
|
||||
type GroupFeaturePreference 'GFHistory = HistoryGroupPreference
|
||||
sGroupFeature = SGFHistory
|
||||
groupPrefParam _ = Nothing
|
||||
|
||||
groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
|
||||
groupPrefStateText feature pref param =
|
||||
let enabled = getField @"enable" pref
|
||||
@ -616,7 +639,8 @@ mergeGroupPreferences groupPreferences =
|
||||
fullDelete = pref SGFFullDelete,
|
||||
reactions = pref SGFReactions,
|
||||
voice = pref SGFVoice,
|
||||
files = pref SGFFiles
|
||||
files = pref SGFFiles,
|
||||
history = pref SGFHistory
|
||||
}
|
||||
where
|
||||
pref :: SGroupFeature f -> GroupFeaturePreference f
|
||||
@ -630,7 +654,8 @@ toGroupPreferences groupPreferences =
|
||||
fullDelete = pref SGFFullDelete,
|
||||
reactions = pref SGFReactions,
|
||||
voice = pref SGFVoice,
|
||||
files = pref SGFFiles
|
||||
files = pref SGFFiles,
|
||||
history = pref SGFHistory
|
||||
}
|
||||
where
|
||||
pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
|
||||
@ -736,6 +761,8 @@ $(J.deriveJSON defaultJSON ''VoiceGroupPreference)
|
||||
|
||||
$(J.deriveJSON defaultJSON ''FilesGroupPreference)
|
||||
|
||||
$(J.deriveJSON defaultJSON ''HistoryGroupPreference)
|
||||
|
||||
$(J.deriveJSON defaultJSON ''GroupPreferences)
|
||||
|
||||
instance ToField GroupPreferences where
|
||||
|
@ -1,12 +1,18 @@
|
||||
module Simplex.Chat.Util (week, encryptFile, chunkSize) where
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Simplex.Chat.Util (week, encryptFile, chunkSize, shuffle) where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.IO.Class
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.List (sortBy)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Time (NominalDiffTime)
|
||||
import Data.Word (Word16)
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import System.Random (randomRIO)
|
||||
import UnliftIO.IO (IOMode (..), withFile)
|
||||
|
||||
week :: NominalDiffTime
|
||||
@ -30,3 +36,9 @@ encryptFile fromPath toPath cfArgs = do
|
||||
chunkSize :: Num a => a
|
||||
chunkSize = 65536
|
||||
{-# INLINE chunkSize #-}
|
||||
|
||||
shuffle :: [a] -> IO [a]
|
||||
shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) xs
|
||||
where
|
||||
random :: IO Word16
|
||||
random = randomRIO (0, 65535)
|
||||
|
@ -175,7 +175,7 @@ startTestChat_ :: ChatDatabase -> ChatConfig -> ChatOpts -> User -> IO TestCC
|
||||
startTestChat_ db cfg opts user = do
|
||||
t <- withVirtualTerminal termSettings pure
|
||||
ct <- newChatTerminal t opts
|
||||
cc <- newChatController db (Just user) cfg opts
|
||||
cc <- newChatController db (Just user) cfg opts False
|
||||
chatAsync <- async . runSimplexChat opts user cc $ \_u cc' -> runChatTerminal ct cc' opts
|
||||
atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry
|
||||
termQ <- newTQueueIO
|
||||
|
@ -16,14 +16,11 @@ import Simplex.Chat (roundedFDCount)
|
||||
import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig)
|
||||
import Simplex.Chat.Mobile.File
|
||||
import Simplex.Chat.Options (ChatOpts (..))
|
||||
import Simplex.FileTransfer.Client.Main (xftpClientCLI)
|
||||
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Util (unlessM)
|
||||
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize)
|
||||
import System.Environment (withArgs)
|
||||
import System.IO.Silently (capture_)
|
||||
import Test.Hspec
|
||||
|
||||
chatFileTests :: SpecWith FilePath
|
||||
@ -1496,7 +1493,7 @@ testXFTPCancelRcvRepeat =
|
||||
dest <- B.readFile "./tests/tmp/testfile_1"
|
||||
dest `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
cfg = testCfg {xftpDescrPartSize = 200, xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testAutoAcceptFile :: HasCallStack => FilePath -> IO ()
|
||||
testAutoAcceptFile =
|
||||
@ -1548,9 +1545,6 @@ testProhibitFiles =
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
xftpCLI :: [String] -> IO [String]
|
||||
xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)
|
||||
|
||||
startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
|
||||
startFileTransfer alice bob =
|
||||
startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"
|
||||
|
@ -115,6 +115,19 @@ chatGroupTests = do
|
||||
it "forward file (x.msg.file.descr)" testGroupMsgForwardFile
|
||||
it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole
|
||||
it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember
|
||||
describe "group history" $ do
|
||||
it "text messages" testGroupHistory
|
||||
it "history is sent when joining via group link" testGroupHistoryGroupLink
|
||||
it "history is not sent if preference is disabled" testGroupHistoryPreferenceOff
|
||||
it "host's file" testGroupHistoryHostFile
|
||||
it "member's file" testGroupHistoryMemberFile
|
||||
it "large file with text" testGroupHistoryLargeFile
|
||||
it "multiple files" testGroupHistoryMultipleFiles
|
||||
it "cancelled files are not attached (text message is still sent)" testGroupHistoryFileCancel
|
||||
it "cancelled files without text are excluded" testGroupHistoryFileCancelNoText
|
||||
it "quoted messages" testGroupHistoryQuotes
|
||||
it "deleted message is not included" testGroupHistoryDeletedMessage
|
||||
it "disappearing message is sent as disappearing" testGroupHistoryDisappearingMessage
|
||||
where
|
||||
_0 = supportedChatVRange -- don't create direct connections
|
||||
_1 = groupCreateDirectVRange
|
||||
@ -1447,6 +1460,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile
|
||||
alice <## "Message reactions: on"
|
||||
alice <## "Voice messages: on"
|
||||
alice <## "Files and media: on"
|
||||
alice <## "Recent history: on"
|
||||
bobAddedDan :: HasCallStack => TestCC -> IO ()
|
||||
bobAddedDan cc = do
|
||||
cc <## "#team: bob added dan (Daniel) to the group (connecting...)"
|
||||
@ -4116,3 +4130,735 @@ testGroupMsgForwardNewMember =
|
||||
"cath (Catherine): admin, connected",
|
||||
"dan (Daniel): member"
|
||||
]
|
||||
|
||||
testGroupHistory :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistory =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice #> "#team hello"
|
||||
bob <# "#team alice> hello"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob #> "#team hey!"
|
||||
alice <# "#team bob> hey!"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team alice> hello [>>]",
|
||||
WithTime "#team bob> hey! [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r <- chat <$> getTermLine cath
|
||||
r `shouldContain` [(0, "hello"), (0, "hey!")]
|
||||
|
||||
-- message delivery works after sending history
|
||||
alice #> "#team 1"
|
||||
[bob, cath] *<# "#team alice> 1"
|
||||
bob #> "#team 2"
|
||||
[alice, cath] *<# "#team bob> 2"
|
||||
cath #> "#team 3"
|
||||
[alice, bob] *<# "#team cath> 3"
|
||||
|
||||
testGroupHistoryGroupLink :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryGroupLink =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice #> "#team hello"
|
||||
bob <# "#team alice> hello"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob #> "#team hey!"
|
||||
alice <# "#team bob> hey!"
|
||||
|
||||
alice ##> "/create link #team"
|
||||
gLink <- getGroupLink alice "team" GRMember True
|
||||
|
||||
cath ##> ("/c " <> gLink)
|
||||
cath <## "connection request sent!"
|
||||
alice <## "cath (Catherine): accepting request to join group #team..."
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: joining the group...",
|
||||
"#team: you joined the group",
|
||||
WithTime "#team alice> hello [>>]",
|
||||
WithTime "#team bob> hey! [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r <- chat <$> getTermLine cath
|
||||
r `shouldContain` [(0, "hello"), (0, "hey!")]
|
||||
|
||||
-- message delivery works after sending history
|
||||
alice #> "#team 1"
|
||||
[bob, cath] *<# "#team alice> 1"
|
||||
bob #> "#team 2"
|
||||
[alice, cath] *<# "#team bob> 2"
|
||||
cath #> "#team 3"
|
||||
[alice, bob] *<# "#team cath> 3"
|
||||
|
||||
testGroupHistoryPreferenceOff :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryPreferenceOff =
|
||||
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice #> "#team hello"
|
||||
bob <# "#team alice> hello"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob #> "#team hey!"
|
||||
alice <# "#team bob> hey!"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team alice> hello [>>]",
|
||||
WithTime "#team bob> hey! [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r <- chat <$> getTermLine cath
|
||||
r `shouldContain` [(0, "hello"), (0, "hey!")]
|
||||
|
||||
alice ##> "/set history #team off"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Recent history: off"
|
||||
concurrentlyN_
|
||||
[ do
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Recent history: off",
|
||||
do
|
||||
cath <## "alice updated group #team:"
|
||||
cath <## "updated group preferences:"
|
||||
cath <## "Recent history: off"
|
||||
]
|
||||
|
||||
connectUsers alice dan
|
||||
addMember "team" alice dan GRAdmin
|
||||
dan ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: dan joined the group",
|
||||
do
|
||||
dan <## "#team: you joined the group"
|
||||
dan
|
||||
<### [ "#team: member bob (Bob) is connected",
|
||||
"#team: member cath (Catherine) is connected"
|
||||
],
|
||||
aliceAddedDan bob,
|
||||
aliceAddedDan cath
|
||||
]
|
||||
|
||||
dan ##> "/_get chat #1 count=100"
|
||||
r' <- chat <$> getTermLine dan
|
||||
r' `shouldNotContain` [(0, "hello")]
|
||||
r' `shouldNotContain` [(0, "hey!")]
|
||||
where
|
||||
aliceAddedDan :: HasCallStack => TestCC -> IO ()
|
||||
aliceAddedDan cc = do
|
||||
cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
|
||||
cc <## "#team: new member dan is connected"
|
||||
|
||||
testGroupHistoryHostFile :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryHostFile =
|
||||
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
alice #> "/f #team ./tests/fixtures/test.jpg"
|
||||
alice <## "use /fc 1 to cancel sending"
|
||||
alice <## "completed uploading file 1 (test.jpg) for #team"
|
||||
|
||||
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]",
|
||||
"use /fr 1 [<dir>/ | <path>] to receive it [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/fr 1 ./tests/tmp"
|
||||
cath
|
||||
<### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
|
||||
"started receiving file 1 (test.jpg) from alice"
|
||||
]
|
||||
cath <## "completed receiving file 1 (test.jpg) from alice"
|
||||
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||
dest `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testGroupHistoryMemberFile :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryMemberFile =
|
||||
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
bob #> "/f #team ./tests/fixtures/test.jpg"
|
||||
bob <## "use /fc 1 to cancel sending"
|
||||
bob <## "completed uploading file 1 (test.jpg) for #team"
|
||||
|
||||
alice <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
||||
alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]",
|
||||
"use /fr 1 [<dir>/ | <path>] to receive it [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/fr 1 ./tests/tmp"
|
||||
cath
|
||||
<### [ "saving file 1 from bob to ./tests/tmp/test.jpg",
|
||||
"started receiving file 1 (test.jpg) from bob"
|
||||
]
|
||||
cath <## "completed receiving file 1 (test.jpg) from bob"
|
||||
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||
dest `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testGroupHistoryLargeFile :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryLargeFile =
|
||||
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile"]
|
||||
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile\", \"msgContent\": {\"text\":\"hello\",\"type\":\"file\"}}"
|
||||
bob <# "#team hello"
|
||||
bob <# "/f #team ./tests/tmp/testfile"
|
||||
bob <## "use /fc 1 to cancel sending"
|
||||
bob <## "completed uploading file 1 (testfile) for #team"
|
||||
|
||||
alice <# "#team bob> hello"
|
||||
alice <# "#team bob> sends file testfile (17.0 MiB / 17825792 bytes)"
|
||||
alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
|
||||
-- admin receiving file does not prevent the new member from receiving it later
|
||||
alice ##> "/fr 1 ./tests/tmp"
|
||||
alice
|
||||
<### [ "saving file 1 from bob to ./tests/tmp/testfile_1",
|
||||
"started receiving file 1 (testfile) from bob"
|
||||
]
|
||||
alice <## "completed receiving file 1 (testfile) from bob"
|
||||
src <- B.readFile "./tests/tmp/testfile"
|
||||
destAlice <- B.readFile "./tests/tmp/testfile_1"
|
||||
destAlice `shouldBe` src
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team bob> hello [>>]",
|
||||
WithTime "#team bob> sends file testfile (17.0 MiB / 17825792 bytes) [>>]",
|
||||
"use /fr 1 [<dir>/ | <path>] to receive it [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/fr 1 ./tests/tmp"
|
||||
cath
|
||||
<### [ "saving file 1 from bob to ./tests/tmp/testfile_2",
|
||||
"started receiving file 1 (testfile) from bob"
|
||||
]
|
||||
cath <## "completed receiving file 1 (testfile) from bob"
|
||||
|
||||
destCath <- B.readFile "./tests/tmp/testfile_2"
|
||||
destCath `shouldBe` src
|
||||
where
|
||||
cfg = testCfg {xftpDescrPartSize = 200, xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testGroupHistoryMultipleFiles :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryMultipleFiles =
|
||||
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
|
||||
xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
|
||||
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}"
|
||||
bob <# "#team hi alice"
|
||||
bob <# "/f #team ./tests/tmp/testfile_bob"
|
||||
bob <## "use /fc 1 to cancel sending"
|
||||
bob <## "completed uploading file 1 (testfile_bob) for #team"
|
||||
|
||||
alice <# "#team bob> hi alice"
|
||||
alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)"
|
||||
alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}"
|
||||
alice <# "#team hey bob"
|
||||
alice <# "/f #team ./tests/tmp/testfile_alice"
|
||||
alice <## "use /fc 2 to cancel sending"
|
||||
alice <## "completed uploading file 2 (testfile_alice) for #team"
|
||||
|
||||
bob <# "#team alice> hey bob"
|
||||
bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)"
|
||||
bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team bob> hi alice [>>]",
|
||||
WithTime "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes) [>>]",
|
||||
"use /fr 1 [<dir>/ | <path>] to receive it [>>]",
|
||||
WithTime "#team alice> hey bob [>>]",
|
||||
WithTime "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes) [>>]",
|
||||
"use /fr 2 [<dir>/ | <path>] to receive it [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/fr 1 ./tests/tmp"
|
||||
cath
|
||||
<### [ "saving file 1 from bob to ./tests/tmp/testfile_bob_1",
|
||||
"started receiving file 1 (testfile_bob) from bob"
|
||||
]
|
||||
cath <## "completed receiving file 1 (testfile_bob) from bob"
|
||||
srcBob <- B.readFile "./tests/tmp/testfile_bob"
|
||||
destBob <- B.readFile "./tests/tmp/testfile_bob_1"
|
||||
destBob `shouldBe` srcBob
|
||||
|
||||
cath ##> "/fr 2 ./tests/tmp"
|
||||
cath
|
||||
<### [ "saving file 2 from alice to ./tests/tmp/testfile_alice_1",
|
||||
"started receiving file 2 (testfile_alice) from alice"
|
||||
]
|
||||
cath <## "completed receiving file 2 (testfile_alice) from alice"
|
||||
srcAlice <- B.readFile "./tests/tmp/testfile_alice"
|
||||
destAlice <- B.readFile "./tests/tmp/testfile_alice_1"
|
||||
destAlice `shouldBe` srcAlice
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r <- chatF <$> getTermLine cath
|
||||
r
|
||||
`shouldContain` [ ((0, "hi alice"), Just "./tests/tmp/testfile_bob_1"),
|
||||
((0, "hey bob"), Just "./tests/tmp/testfile_alice_1")
|
||||
]
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testGroupHistoryFileCancel :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryFileCancel =
|
||||
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
|
||||
xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
|
||||
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}"
|
||||
bob <# "#team hi alice"
|
||||
bob <# "/f #team ./tests/tmp/testfile_bob"
|
||||
bob <## "use /fc 1 to cancel sending"
|
||||
bob <## "completed uploading file 1 (testfile_bob) for #team"
|
||||
|
||||
alice <# "#team bob> hi alice"
|
||||
alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)"
|
||||
alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
|
||||
bob ##> "/fc 1"
|
||||
bob <## "cancelled sending file 1 (testfile_bob) to alice"
|
||||
alice <## "bob cancelled sending file 1 (testfile_bob)"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}"
|
||||
alice <# "#team hey bob"
|
||||
alice <# "/f #team ./tests/tmp/testfile_alice"
|
||||
alice <## "use /fc 2 to cancel sending"
|
||||
alice <## "completed uploading file 2 (testfile_alice) for #team"
|
||||
|
||||
bob <# "#team alice> hey bob"
|
||||
bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)"
|
||||
bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
||||
|
||||
alice ##> "/fc 2"
|
||||
alice <## "cancelled sending file 2 (testfile_alice) to bob"
|
||||
bob <## "alice cancelled sending file 2 (testfile_alice)"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team bob> hi alice [>>]",
|
||||
WithTime "#team alice> hey bob [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testGroupHistoryFileCancelNoText :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryFileCancelNoText =
|
||||
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
|
||||
xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
|
||||
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
alice #> "#team hello"
|
||||
bob <# "#team alice> hello"
|
||||
|
||||
-- bob file
|
||||
|
||||
bob #> "/f #team ./tests/tmp/testfile_bob"
|
||||
bob <## "use /fc 1 to cancel sending"
|
||||
bob <## "completed uploading file 1 (testfile_bob) for #team"
|
||||
|
||||
alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)"
|
||||
alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
|
||||
bob ##> "/fc 1"
|
||||
bob <## "cancelled sending file 1 (testfile_bob) to alice"
|
||||
alice <## "bob cancelled sending file 1 (testfile_bob)"
|
||||
|
||||
-- alice file
|
||||
|
||||
alice #> "/f #team ./tests/tmp/testfile_alice"
|
||||
alice <## "use /fc 2 to cancel sending"
|
||||
alice <## "completed uploading file 2 (testfile_alice) for #team"
|
||||
|
||||
bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)"
|
||||
bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
||||
|
||||
alice ##> "/fc 2"
|
||||
alice <## "cancelled sending file 2 (testfile_alice) to bob"
|
||||
bob <## "alice cancelled sending file 2 (testfile_alice)"
|
||||
|
||||
-- other messages are sent
|
||||
|
||||
bob #> "#team hey!"
|
||||
alice <# "#team bob> hey!"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team alice> hello [>>]",
|
||||
WithTime "#team bob> hey! [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testGroupHistoryQuotes :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryQuotes =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice #> "#team ALICE"
|
||||
bob <# "#team alice> ALICE"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob #> "#team BOB"
|
||||
alice <# "#team bob> BOB"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice `send` "> #team @alice (ALICE) 1"
|
||||
alice <# "#team > alice ALICE"
|
||||
alice <## " 1"
|
||||
bob <# "#team alice> > alice ALICE"
|
||||
bob <## " 1"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice `send` "> #team @bob (BOB) 2"
|
||||
alice <# "#team > bob BOB"
|
||||
alice <## " 2"
|
||||
bob <# "#team alice> > bob BOB"
|
||||
bob <## " 2"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob `send` "> #team @alice (ALICE) 3"
|
||||
bob <# "#team > alice ALICE"
|
||||
bob <## " 3"
|
||||
alice <# "#team bob> > alice ALICE"
|
||||
alice <## " 3"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob `send` "> #team @bob (BOB) 4"
|
||||
bob <# "#team > bob BOB"
|
||||
bob <## " 4"
|
||||
alice <# "#team bob> > bob BOB"
|
||||
alice <## " 4"
|
||||
|
||||
alice
|
||||
#$> ( "/_get chat #1 count=6",
|
||||
chat',
|
||||
[ ((1, "ALICE"), Nothing),
|
||||
((0, "BOB"), Nothing),
|
||||
((1, "1"), Just (1, "ALICE")),
|
||||
((1, "2"), Just (0, "BOB")),
|
||||
((0, "3"), Just (1, "ALICE")),
|
||||
((0, "4"), Just (0, "BOB"))
|
||||
]
|
||||
)
|
||||
bob
|
||||
#$> ( "/_get chat #1 count=6",
|
||||
chat',
|
||||
[ ((0, "ALICE"), Nothing),
|
||||
((1, "BOB"), Nothing),
|
||||
((0, "1"), Just (0, "ALICE")),
|
||||
((0, "2"), Just (1, "BOB")),
|
||||
((1, "3"), Just (0, "ALICE")),
|
||||
((1, "4"), Just (1, "BOB"))
|
||||
]
|
||||
)
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team alice> ALICE [>>]",
|
||||
WithTime "#team bob> BOB [>>]",
|
||||
WithTime "#team alice> > alice ALICE [>>]",
|
||||
" 1 [>>]",
|
||||
WithTime "#team alice> > bob BOB [>>]",
|
||||
" 2 [>>]",
|
||||
WithTime "#team bob> > alice ALICE [>>]",
|
||||
" 3 [>>]",
|
||||
WithTime "#team bob> > bob BOB [>>]",
|
||||
" 4 [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r <- chat' <$> getTermLine cath
|
||||
r
|
||||
`shouldContain` [ ((0, "ALICE"), Nothing),
|
||||
((0, "BOB"), Nothing),
|
||||
((0, "1"), Just (0, "ALICE")),
|
||||
((0, "2"), Just (0, "BOB")),
|
||||
((0, "3"), Just (0, "ALICE")),
|
||||
((0, "4"), Just (0, "BOB"))
|
||||
]
|
||||
|
||||
testGroupHistoryDeletedMessage :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryDeletedMessage =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
alice #> "#team hello"
|
||||
bob <# "#team alice> hello"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
bob #> "#team hey!"
|
||||
alice <# "#team bob> hey!"
|
||||
|
||||
bobMsgId <- lastItemId bob
|
||||
bob #$> ("/_delete item #1 " <> bobMsgId <> " broadcast", id, "message marked deleted")
|
||||
alice <# "#team bob> [marked deleted] hey!"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team alice> hello [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r <- chat <$> getTermLine cath
|
||||
r `shouldContain` [(0, "hello")]
|
||||
r `shouldNotContain` [(0, "hey!")]
|
||||
|
||||
testGroupHistoryDisappearingMessage :: HasCallStack => FilePath -> IO ()
|
||||
testGroupHistoryDisappearingMessage =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice #> "#team 1"
|
||||
bob <# "#team alice> 1"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
-- 3 seconds so that messages 2 and 3 are not deleted for alice before sending history to cath
|
||||
alice ##> "/set disappear #team on 3"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages: on (3 sec)"
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages: on (3 sec)"
|
||||
|
||||
bob #> "#team 2"
|
||||
alice <# "#team bob> 2"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice #> "#team 3"
|
||||
bob <# "#team alice> 3"
|
||||
|
||||
threadDelay 1000000
|
||||
|
||||
alice ##> "/set disappear #team off"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages: off"
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages: off"
|
||||
|
||||
bob #> "#team 4"
|
||||
alice <# "#team bob> 4"
|
||||
|
||||
connectUsers alice cath
|
||||
addMember "team" alice cath GRAdmin
|
||||
cath ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: cath joined the group",
|
||||
cath
|
||||
<### [ "#team: you joined the group",
|
||||
WithTime "#team alice> 1 [>>]",
|
||||
WithTime "#team bob> 2 [>>]",
|
||||
WithTime "#team alice> 3 [>>]",
|
||||
WithTime "#team bob> 4 [>>]",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
||||
bob <## "#team: new member cath is connected"
|
||||
]
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r1 <- chat <$> getTermLine cath
|
||||
r1 `shouldContain` [(0, "1"), (0, "2"), (0, "3"), (0, "4")]
|
||||
|
||||
concurrentlyN_
|
||||
[ do
|
||||
alice <## "timed message deleted: 2"
|
||||
alice <## "timed message deleted: 3",
|
||||
do
|
||||
bob <## "timed message deleted: 2"
|
||||
bob <## "timed message deleted: 3",
|
||||
do
|
||||
cath <## "timed message deleted: 2"
|
||||
cath <## "timed message deleted: 3"
|
||||
]
|
||||
|
||||
cath ##> "/_get chat #1 count=100"
|
||||
r2 <- chat <$> getTermLine cath
|
||||
r2 `shouldContain` [(0, "1"), (0, "4")]
|
||||
r2 `shouldNotContain` [(0, "2")]
|
||||
r2 `shouldNotContain` [(0, "3")]
|
||||
|
@ -1601,7 +1601,7 @@ testUpdateGroupPrefs =
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected")])
|
||||
threadDelay 500000
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected")])
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}}}"
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Full deletion: on"
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on")])
|
||||
@ -1610,7 +1610,7 @@ testUpdateGroupPrefs =
|
||||
bob <## "Full deletion: on"
|
||||
threadDelay 500000
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on")])
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"off\"}, \"directMessages\": {\"enable\": \"on\"}}}"
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"off\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Full deletion: off"
|
||||
alice <## "Voice messages: off"
|
||||
@ -1621,7 +1621,6 @@ testUpdateGroupPrefs =
|
||||
bob <## "Voice messages: off"
|
||||
threadDelay 500000
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off")])
|
||||
-- alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
|
||||
alice ##> "/set voice #team on"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Voice messages: on"
|
||||
@ -1632,7 +1631,7 @@ testUpdateGroupPrefs =
|
||||
threadDelay 500000
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off"), (0, "Voice messages: on")])
|
||||
threadDelay 500000
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}}}"
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
|
||||
-- no update
|
||||
threadDelay 500000
|
||||
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")])
|
||||
@ -1798,7 +1797,7 @@ testEnableTimedMessagesGroup =
|
||||
\alice bob -> do
|
||||
createGroup2 "team" alice bob
|
||||
threadDelay 1000000
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}}}"
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages: on (1 sec)"
|
||||
bob <## "alice updated group #team:"
|
||||
|
@ -23,13 +23,15 @@ import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Store.Profiles (getUserContactProfiles)
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.FileTransfer.Client.Main (xftpClientCLI)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Version
|
||||
import System.Directory (doesFileExist)
|
||||
import System.Environment (lookupEnv)
|
||||
import System.Environment (lookupEnv, withArgs)
|
||||
import System.FilePath ((</>))
|
||||
import System.IO.Silently (capture_)
|
||||
import System.Info (os)
|
||||
import Test.Hspec
|
||||
|
||||
@ -219,7 +221,8 @@ groupFeatures'' =
|
||||
((0, "Full deletion: off"), Nothing, Nothing),
|
||||
((0, "Message reactions: on"), Nothing, Nothing),
|
||||
((0, "Voice messages: on"), Nothing, Nothing),
|
||||
((0, "Files and media: on"), Nothing, Nothing)
|
||||
((0, "Files and media: on"), Nothing, Nothing),
|
||||
((0, "Recent history: on"), Nothing, Nothing)
|
||||
]
|
||||
|
||||
itemId :: Int -> String
|
||||
@ -597,3 +600,6 @@ linkAnotherSchema link
|
||||
| "simplex:/" `isPrefixOf` link =
|
||||
T.unpack $ T.replace "simplex:/" "https://simplex.chat/" $ T.pack link
|
||||
| otherwise = error "link starts with neither https://simplex.chat/ nor simplex:/"
|
||||
|
||||
xftpCLI :: [String] -> IO [String]
|
||||
xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)
|
||||
|
120
tests/MessageBatching.hs
Normal file
120
tests/MessageBatching.hs
Normal file
@ -0,0 +1,120 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module MessageBatching (batchingTests) where
|
||||
|
||||
import Crypto.Number.Serialize (os2ip)
|
||||
import Data.ByteString.Builder (toLazyByteString)
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Either (partitionEithers)
|
||||
import Data.Int (Int64)
|
||||
import Data.String (IsString (..))
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Simplex.Chat.Messages.Batch
|
||||
import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
|
||||
import Simplex.Chat.Messages (SndMessage (..))
|
||||
import Simplex.Chat.Protocol (SharedMsgId (..), maxChatMsgSize)
|
||||
import Test.Hspec
|
||||
|
||||
batchingTests :: Spec
|
||||
batchingTests = describe "message batching tests" $ do
|
||||
testBatchingCorrectness
|
||||
it "image x.msg.new and x.msg.file.descr should fit into single batch" testImageFitsSingleBatch
|
||||
|
||||
instance IsString SndMessage where
|
||||
fromString s = SndMessage {msgId, sharedMsgId = SharedMsgId "", msgBody = LB.fromStrict s'}
|
||||
where
|
||||
s' = encodeUtf8 $ T.pack s
|
||||
msgId = fromInteger $ os2ip s'
|
||||
|
||||
deriving instance Eq SndMessage
|
||||
|
||||
instance IsString ChatError where
|
||||
fromString s = ChatError $ CEInternalError ("large message " <> show msgId)
|
||||
where
|
||||
s' = encodeUtf8 $ T.pack s
|
||||
msgId = fromInteger (os2ip s') :: Int64
|
||||
|
||||
testBatchingCorrectness :: Spec
|
||||
testBatchingCorrectness = describe "correctness tests" $ do
|
||||
runBatcherTest 8 ["a"] [] ["a"]
|
||||
runBatcherTest 8 ["a", "b"] [] ["[a,b]"]
|
||||
runBatcherTest 8 ["a", "b", "c"] [] ["[a,b,c]"]
|
||||
runBatcherTest 8 ["a", "bb", "c"] [] ["[a,bb,c]"]
|
||||
runBatcherTest 8 ["a", "b", "c", "d"] [] ["a", "[b,c,d]"]
|
||||
runBatcherTest 8 ["a", "bb", "c", "d"] [] ["a", "[bb,c,d]"]
|
||||
runBatcherTest 8 ["a", "bb", "c", "de"] [] ["[a,bb]", "[c,de]"]
|
||||
runBatcherTest 8 ["a", "b", "c", "d", "e"] [] ["[a,b]", "[c,d,e]"]
|
||||
runBatcherTest 8 ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j"] [] ["a", "[b,c,d]", "[e,f,g]", "[h,i,j]"]
|
||||
runBatcherTest 8 ["aaaaa"] [] ["aaaaa"]
|
||||
runBatcherTest 8 ["8aaaaaaa"] [] ["8aaaaaaa"]
|
||||
runBatcherTest 8 ["aaaa", "bbbb"] [] ["aaaa", "bbbb"]
|
||||
runBatcherTest 8 ["aa", "bbb", "cc", "dd"] [] ["[aa,bbb]", "[cc,dd]"]
|
||||
runBatcherTest 8 ["aa", "bbb", "cc", "dd", "eee", "fff", "gg", "hh"] [] ["aa", "[bbb,cc]", "[dd,eee]", "fff", "[gg,hh]"]
|
||||
runBatcherTest 8 ["9aaaaaaaa"] ["9aaaaaaaa"] []
|
||||
runBatcherTest 8 ["aaaaa", "bbb", "cc"] [] ["aaaaa", "[bbb,cc]"]
|
||||
runBatcherTest 8 ["8aaaaaaa", "bbb", "cc"] [] ["8aaaaaaa", "[bbb,cc]"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "bbb", "cc"] ["9aaaaaaaa"] ["[bbb,cc]"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "bbb", "cc", "dd"] ["9aaaaaaaa"] ["bbb", "[cc,dd]"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "bbb", "cc", "dd", "e"] ["9aaaaaaaa"] ["[bbb,cc]", "[dd,e]"]
|
||||
runBatcherTest 8 ["bbb", "cc", "aaaaa"] [] ["[bbb,cc]", "aaaaa"]
|
||||
runBatcherTest 8 ["bbb", "cc", "8aaaaaaa"] [] ["[bbb,cc]", "8aaaaaaa"]
|
||||
runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa"] ["9aaaaaaaa"] ["[bbb,cc]"]
|
||||
runBatcherTest 8 ["bbb", "cc", "dd", "9aaaaaaaa"] ["9aaaaaaaa"] ["bbb", "[cc,dd]"]
|
||||
runBatcherTest 8 ["bbb", "cc", "dd", "e", "9aaaaaaaa"] ["9aaaaaaaa"] ["[bbb,cc]", "[dd,e]"]
|
||||
runBatcherTest 8 ["bbb", "cc", "aaaaa", "dd"] [] ["[bbb,cc]", "aaaaa", "dd"]
|
||||
runBatcherTest 8 ["bbb", "cc", "aaaaa", "dd", "e"] [] ["[bbb,cc]", "aaaaa", "[dd,e]"]
|
||||
runBatcherTest 8 ["bbb", "cc", "8aaaaaaa", "dd"] [] ["[bbb,cc]", "8aaaaaaa", "dd"]
|
||||
runBatcherTest 8 ["bbb", "cc", "8aaaaaaa", "dd", "e"] [] ["[bbb,cc]", "8aaaaaaa", "[dd,e]"]
|
||||
runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa"] ["9aaaaaaaa"] ["[bbb,cc]"]
|
||||
runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa", "dd"] ["9aaaaaaaa"] ["[bbb,cc]", "dd"]
|
||||
runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa", "dd", "e"] ["9aaaaaaaa"] ["[bbb,cc]", "[dd,e]"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] []
|
||||
runBatcherTest 8 ["8aaaaaaa", "9aaaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["8aaaaaaa"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "8aaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["8aaaaaaa"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "10aaaaaaaa", "8aaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["8aaaaaaa"]
|
||||
runBatcherTest 8 ["bb", "cc", "dd", "9aaaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
|
||||
runBatcherTest 8 ["bb", "cc", "9aaaaaaaa", "dd", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["[bb,cc]", "dd"]
|
||||
runBatcherTest 8 ["bb", "9aaaaaaaa", "cc", "dd", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
|
||||
runBatcherTest 8 ["bb", "9aaaaaaaa", "cc", "10aaaaaaaa", "dd"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "cc", "dd"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "bb", "cc", "dd", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "bb", "10aaaaaaaa", "cc", "dd"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
|
||||
runBatcherTest 8 ["9aaaaaaaa", "10aaaaaaaa", "bb", "cc", "dd"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
|
||||
|
||||
testImageFitsSingleBatch :: IO ()
|
||||
testImageFitsSingleBatch = do
|
||||
-- 14000 (limit for encoded image used in UI)
|
||||
-- + 300 (remaining x.msg.new metadata, rounded up, actual example was 266)
|
||||
let xMsgNewRoundedSize = 14300
|
||||
-- size of x.msg.file.descr body for a file of size
|
||||
-- 261_120 bytes (MAX_IMAGE_SIZE in UI), rounded up, example was 743
|
||||
let descrRoundedSize = 800
|
||||
|
||||
let xMsgNewStr = LB.replicate xMsgNewRoundedSize 1
|
||||
descrStr = LB.replicate descrRoundedSize 2
|
||||
msg s = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = s}
|
||||
batched = "[" <> xMsgNewStr <> "," <> descrStr <> "]"
|
||||
|
||||
runBatcherTest' maxChatMsgSize [msg xMsgNewStr, msg descrStr] [] [batched]
|
||||
|
||||
runBatcherTest :: Int64 -> [SndMessage] -> [ChatError] -> [LB.ByteString] -> Spec
|
||||
runBatcherTest maxLen msgs expectedErrors expectedBatches =
|
||||
it
|
||||
( (show (map (\SndMessage {msgBody} -> msgBody) msgs) <> ", limit " <> show maxLen <> ": should return ")
|
||||
<> (show (length expectedErrors) <> " large, ")
|
||||
<> (show (length expectedBatches) <> " batches")
|
||||
)
|
||||
(runBatcherTest' maxLen msgs expectedErrors expectedBatches)
|
||||
|
||||
runBatcherTest' :: Int64 -> [SndMessage] -> [ChatError] -> [LB.ByteString] -> IO ()
|
||||
runBatcherTest' maxLen msgs expectedErrors expectedBatches = do
|
||||
let (errors, batches) = partitionEithers $ batchMessages maxLen msgs
|
||||
batchedStrs = map (\(MsgBatch builder _) -> toLazyByteString builder) batches
|
||||
testErrors errors `shouldBe` testErrors expectedErrors
|
||||
batchedStrs `shouldBe` expectedBatches
|
||||
where
|
||||
testErrors = map (\case ChatError (CEInternalError s) -> Just s; _ -> Nothing)
|
@ -7,6 +7,7 @@ module ProtocolTests where
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
@ -14,8 +15,6 @@ import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.Ratchet
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (parseAll)
|
||||
import Simplex.Messaging.Protocol (supportedSMPClientVRange)
|
||||
import Simplex.Messaging.Version
|
||||
import Test.Hspec
|
||||
@ -62,13 +61,22 @@ quotedMsg =
|
||||
|
||||
(==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
|
||||
s ==## msg = do
|
||||
strDecode s `shouldBe` Right msg
|
||||
parseAll strP s `shouldBe` Right msg
|
||||
case parseChatMessages s of
|
||||
[acMsg] -> case acMsg of
|
||||
Right (ACMsg _ msg') -> case checkEncoding msg' of
|
||||
Right msg'' -> msg'' `shouldBe` msg
|
||||
Left e -> expectationFailure $ "checkEncoding error: " <> show e
|
||||
Left e -> expectationFailure $ "parse error: " <> show e
|
||||
_ -> expectationFailure "exactly one message expected"
|
||||
|
||||
(##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
|
||||
s ##== msg =
|
||||
J.eitherDecodeStrict' (strEncode msg)
|
||||
`shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
|
||||
s ##== msg = do
|
||||
let r = encodeChatMessage msg
|
||||
case r of
|
||||
ECMEncoded encodedBody ->
|
||||
J.eitherDecodeStrict' (LB.toStrict encodedBody)
|
||||
`shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
|
||||
ECMLarge -> expectationFailure $ "large message"
|
||||
|
||||
(##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
|
||||
s ##==## msg = do
|
||||
@ -90,7 +98,7 @@ testChatPreferences :: Maybe Preferences
|
||||
testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}}
|
||||
|
||||
testGroupPreferences :: Maybe GroupPreferences
|
||||
testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, files = Nothing, fullDelete = Nothing}
|
||||
testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, files = Nothing, fullDelete = Nothing, history = Nothing}
|
||||
|
||||
testProfile :: Profile
|
||||
testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), contactLink = Nothing, preferences = testChatPreferences}
|
||||
@ -122,7 +130,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
it "x.msg.new chat message with chat version range" $
|
||||
"{\"v\":\"1-4\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
"{\"v\":\"1-5\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
it "x.msg.new quote" $
|
||||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}"
|
||||
@ -232,13 +240,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
|
||||
it "x.grp.mem.new with member chat version range" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-5\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
|
||||
it "x.grp.mem.intro" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
|
||||
it "x.grp.mem.intro with member chat version range" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-5\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
|
||||
it "x.grp.mem.inv" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
|
||||
@ -250,7 +258,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq}
|
||||
it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-5\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing}
|
||||
it "x.grp.mem.info" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"
|
||||
|
@ -73,7 +73,9 @@ skipComparisonForDownMigrations =
|
||||
-- table and index definitions move down the file, so fields are re-created as not unique
|
||||
"20230914_member_probes",
|
||||
-- on down migration idx_connections_via_contact_uri_hash index moves down to the end of the file
|
||||
"20231019_indexes"
|
||||
"20231019_indexes",
|
||||
-- table and indexes move down to the end of the file
|
||||
"20231215_recreate_msg_deliveries"
|
||||
]
|
||||
|
||||
getSchema :: FilePath -> FilePath -> IO String
|
||||
|
@ -7,6 +7,7 @@ import Control.Logger.Simple
|
||||
import Data.Time.Clock.System
|
||||
import JSONTests
|
||||
import MarkdownTests
|
||||
import MessageBatching
|
||||
import MobileTests
|
||||
import ProtocolTests
|
||||
import RemoteTests
|
||||
@ -28,6 +29,7 @@ main = do
|
||||
describe "SimpleX chat protocol" protocolTests
|
||||
around tmpBracket $ describe "WebRTC encryption" webRTCTests
|
||||
describe "Valid names" validNameTests
|
||||
describe "Message batching" batchingTests
|
||||
around testBracket $ do
|
||||
describe "Mobile API Tests" mobileTests
|
||||
describe "SimpleX chat client" chatTests
|
||||
|
Loading…
Reference in New Issue
Block a user