From 3ddf7b26808dc5f5825e228f24fe819c29424383 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 9 Oct 2023 18:03:03 +0100 Subject: [PATCH 1/4] ios: close database connections when app is terminating (#3188) * ios: close database connections when app is terminating * update * remove () * close when suspended too * additional check * fix * refactore * reset "terminating" flag --- apps/ios/Shared/Model/SuspendChat.swift | 28 ++++++++++++++++++++----- apps/ios/SimpleXChat/API.swift | 7 +++++++ apps/ios/SimpleXChat/AppGroup.swift | 8 +++++++ apps/ios/SimpleXChat/SimpleX.h | 1 + 4 files changed, 39 insertions(+), 5 deletions(-) diff --git a/apps/ios/Shared/Model/SuspendChat.swift b/apps/ios/Shared/Model/SuspendChat.swift index 58ed46a05a..1c8c32f8b9 100644 --- a/apps/ios/Shared/Model/SuspendChat.swift +++ b/apps/ios/Shared/Model/SuspendChat.swift @@ -19,7 +19,11 @@ let bgSuspendTimeout: Int = 5 // seconds let terminationTimeout: Int = 3 // seconds private func _suspendChat(timeout: Int) { - if ChatModel.ok { + // this is a redundant check to prevent logical errors, like the one fixed in this PR + let state = appStateGroupDefault.get() + if !state.canSuspend { + logger.error("_suspendChat called, current state: \(state.rawValue, privacy: .public)") + } else if ChatModel.ok { appStateGroupDefault.set(.suspending) apiSuspendChat(timeoutMicroseconds: timeout * 1000000) let endTask = beginBGTask(chatSuspended) @@ -31,9 +35,7 @@ private func _suspendChat(timeout: Int) { func suspendChat() { suspendLockQueue.sync { - if appStateGroupDefault.get() != .stopped { - _suspendChat(timeout: appSuspendTimeout) - } + _suspendChat(timeout: appSuspendTimeout) } } @@ -45,15 +47,25 @@ func suspendBgRefresh() { } } +private var terminating = false + func terminateChat() { + logger.debug("terminateChat") suspendLockQueue.sync { switch appStateGroupDefault.get() { case .suspending: // suspend instantly if already suspending _chatSuspended() + // when apiSuspendChat is called with timeout 0, it won't send any events on suspension if ChatModel.ok { apiSuspendChat(timeoutMicroseconds: 0) } - case .stopped: () + chatCloseStore() + case .suspended: + chatCloseStore() + case .stopped: + chatCloseStore() default: + terminating = true + // the store will be closed in _chatSuspended when event is received _suspendChat(timeout: terminationTimeout) } } @@ -73,10 +85,14 @@ private func _chatSuspended() { if ChatModel.shared.chatRunning == true { ChatReceiver.shared.stop() } + if terminating { + chatCloseStore() + } } func activateChat(appState: AppState = .active) { logger.debug("DEBUGGING: activateChat") + terminating = false suspendLockQueue.sync { appStateGroupDefault.set(appState) if ChatModel.ok { apiActivateChat() } @@ -85,6 +101,7 @@ func activateChat(appState: AppState = .active) { } func initChatAndMigrate(refreshInvitations: Bool = true) { + terminating = false let m = ChatModel.shared if (!m.chatInitialized) { do { @@ -97,6 +114,7 @@ func initChatAndMigrate(refreshInvitations: Bool = true) { } func startChatAndActivate() { + terminating = false logger.debug("DEBUGGING: startChatAndActivate") if ChatModel.shared.chatRunning == true { ChatReceiver.shared.start() diff --git a/apps/ios/SimpleXChat/API.swift b/apps/ios/SimpleXChat/API.swift index e3d202c124..fbf9d3b2ca 100644 --- a/apps/ios/SimpleXChat/API.swift +++ b/apps/ios/SimpleXChat/API.swift @@ -50,6 +50,13 @@ public func chatMigrateInit(_ useKey: String? = nil, confirmMigrations: Migratio return result } +public func chatCloseStore() { + let err = fromCString(chat_close_store(getChatCtrl())) + if err != "" { + logger.error("chatCloseStore error: \(err)") + } +} + public func resetChatCtrl() { chatController = nil migrationResult = nil diff --git a/apps/ios/SimpleXChat/AppGroup.swift b/apps/ios/SimpleXChat/AppGroup.swift index e09b957171..4943dbd4ea 100644 --- a/apps/ios/SimpleXChat/AppGroup.swift +++ b/apps/ios/SimpleXChat/AppGroup.swift @@ -80,6 +80,14 @@ public enum AppState: String { default: return false } } + + public var canSuspend: Bool { + switch self { + case .active: true + case .bgRefresh: true + default: false + } + } } public enum DBContainer: String { diff --git a/apps/ios/SimpleXChat/SimpleX.h b/apps/ios/SimpleXChat/SimpleX.h index 67c2fa728c..644569c1ba 100644 --- a/apps/ios/SimpleXChat/SimpleX.h +++ b/apps/ios/SimpleXChat/SimpleX.h @@ -17,6 +17,7 @@ typedef void* chat_ctrl; // the last parameter is used to return the pointer to chat controller extern char *chat_migrate_init(char *path, char *key, char *confirm, chat_ctrl *ctrl); +extern char *chat_close_store(chat_ctrl ctl); extern char *chat_send_cmd(chat_ctrl ctl, char *cmd); extern char *chat_recv_msg(chat_ctrl ctl); extern char *chat_recv_msg_wait(chat_ctrl ctl, int wait); From 86c2f29920146f60ebf3d833f9ed175e5369cf60 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 9 Oct 2023 18:30:59 +0100 Subject: [PATCH 2/4] 5.3.2: ios 178, android 157, desktop 14 --- apps/ios/SimpleX.xcodeproj/project.pbxproj | 64 +++++++++++----------- apps/multiplatform/gradle.properties | 8 +-- 2 files changed, 36 insertions(+), 36 deletions(-) diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj index 20ba15e925..1cbe61dea0 100644 --- a/apps/ios/SimpleX.xcodeproj/project.pbxproj +++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj @@ -48,11 +48,6 @@ 5C55A921283CCCB700C4E99E /* IncomingCallView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C55A920283CCCB700C4E99E /* IncomingCallView.swift */; }; 5C55A923283CEDE600C4E99E /* SoundPlayer.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C55A922283CEDE600C4E99E /* SoundPlayer.swift */; }; 5C55A92E283D0FDE00C4E99E /* sounds in Resources */ = {isa = PBXBuildFile; fileRef = 5C55A92D283D0FDE00C4E99E /* sounds */; }; - 5C56251A2AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7-ghc8.10.7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C5625152AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7-ghc8.10.7.a */; }; - 5C56251B2AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C5625162AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7.a */; }; - 5C56251C2AC1DE5900A21210 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C5625172AC1DE5900A21210 /* libgmpxx.a */; }; - 5C56251D2AC1DE5900A21210 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C5625182AC1DE5900A21210 /* libgmp.a */; }; - 5C56251E2AC1DE5900A21210 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C5625192AC1DE5900A21210 /* libffi.a */; }; 5C577F7D27C83AA10006112D /* MarkdownHelp.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C577F7C27C83AA10006112D /* MarkdownHelp.swift */; }; 5C58BCD6292BEBE600AF9E4F /* CIChatFeatureView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C58BCD5292BEBE600AF9E4F /* CIChatFeatureView.swift */; }; 5C5DB70E289ABDD200730FFF /* AppearanceSettings.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C5DB70D289ABDD200730FFF /* AppearanceSettings.swift */; }; @@ -119,6 +114,11 @@ 5CC1C99527A6CF7F000D9FF6 /* ShareSheet.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CC1C99427A6CF7F000D9FF6 /* ShareSheet.swift */; }; 5CC2C0FC2809BF11000C35E3 /* Localizable.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CC2C0FA2809BF11000C35E3 /* Localizable.strings */; }; 5CC2C0FF2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CC2C0FD2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings */; }; + 5CC739A12AD468E4009470A9 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC7399C2AD468E4009470A9 /* libgmpxx.a */; }; + 5CC739A22AD468E4009470A9 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC7399D2AD468E4009470A9 /* libffi.a */; }; + 5CC739A32AD468E4009470A9 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC7399E2AD468E4009470A9 /* libgmp.a */; }; + 5CC739A42AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI-ghc8.10.7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC7399F2AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI-ghc8.10.7.a */; }; + 5CC739A52AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739A02AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI.a */; }; 5CC868F329EB540C0017BBFD /* CIRcvDecryptionError.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */; }; 5CCB939C297EFCB100399E78 /* NavStackCompat.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCB939B297EFCB100399E78 /* NavStackCompat.swift */; }; 5CCD403427A5F6DF00368C90 /* AddContactView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCD403327A5F6DF00368C90 /* AddContactView.swift */; }; @@ -293,11 +293,6 @@ 5C55A920283CCCB700C4E99E /* IncomingCallView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = IncomingCallView.swift; sourceTree = ""; }; 5C55A922283CEDE600C4E99E /* SoundPlayer.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SoundPlayer.swift; sourceTree = ""; }; 5C55A92D283D0FDE00C4E99E /* sounds */ = {isa = PBXFileReference; lastKnownFileType = folder; path = sounds; sourceTree = ""; }; - 5C5625152AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7-ghc8.10.7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7-ghc8.10.7.a"; sourceTree = ""; }; - 5C5625162AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7.a"; sourceTree = ""; }; - 5C5625172AC1DE5900A21210 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = ""; }; - 5C5625182AC1DE5900A21210 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; - 5C5625192AC1DE5900A21210 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; 5C577F7C27C83AA10006112D /* MarkdownHelp.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MarkdownHelp.swift; sourceTree = ""; }; 5C58BCD5292BEBE600AF9E4F /* CIChatFeatureView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIChatFeatureView.swift; sourceTree = ""; }; 5C5B67912ABAF4B500DA9412 /* bg */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = bg; path = bg.lproj/Localizable.strings; sourceTree = ""; }; @@ -400,6 +395,11 @@ 5CC1C99427A6CF7F000D9FF6 /* ShareSheet.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ShareSheet.swift; sourceTree = ""; }; 5CC2C0FB2809BF11000C35E3 /* ru */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ru; path = ru.lproj/Localizable.strings; sourceTree = ""; }; 5CC2C0FE2809BF11000C35E3 /* ru */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ru; path = "ru.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = ""; }; + 5CC7399C2AD468E4009470A9 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = ""; }; + 5CC7399D2AD468E4009470A9 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; + 5CC7399E2AD468E4009470A9 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; + 5CC7399F2AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI-ghc8.10.7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI-ghc8.10.7.a"; sourceTree = ""; }; + 5CC739A02AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI.a"; sourceTree = ""; }; 5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIRcvDecryptionError.swift; sourceTree = ""; }; 5CCB939B297EFCB100399E78 /* NavStackCompat.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NavStackCompat.swift; sourceTree = ""; }; 5CCD403327A5F6DF00368C90 /* AddContactView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = AddContactView.swift; sourceTree = ""; }; @@ -507,13 +507,13 @@ isa = PBXFrameworksBuildPhase; buildActionMask = 2147483647; files = ( + 5CC739A12AD468E4009470A9 /* libgmpxx.a in Frameworks */, + 5CC739A32AD468E4009470A9 /* libgmp.a in Frameworks */, 5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */, - 5C56251C2AC1DE5900A21210 /* libgmpxx.a in Frameworks */, - 5C56251B2AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7.a in Frameworks */, - 5C56251A2AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7-ghc8.10.7.a in Frameworks */, - 5C56251E2AC1DE5900A21210 /* libffi.a in Frameworks */, - 5C56251D2AC1DE5900A21210 /* libgmp.a in Frameworks */, 5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */, + 5CC739A42AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI-ghc8.10.7.a in Frameworks */, + 5CC739A22AD468E4009470A9 /* libffi.a in Frameworks */, + 5CC739A52AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI.a in Frameworks */, ); runOnlyForDeploymentPostprocessing = 0; }; @@ -574,11 +574,11 @@ 5C764E5C279C70B7000C6508 /* Libraries */ = { isa = PBXGroup; children = ( - 5C5625192AC1DE5900A21210 /* libffi.a */, - 5C5625182AC1DE5900A21210 /* libgmp.a */, - 5C5625172AC1DE5900A21210 /* libgmpxx.a */, - 5C5625152AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7-ghc8.10.7.a */, - 5C5625162AC1DE5900A21210 /* libHSsimplex-chat-5.3.1.0-625aldG8rLm27VEosiv5y7.a */, + 5CC7399D2AD468E4009470A9 /* libffi.a */, + 5CC7399E2AD468E4009470A9 /* libgmp.a */, + 5CC7399C2AD468E4009470A9 /* libgmpxx.a */, + 5CC7399F2AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI-ghc8.10.7.a */, + 5CC739A02AD468E4009470A9 /* libHSsimplex-chat-5.3.2.0-CqvLUli0CbhHnscdGdNqYI.a */, ); path = Libraries; sourceTree = ""; @@ -1486,7 +1486,7 @@ CLANG_ENABLE_MODULES = YES; CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 174; + CURRENT_PROJECT_VERSION = 178; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; ENABLE_PREVIEWS = YES; @@ -1507,7 +1507,7 @@ "$(inherited)", "@executable_path/Frameworks", ); - MARKETING_VERSION = 5.3.1; + MARKETING_VERSION = 5.3.2; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.app; PRODUCT_NAME = SimpleX; SDKROOT = iphoneos; @@ -1528,7 +1528,7 @@ CLANG_ENABLE_MODULES = YES; CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 174; + CURRENT_PROJECT_VERSION = 178; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; ENABLE_PREVIEWS = YES; @@ -1549,7 +1549,7 @@ "$(inherited)", "@executable_path/Frameworks", ); - MARKETING_VERSION = 5.3.1; + MARKETING_VERSION = 5.3.2; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.app; PRODUCT_NAME = SimpleX; SDKROOT = iphoneos; @@ -1608,7 +1608,7 @@ CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements"; CODE_SIGN_IDENTITY = "Apple Development"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 174; + CURRENT_PROJECT_VERSION = 178; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; GENERATE_INFOPLIST_FILE = YES; @@ -1621,7 +1621,7 @@ "@executable_path/Frameworks", "@executable_path/../../Frameworks", ); - MARKETING_VERSION = 5.3.1; + MARKETING_VERSION = 5.3.2; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-NSE"; PRODUCT_NAME = "$(TARGET_NAME)"; PROVISIONING_PROFILE_SPECIFIER = ""; @@ -1640,7 +1640,7 @@ CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements"; CODE_SIGN_IDENTITY = "Apple Development"; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 174; + CURRENT_PROJECT_VERSION = 178; DEVELOPMENT_TEAM = 5NN7GUYB6T; ENABLE_BITCODE = NO; GENERATE_INFOPLIST_FILE = YES; @@ -1653,7 +1653,7 @@ "@executable_path/Frameworks", "@executable_path/../../Frameworks", ); - MARKETING_VERSION = 5.3.1; + MARKETING_VERSION = 5.3.2; PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-NSE"; PRODUCT_NAME = "$(TARGET_NAME)"; PROVISIONING_PROFILE_SPECIFIER = ""; @@ -1672,7 +1672,7 @@ APPLICATION_EXTENSION_API_ONLY = YES; CLANG_ENABLE_MODULES = YES; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 174; + CURRENT_PROJECT_VERSION = 178; DEFINES_MODULE = YES; DEVELOPMENT_TEAM = 5NN7GUYB6T; DYLIB_COMPATIBILITY_VERSION = 1; @@ -1696,7 +1696,7 @@ "$(inherited)", "$(PROJECT_DIR)/Libraries/sim", ); - MARKETING_VERSION = 5.3.1; + MARKETING_VERSION = 5.3.2; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleXChat; PRODUCT_NAME = "$(TARGET_NAME:c99extidentifier)"; SDKROOT = iphoneos; @@ -1718,7 +1718,7 @@ APPLICATION_EXTENSION_API_ONLY = YES; CLANG_ENABLE_MODULES = YES; CODE_SIGN_STYLE = Automatic; - CURRENT_PROJECT_VERSION = 174; + CURRENT_PROJECT_VERSION = 178; DEFINES_MODULE = YES; DEVELOPMENT_TEAM = 5NN7GUYB6T; DYLIB_COMPATIBILITY_VERSION = 1; @@ -1742,7 +1742,7 @@ "$(inherited)", "$(PROJECT_DIR)/Libraries/sim", ); - MARKETING_VERSION = 5.3.1; + MARKETING_VERSION = 5.3.2; PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleXChat; PRODUCT_NAME = "$(TARGET_NAME:c99extidentifier)"; SDKROOT = iphoneos; diff --git a/apps/multiplatform/gradle.properties b/apps/multiplatform/gradle.properties index 0d047a7917..cd5a098f73 100644 --- a/apps/multiplatform/gradle.properties +++ b/apps/multiplatform/gradle.properties @@ -25,11 +25,11 @@ android.nonTransitiveRClass=true android.enableJetifier=true kotlin.mpp.androidSourceSetLayoutVersion=2 -android.version_name=5.3.1 -android.version_code=154 +android.version_name=5.3.2 +android.version_code=157 -desktop.version_name=5.3.1 -desktop.version_code=11 +desktop.version_name=5.3.2 +desktop.version_code=14 kotlin.version=1.8.20 gradle.plugin.version=7.4.2 From a67b79952b467bb543ace2122feb46230ccbedcd Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 10 Oct 2023 21:19:04 +0400 Subject: [PATCH 3/4] core: connection plan api; check connection plan before connecting in terminal api (#3176) --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 112 +++++++-- src/Simplex/Chat/Controller.hs | 61 +++++ .../M20231009_via_group_link_uri_hash.hs | 24 ++ src/Simplex/Chat/Migrations/chat_schema.sql | 7 +- src/Simplex/Chat/Store/Connections.hs | 9 +- src/Simplex/Chat/Store/Direct.hs | 48 ++-- src/Simplex/Chat/Store/Groups.hs | 43 ++++ src/Simplex/Chat/Store/Migrations.hs | 4 +- src/Simplex/Chat/Store/Profiles.hs | 15 +- src/Simplex/Chat/Types.hs | 6 + src/Simplex/Chat/View.hs | 37 +++ tests/ChatTests/Direct.hs | 67 +++++ tests/ChatTests/Groups.hs | 237 ++++++++++++++++++ tests/ChatTests/Profiles.hs | 165 +++++++++++- 15 files changed, 784 insertions(+), 52 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20231009_via_group_link_uri_hash.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 4148f0ba83..5a84a1cde8 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -115,6 +115,7 @@ library Simplex.Chat.Migrations.M20230914_member_probes Simplex.Chat.Migrations.M20230926_contact_status Simplex.Chat.Migrations.M20231002_conn_initiated + Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 296abf0e2b..6f43f5c0f8 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -902,7 +902,7 @@ processChatCommand = \case filesInfo <- withStore' $ \db -> getContactFileInfo db user ct withChatLock "deleteChat direct" . procCmd $ do deleteFilesAndConns user filesInfo - when (isReady ct && contactActive ct && notify) $ + when (contactReady ct && contactActive ct && notify) $ void (sendDirectContactMessage ct XDirectDel) `catchChatError` const (pure ()) contactConnIds <- map aConnId <$> withStore (\db -> getContactConnections db userId ct) deleteAgentConnectionsAsync user contactConnIds @@ -1311,6 +1311,8 @@ processChatCommand = \case case conn'_ of Just conn' -> pure $ CRConnectionIncognitoUpdated user conn' Nothing -> throwChatError CEConnectionIncognitoChangeProhibited + APIConnectPlan userId cReqUri -> withUserId userId $ \user -> withChatLock "connectPlan" . procCmd $ + CRConnectionPlan user <$> connectPlan user cReqUri APIConnect userId incognito (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do subMode <- chatReadVar subscriptionMode -- [incognito] generate profile to send @@ -1323,11 +1325,16 @@ processChatCommand = \case pure $ CRSentConfirmation user APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq - Connect incognito cReqUri -> withUser $ \User {userId} -> - processChatCommand $ APIConnect userId incognito cReqUri - ConnectSimplex incognito -> withUser $ \user -> - -- [incognito] generate profile to send - connectViaContact user incognito adminContactReq + Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do + plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk) + unless (connectionPlanOk plan) $ throwChatError (CEConnectionPlan plan) + processChatCommand $ APIConnect userId incognito aCReqUri + Connect _ Nothing -> throwChatError CEInvalidConnReq + ConnectSimplex incognito -> withUser $ \user@User {userId} -> do + let cReqUri = ACR SCMContact adminContactReq + plan <- connectPlan user cReqUri `catchChatError` const (pure $ CPInvitationLink ILPOk) + unless (connectionPlanOk plan) $ throwChatError (CEConnectionPlan plan) + processChatCommand $ APIConnect userId incognito (Just cReqUri) DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect APIListContacts userId -> withUserId userId $ \user -> @@ -1423,7 +1430,7 @@ processChatCommand = \case processChatCommand . APISendMessage chatRef True Nothing $ ComposedMessage Nothing Nothing mc SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withStore' (`getUserContacts` user) - let cts = filter (\ct -> isReady ct && contactActive ct && directOrUsed ct) contacts + let cts = filter (\ct -> contactReady ct && contactActive ct && directOrUsed ct) contacts ChatConfig {logLevel} <- asks config withChatLock "sendMessageBroadcast" . procCmd $ do (successes, failures) <- foldM (sendAndCount user logLevel) (0, 0) cts @@ -1924,19 +1931,36 @@ processChatCommand = \case _ -> throwChatError $ CECommandError "not supported" connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> m ChatResponse connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do - let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq - withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case - (Just contact, _) -> pure $ CRContactAlreadyExists user contact - (_, xContactId_) -> procCmd $ do - let randomXContactId = XContactId <$> drgRandomBytes 16 - xContactId <- maybe randomXContactId pure xContactId_ - subMode <- chatReadVar subscriptionMode + let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli + cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq + case groupLinkId of + -- contact address + Nothing -> + withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case + (Just contact, _) -> pure $ CRContactAlreadyExists user contact + (_, xContactId_) -> procCmd $ do + let randomXContactId = XContactId <$> drgRandomBytes 16 + xContactId <- maybe randomXContactId pure xContactId_ + connect' Nothing cReqHash xContactId + -- group link + Just gLinkId -> + withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case + (Just _contact, _) -> procCmd $ do + -- allow repeat contact request + newXContactId <- XContactId <$> drgRandomBytes 16 + connect' (Just gLinkId) cReqHash newXContactId + (_, xContactId_) -> procCmd $ do + let randomXContactId = XContactId <$> drgRandomBytes 16 + xContactId <- maybe randomXContactId pure xContactId_ + connect' (Just gLinkId) cReqHash xContactId + where + connect' groupLinkId cReqHash xContactId = do -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing dm <- directMessage (XContact profileToSend $ Just xContactId) + subMode <- chatReadVar subscriptionMode connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode - let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode toView $ CRNewContactConnection user conn pure $ CRSentInvitation user incognitoProfile @@ -1975,7 +1999,7 @@ processChatCommand = \case -- read contacts before user update to correctly merge preferences -- [incognito] filter out contacts with whom user has incognito connections contacts <- - filter (\ct -> isReady ct && contactActive ct && not (contactConnIncognito ct)) + filter (\ct -> contactReady ct && contactActive ct && not (contactConnIncognito ct)) <$> withStore' (`getUserContacts` user) user' <- updateUser asks currentUser >>= atomically . (`writeTVar` Just user') @@ -2046,10 +2070,6 @@ processChatCommand = \case g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db -> getGroupIdByName db user gName >>= getGroup db user runUpdateGroupProfile user g $ update p - isReady :: Contact -> Bool - isReady ct = - let s = connStatus $ ct.activeConn - in s == ConnReady || s == ConnSndReady withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse withCurrentCall ctId action = do (user, ct) <- withStore $ \db -> do @@ -2168,6 +2188,54 @@ processChatCommand = \case pure (gId, chatSettings) _ -> throwChatError $ CECommandError "not supported" processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings + connectPlan :: User -> AConnectionRequestUri -> m ConnectionPlan + connectPlan user (ACR SCMInvitation cReq) = do + withStore' (\db -> getConnectionEntityByConnReq db user cReq) >>= \case + Nothing -> pure $ CPInvitationLink ILPOk + Just (RcvDirectMsgConnection conn ct_) -> do + let Connection {connStatus, contactConnInitiated} = conn + if + | connStatus == ConnNew && contactConnInitiated -> + pure $ CPInvitationLink ILPOwnLink + | not (connReady conn) -> + pure $ CPInvitationLink (ILPConnecting ct_) + | otherwise -> case ct_ of + Just ct -> pure $ CPInvitationLink (ILPKnown ct) + Nothing -> throwChatError $ CEInternalError "ready RcvDirectMsgConnection connection should have associated contact" + Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" + connectPlan user (ACR SCMContact cReq) = do + let CRContactUri ConnReqUriData {crClientData} = cReq + groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli + case groupLinkId of + -- contact address + Nothing -> + withStore' (`getUserContactLinkByConnReq` cReq) >>= \case + Just _ -> pure $ CPContactAddress CAPOwnLink + Nothing -> do + let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq + withStore' (\db -> getContactByConnReqHash db user cReqHash) >>= \case + Nothing -> pure $ CPContactAddress CAPOk + Just ct + | not (contactReady ct) && contactActive ct -> pure $ CPContactAddress (CAPConnecting ct) + | otherwise -> pure $ CPContactAddress (CAPKnown ct) + -- group link + Just _ -> + withStore' (\db -> getGroupInfoByUserContactLinkConnReq db user cReq) >>= \case + Just g -> pure $ CPGroupLink (GLPOwnLink g) + Nothing -> do + let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq + ct_ <- withStore' $ \db -> getContactByConnReqHash db user cReqHash + gInfo_ <- withStore' $ \db -> getGroupInfoByGroupLinkHash db user cReqHash + case (gInfo_, ct_) of + (Nothing, Nothing) -> pure $ CPGroupLink GLPOk + (Nothing, Just ct) + | not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnecting gInfo_) + | otherwise -> pure $ CPGroupLink GLPOk + (Just gInfo@GroupInfo {membership}, _) + | not (memberActive membership) && not (memberRemoved membership) -> + pure $ CPGroupLink (GLPConnecting gInfo_) + | memberActive membership -> pure $ CPGroupLink (GLPKnown gInfo) + | otherwise -> pure $ CPGroupLink GLPOk assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m () assertDirectAllowed user dir ct event = @@ -4230,7 +4298,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m () processGroupInvitation ct inv msg msgMeta = do - let Contact {localDisplayName = c, activeConn = Connection {peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'}} = ct + let Contact {localDisplayName = c, activeConn = Connection {connId, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'}} = ct GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole), connRequest, groupLinkId} = inv checkIntegrityCreateItem (CDDirectRcv ct) msgMeta when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) @@ -4243,6 +4311,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do dm <- directMessage $ XGrpAcpt memberId connIds <- joinAgentConnectionAsync user True connRequest dm subMode withStore' $ \db -> do + setViaGroupLinkHash db groupId connId createMemberConnectionAsync db user hostId connIds (fromJVersionRange peerChatVRange) subMode updateGroupMemberStatusById db userId hostId GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted @@ -5642,6 +5711,7 @@ chatCommandP = (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP), "/_contacts " *> (APIListContacts <$> A.decimal), "/contacts" $> ListContacts, + "/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> strP), "/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)), "/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP), "/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index d859231faa..3466371da8 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -338,6 +338,7 @@ data ChatCommand | APIAddContact UserId IncognitoEnabled | AddContact IncognitoEnabled | APISetConnectionIncognito Int64 IncognitoEnabled + | APIConnectPlan UserId AConnectionRequestUri | APIConnect UserId IncognitoEnabled (Maybe AConnectionRequestUri) | Connect IncognitoEnabled (Maybe AConnectionRequestUri) | ConnectSimplex IncognitoEnabled -- UserId (not used in UI) @@ -489,6 +490,7 @@ data ChatResponse | CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]} | CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation, connection :: PendingContactConnection} | CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection} + | CRConnectionPlan {user :: User, connectionPlan :: ConnectionPlan} | CRSentConfirmation {user :: User} | CRSentInvitation {user :: User, customUserProfile :: Maybe Profile} | CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact} @@ -624,6 +626,64 @@ instance ToJSON ChatResponse where toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR" toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR" +data ConnectionPlan + = CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan} + | CPContactAddress {contactAddressPlan :: ContactAddressPlan} + | CPGroupLink {groupLinkPlan :: GroupLinkPlan} + deriving (Show, Generic) + +instance ToJSON ConnectionPlan where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CP" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CP" + +data InvitationLinkPlan + = ILPOk + | ILPOwnLink + | ILPConnecting {contact_ :: Maybe Contact} + | ILPKnown {contact :: Contact} + deriving (Show, Generic) + +instance ToJSON InvitationLinkPlan where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "ILP" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "ILP" + +data ContactAddressPlan + = CAPOk + | CAPOwnLink + | CAPConnecting {contact :: Contact} + | CAPKnown {contact :: Contact} + deriving (Show, Generic) + +instance ToJSON ContactAddressPlan where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CAP" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CAP" + +data GroupLinkPlan + = GLPOk + | GLPOwnLink {groupInfo :: GroupInfo} + | GLPConnecting {groupInfo_ :: Maybe GroupInfo} + | GLPKnown {groupInfo :: GroupInfo} + deriving (Show, Generic) + +instance ToJSON GroupLinkPlan where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "GLP" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "GLP" + +connectionPlanOk :: ConnectionPlan -> Bool +connectionPlanOk = \case + CPInvitationLink ilp -> case ilp of + ILPOk -> True + ILPOwnLink -> True + _ -> False + CPContactAddress cap -> case cap of + CAPOk -> True + CAPOwnLink -> True + _ -> False + CPGroupLink glp -> case glp of + GLPOk -> True + GLPOwnLink _ -> True + _ -> False + newtype UserPwd = UserPwd {unUserPwd :: Text} deriving (Eq, Show) @@ -888,6 +948,7 @@ data ChatErrorType | CEChatNotStarted | CEChatNotStopped | CEChatStoreChanged + | CEConnectionPlan {connectionPlan :: ConnectionPlan} | CEInvalidConnReq | CEInvalidChatMessage {connection :: Connection, msgMeta :: Maybe MsgMetaJSON, messageData :: Text, message :: String} | CEContactNotFound {contactName :: ContactName, suspectedMember :: Maybe (GroupInfo, GroupMember)} diff --git a/src/Simplex/Chat/Migrations/M20231009_via_group_link_uri_hash.hs b/src/Simplex/Chat/Migrations/M20231009_via_group_link_uri_hash.hs new file mode 100644 index 0000000000..41c9887a04 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20231009_via_group_link_uri_hash.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20231009_via_group_link_uri_hash :: Query +m20231009_via_group_link_uri_hash = + [sql| +CREATE INDEX idx_connections_conn_req_inv ON connections(conn_req_inv); + +ALTER TABLE groups ADD COLUMN via_group_link_uri_hash BLOB; +CREATE INDEX idx_groups_via_group_link_uri_hash ON groups(via_group_link_uri_hash); +|] + +down_m20231009_via_group_link_uri_hash :: Query +down_m20231009_via_group_link_uri_hash = + [sql| +DROP INDEX idx_groups_via_group_link_uri_hash; +ALTER TABLE groups DROP COLUMN via_group_link_uri_hash; + +DROP INDEX idx_connections_conn_req_inv; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index e88d83e42d..542acbbebd 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -117,7 +117,8 @@ CREATE TABLE groups( unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL), chat_ts TEXT, favorite INTEGER NOT NULL DEFAULT 0, - send_rcpts INTEGER, -- received + send_rcpts INTEGER, + via_group_link_uri_hash BLOB, -- received FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -736,3 +737,7 @@ CREATE INDEX idx_received_probes_probe_hash ON received_probes(probe_hash); CREATE INDEX idx_sent_probes_created_at ON sent_probes(created_at); CREATE INDEX idx_sent_probe_hashes_created_at ON sent_probe_hashes(created_at); CREATE INDEX idx_received_probes_created_at ON received_probes(created_at); +CREATE INDEX idx_connections_conn_req_inv ON connections(conn_req_inv); +CREATE INDEX idx_groups_via_group_link_uri_hash ON groups( + via_group_link_uri_hash +); diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 383db3c59c..c9e846a81f 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -9,6 +9,7 @@ module Simplex.Chat.Store.Connections ( getConnectionEntity, + getConnectionEntityByConnReq, getConnectionsToSubscribe, unsetConnectionToSubscribe, ) @@ -31,7 +32,7 @@ import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol (ConnId) -import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow') +import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Util (eitherToMaybe) @@ -152,6 +153,12 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId} userContact_ _ = Left SEUserContactLinkNotFound +getConnectionEntityByConnReq :: DB.Connection -> User -> ConnReqInvitation -> IO (Maybe ConnectionEntity) +getConnectionEntityByConnReq db user cReq = do + connId_ <- maybeFirstRow fromOnly $ + DB.query db "SELECT agent_conn_id FROM connections WHERE conn_req_inv = ? LIMIT 1" (Only cReq) + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_ + getConnectionsToSubscribe :: DB.Connection -> IO ([ConnId], [ConnectionEntity]) getConnectionsToSubscribe db = do aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1" diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 91243e2319..7227797193 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -25,6 +25,7 @@ module Simplex.Chat.Store.Direct createConnReqConnection, getProfileById, getConnReqContactXContactId, + getContactByConnReqHash, createDirectContact, deleteContactConnectionsAndFiles, deleteContact, @@ -137,32 +138,10 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou getConnReqContactXContactId :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId) getConnReqContactXContactId db user@User {userId} cReqHash = do - getContact' >>= \case + getContactByConnReqHash db user cReqHash >>= \case c@(Just _) -> pure (c, Nothing) Nothing -> (Nothing,) <$> getXContactId where - getContact' :: IO (Maybe Contact) - getContact' = - maybeFirstRow (toContact user) $ - DB.query - db - [sql| - SELECT - -- Contact - ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, - cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, - -- Connection - c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, - c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter, - c.peer_chat_min_version, c.peer_chat_max_version - FROM contacts ct - JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id - JOIN connections c ON c.contact_id = ct.contact_id - WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.deleted = 0 - ORDER BY c.created_at DESC - LIMIT 1 - |] - (userId, cReqHash) getXContactId :: IO (Maybe XContactId) getXContactId = maybeFirstRow fromOnly $ @@ -171,6 +150,29 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do "SELECT xcontact_id FROM connections WHERE user_id = ? AND via_contact_uri_hash = ? LIMIT 1" (userId, cReqHash) +getContactByConnReqHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact) +getContactByConnReqHash db user@User {userId} cReqHash = + maybeFirstRow (toContact user) $ + DB.query + db + [sql| + SELECT + -- Contact + ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite, + cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, + -- Connection + c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, + c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter, + c.peer_chat_min_version, c.peer_chat_max_version + FROM contacts ct + JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id + JOIN connections c ON c.contact_id = ct.contact_id + WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.contact_status = ? AND ct.deleted = 0 + ORDER BY c.created_at DESC + LIMIT 1 + |] + (userId, cReqHash, CSActive) + createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> IO PendingContactConnection createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode = do createdAt <- getCurrentTime diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 236031da94..20fb8c7217 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -31,9 +31,12 @@ module Simplex.Chat.Store.Groups getGroupAndMember, createNewGroup, createGroupInvitation, + setViaGroupLinkHash, setGroupInvitationChatItemId, getGroup, getGroupInfo, + getGroupInfoByUserContactLinkConnReq, + getGroupInfoByGroupLinkHash, updateGroupProfile, getGroupIdByName, getGroupMemberIdByName, @@ -405,6 +408,17 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me ) pure $ Right incognitoLdn +setViaGroupLinkHash :: DB.Connection -> GroupId -> Int64 -> IO () +setViaGroupLinkHash db groupId connId = + DB.execute + db + [sql| + UPDATE groups + SET via_group_link_uri_hash = (SELECT via_contact_uri_hash FROM connections WHERE connection_id = ?) + WHERE group_id = ? + |] + (connId, groupId) + setGroupInvitationChatItemId :: DB.Connection -> User -> GroupId -> ChatItemId -> IO () setGroupInvitationChatItemId db User {userId} groupId chatItemId = do currentTs <- getCurrentTime @@ -1102,6 +1116,35 @@ getGroupInfo db User {userId, userContactId} groupId = |] (groupId, userId, userContactId) +getGroupInfoByUserContactLinkConnReq :: DB.Connection -> User -> ConnReqContact -> IO (Maybe GroupInfo) +getGroupInfoByUserContactLinkConnReq db user cReq = do + groupId_ <- maybeFirstRow fromOnly $ + DB.query + db + [sql| + SELECT group_id + FROM user_contact_links + WHERE conn_req_contact = ? + |] + (Only cReq) + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_ + +getGroupInfoByGroupLinkHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe GroupInfo) +getGroupInfoByGroupLinkHash db user@User {userId, userContactId} groupLinkHash = do + groupId_ <- maybeFirstRow fromOnly $ + DB.query + db + [sql| + SELECT g.group_id + FROM groups g + JOIN group_members mu ON mu.group_id = g.group_id + WHERE g.user_id = ? AND g.via_group_link_uri_hash = ? + AND mu.contact_id = ? AND mu.member_status NOT IN (?,?,?) + LIMIT 1 + |] + (userId, groupLinkHash, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted) + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_ + getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId getGroupIdByName db User {userId} gName = ExceptT . firstRow fromOnly (SEGroupNotFoundByName gName) $ diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 3ef68874b0..5c44b8cded 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -83,6 +83,7 @@ import Simplex.Chat.Migrations.M20230913_member_contacts import Simplex.Chat.Migrations.M20230914_member_probes import Simplex.Chat.Migrations.M20230926_contact_status import Simplex.Chat.Migrations.M20231002_conn_initiated +import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -165,7 +166,8 @@ schemaMigrations = ("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts), ("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes), ("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status), - ("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated) + ("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated), + ("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index a577796810..5b5a6eb671 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -42,6 +42,7 @@ module Simplex.Chat.Store.Profiles deleteUserAddress, getUserAddress, getUserContactLinkById, + getUserContactLinkByConnReq, updateUserAddressAutoAccept, getProtocolServers, overwriteProtocolServers, @@ -86,7 +87,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode) import Simplex.Messaging.Transport.Client (TransportHost) -import Simplex.Messaging.Util (safeDecodeUtf8) +import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8) createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime @@ -440,6 +441,18 @@ getUserContactLinkById db userId userContactLinkId = |] (userId, userContactLinkId) +getUserContactLinkByConnReq :: DB.Connection -> ConnReqContact -> IO (Maybe UserContactLink) +getUserContactLinkByConnReq db cReq = + maybeFirstRow toUserContactLink $ + DB.query + db + [sql| + SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content + FROM user_contact_links + WHERE conn_req_contact = ? + |] + (Only cReq) + updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink updateUserAddressAutoAccept db user@User {userId} autoAccept = do link <- getUserAddress db user diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 529d2bf019..864ebd7227 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -206,6 +206,9 @@ directOrUsed ct@Contact {contactUsed} = anyDirectOrUsed :: Contact -> Bool anyDirectOrUsed Contact {contactUsed, activeConn = Connection {connLevel}} = connLevel == 0 || contactUsed +contactReady :: Contact -> Bool +contactReady Contact {activeConn} = connReady activeConn + contactActive :: Contact -> Bool contactActive Contact {contactStatus} = contactStatus == CSActive @@ -1244,6 +1247,9 @@ data Connection = Connection } deriving (Eq, Show, Generic) +connReady :: Connection -> Bool +connReady Connection {connStatus} = connStatus == ConnReady || connStatus == ConnSndReady + authErrDisableCount :: Int authErrDisableCount = 10 diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index b981929efc..bb5e854cd2 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -148,6 +148,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRVersionInfo info _ _ -> viewVersionInfo logLevel info CRInvitation u cReq _ -> ttyUser u $ viewConnReqInvitation cReq CRConnectionIncognitoUpdated u c -> ttyUser u $ viewConnectionIncognitoUpdated c + CRConnectionPlan u connectionPlan -> ttyUser u $ viewConnectionPlan connectionPlan CRSentConfirmation u -> ttyUser u ["confirmation sent!"] CRSentInvitation u customUserProfile -> ttyUser u $ viewSentInvitation customUserProfile testView CRContactDeleted u c -> ttyUser u [ttyContact' c <> ": contact is deleted"] @@ -1223,6 +1224,41 @@ viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserPr | isJust customUserProfileId = ["connection " <> sShow pccConnId <> " changed to incognito"] | otherwise = ["connection " <> sShow pccConnId <> " changed to non incognito"] +viewConnectionPlan :: ConnectionPlan -> [StyledString] +viewConnectionPlan = \case + CPInvitationLink ilp -> case ilp of + ILPOk -> [invLink "ok to connect"] + ILPOwnLink -> [invLink "own link"] + ILPConnecting Nothing -> [invLink "connecting"] + ILPConnecting (Just ct) -> [invLink ("connecting to contact " <> ttyContact' ct)] + ILPKnown ct -> + [ invLink ("known contact " <> ttyContact' ct), + "use " <> ttyToContact' ct <> highlight' "" <> " to send messages" + ] + where + invLink = ("invitation link: " <>) + CPContactAddress cap -> case cap of + CAPOk -> [ctAddr "ok to connect"] + CAPOwnLink -> [ctAddr "own address"] + CAPConnecting ct -> [ctAddr ("connecting to contact " <> ttyContact' ct)] + CAPKnown ct -> + [ ctAddr ("known contact " <> ttyContact' ct), + "use " <> ttyToContact' ct <> highlight' "" <> " to send messages" + ] + where + ctAddr = ("contact address: " <>) + CPGroupLink glp -> case glp of + GLPOk -> [grpLink "ok to connect"] + GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g] + GLPConnecting Nothing -> [grpLink "connecting"] + GLPConnecting (Just g) -> [grpLink ("connecting to group " <> ttyGroup' g)] + GLPKnown g -> + [ grpLink ("known group " <> ttyGroup' g), + "use " <> ttyToGroup g <> highlight' "" <> " to send messages" + ] + where + grpLink = ("group link: " <>) + viewContactUpdated :: Contact -> Contact -> [StyledString] viewContactUpdated Contact {localDisplayName = n, profile = LocalProfile {fullName, contactLink}} @@ -1565,6 +1601,7 @@ viewChatError logLevel = \case CEChatNotStarted -> ["error: chat not started"] CEChatNotStopped -> ["error: chat not stopped"] CEChatStoreChanged -> ["error: chat store changed, please restart chat"] + CEConnectionPlan connectionPlan -> viewConnectionPlan connectionPlan CEInvalidConnReq -> viewInvalidConnReq CEInvalidChatMessage Connection {connId} msgMeta_ msg e -> [ plain $ diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index a5fc7455c8..47333906bb 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -44,6 +44,10 @@ chatDirectTests = do describe "duplicate contacts" $ do it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate + describe "invitation link connection plan" $ do + it "invitation link ok to connect" testPlanInvitationLinkOk + it "own invitation link" testPlanInvitationLinkOwn + it "connecting via invitation link" testPlanInvitationLinkConnecting describe "SMP servers" $ do it "get and set SMP servers" testGetSetSMPServers it "test SMP server connection" testTestSMPServerConnection @@ -236,6 +240,69 @@ testDuplicateContactsMultipleSeparate = alice `hasContactProfiles` ["alice", "bob", "bob", "bob"] bob `hasContactProfiles` ["bob", "alice", "alice", "alice"] +testPlanInvitationLinkOk :: HasCallStack => FilePath -> IO () +testPlanInvitationLinkOk = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/c" + inv <- getInvitation alice + bob ##> ("/_connect plan 1 " <> inv) + bob <## "invitation link: ok to connect" + + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + concurrently_ + (alice <## "bob (Bob): contact is connected") + (bob <## "alice (Alice): contact is connected") + + bob ##> ("/_connect plan 1 " <> inv) + bob <## "invitation link: ok to connect" -- conn_req_inv is forgotten after connection + + alice <##> bob + +testPlanInvitationLinkOwn :: HasCallStack => FilePath -> IO () +testPlanInvitationLinkOwn tmp = + withNewTestChat tmp "alice" aliceProfile $ \alice -> do + alice ##> "/c" + inv <- getInvitation alice + alice ##> ("/_connect plan 1 " <> inv) + alice <## "invitation link: own link" + + alice ##> ("/c " <> inv) + alice <## "confirmation sent!" + alice + <### [ "alice_1 (Alice): contact is connected", + "alice_2 (Alice): contact is connected" + ] + + alice ##> ("/_connect plan 1 " <> inv) + alice <## "invitation link: ok to connect" -- conn_req_inv is forgotten after connection + + alice @@@ [("@alice_1", lastChatFeature), ("@alice_2", lastChatFeature)] + alice `send` "@alice_2 hi" + alice + <### [ WithTime "@alice_2 hi", + WithTime "alice_1> hi" + ] + alice `send` "@alice_1 hey" + alice + <### [ WithTime "@alice_1 hey", + WithTime "alice_2> hey" + ] + alice @@@ [("@alice_1", "hey"), ("@alice_2", "hey")] + +testPlanInvitationLinkConnecting :: HasCallStack => FilePath -> IO () +testPlanInvitationLinkConnecting tmp = do + inv <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do + alice ##> "/c" + getInvitation alice + withNewTestChat tmp "bob" bobProfile $ \bob -> do + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + + bob ##> ("/_connect plan 1 " <> inv) + bob <## "invitation link: connecting" + testContactClear :: HasCallStack => FilePath -> IO () testContactClear = testChat2 aliceProfile bobProfile $ diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 9fb6ac7f9b..997beec4ea 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -57,6 +57,12 @@ chatGroupTests = do it "leaving groups with unused host contacts deletes incognito profiles" testGroupLinkIncognitoUnusedHostContactsDeleted it "group link member role" testGroupLinkMemberRole it "leaving and deleting the group joined via link should NOT delete previously existing direct contacts" testGroupLinkLeaveDelete + describe "group link connection plan" $ do + it "group link ok to connect; known group" testPlanGroupLinkOkKnown + it "group is known if host contact was deleted" testPlanHostContactDeletedGroupLinkKnown + it "own group link" testPlanGroupLinkOwn + it "connecting via group link" testPlanGroupLinkConnecting + it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin describe "group message errors" $ do it "show message decryption error" testGroupMsgDecryptError it "should report ratchet de-synchronization, synchronize ratchets" testGroupSyncRatchet @@ -2251,6 +2257,237 @@ testGroupLinkLeaveDelete = bob <## "alice (Alice)" bob <## "cath (Catherine)" +testPlanGroupLinkOkKnown :: HasCallStack => FilePath -> IO () +testPlanGroupLinkOkKnown = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + + bob ##> ("/_connect plan 1 " <> gLink) + bob <## "group link: ok to connect" + + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ do + alice <## "bob (Bob): contact is connected" + alice <## "bob invited to group #team via your group link" + alice <## "#team: bob joined the group", + do + bob <## "alice (Alice): contact is connected" + bob <## "#team: you joined the group" + ] + alice #> "#team hi" + bob <# "#team alice> hi" + bob #> "#team hey" + alice <# "#team bob> hey" + + bob ##> ("/_connect plan 1 " <> gLink) + bob <## "group link: known group #team" + bob <## "use #team to send messages" + + bob ##> ("/c " <> gLink) + bob <## "group link: known group #team" + bob <## "use #team to send messages" + +testPlanHostContactDeletedGroupLinkKnown :: HasCallStack => FilePath -> IO () +testPlanHostContactDeletedGroupLinkKnown = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ do + alice <## "bob (Bob): contact is connected" + alice <## "bob invited to group #team via your group link" + alice <## "#team: bob joined the group", + do + bob <## "alice (Alice): contact is connected" + bob <## "#team: you joined the group" + ] + alice #> "#team hi" + bob <# "#team alice> hi" + bob #> "#team hey" + alice <# "#team bob> hey" + + alice <##> bob + threadDelay 500000 + bob ##> "/d alice" + bob <## "alice: contact is deleted" + alice <## "bob (Bob) deleted contact with you" + + bob ##> ("/_connect plan 1 " <> gLink) + bob <## "group link: known group #team" + bob <## "use #team to send messages" + + bob ##> ("/c " <> gLink) + bob <## "group link: known group #team" + bob <## "use #team to send messages" + +testPlanGroupLinkOwn :: HasCallStack => FilePath -> IO () +testPlanGroupLinkOwn tmp = + withNewTestChat tmp "alice" aliceProfile $ \alice -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + + alice ##> ("/_connect plan 1 " <> gLink) + alice <## "group link: own link for group #team" + + alice ##> ("/c " <> gLink) + alice <## "connection request sent!" + alice <## "alice_1 (Alice): accepting request to join group #team..." + alice + <### [ "alice_1 (Alice): contact is connected", + "alice_1 invited to group #team via your group link", + "#team: alice_1 joined the group", + "alice_2 (Alice): contact is connected", + "#team_1: you joined the group", + "contact alice_2 is merged into alice_1", + "use @alice_1 to send messages" + ] + alice `send` "#team 1" + alice + <### [ WithTime "#team 1", + WithTime "#team_1 alice_1> 1" + ] + alice `send` "#team_1 2" + alice + <### [ WithTime "#team_1 2", + WithTime "#team alice_1> 2" + ] + + alice ##> ("/_connect plan 1 " <> gLink) + alice <## "group link: own link for group #team" + + -- group works if merged contact is deleted + alice ##> "/d alice_1" + alice <## "alice_1: contact is deleted" + + alice `send` "#team 3" + alice + <### [ WithTime "#team 3", + WithTime "#team_1 alice_1> 3" + ] + alice `send` "#team_1 4" + alice + <### [ WithTime "#team_1 4", + WithTime "#team alice_1> 4" + ] + +testPlanGroupLinkConnecting :: HasCallStack => FilePath -> IO () +testPlanGroupLinkConnecting tmp = do + gLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + getGroupLink alice "team" GRMember True + withNewTestChat tmp "bob" bobProfile $ \bob -> do + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + withTestChat tmp "alice" $ \alice -> do + alice + <### [ "1 group links active", + "#team: group is empty", + "bob (Bob): accepting request to join group #team..." + ] + withTestChat tmp "bob" $ \bob -> do + threadDelay 500000 + bob ##> ("/_connect plan 1 " <> gLink) + bob <## "group link: connecting" + + bob ##> ("/c " <> gLink) + bob <## "group link: connecting" + +testPlanGroupLinkLeaveRejoin :: HasCallStack => FilePath -> IO () +testPlanGroupLinkLeaveRejoin = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ do + alice <## "bob (Bob): contact is connected" + alice <## "bob invited to group #team via your group link" + alice <## "#team: bob joined the group", + do + bob <## "alice (Alice): contact is connected" + bob <## "#team: you joined the group" + ] + + bob ##> ("/_connect plan 1 " <> gLink) + bob <## "group link: known group #team" + bob <## "use #team to send messages" + + bob ##> ("/c " <> gLink) + bob <## "group link: known group #team" + bob <## "use #team to send messages" + + bob ##> "/leave #team" + concurrentlyN_ + [ do + bob <## "#team: you left the group" + bob <## "use /d #team to delete the group", + alice <## "#team: bob left the group" + ] + + bob ##> ("/_connect plan 1 " <> gLink) + bob <## "group link: ok to connect" + + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob_1 (Bob): accepting request to join group #team..." + concurrentlyN_ + [ alice + <### [ "bob_1 (Bob): contact is connected", + "bob_1 invited to group #team via your group link", + EndsWith "joined the group", + "contact bob_1 is merged into bob", + "use @bob to send messages" + ], + bob + <### [ "alice_1 (Alice): contact is connected", + "#team_1: you joined the group", + "contact alice_1 is merged into alice", + "use @alice to send messages" + ] + ] + + alice #> "#team hi" + bob <# "#team_1 alice> hi" + bob #> "#team_1 hey" + alice <# "#team bob> hey" + + bob ##> ("/_connect plan 1 " <> gLink) + bob <## "group link: known group #team_1" + bob <## "use #team_1 to send messages" + + bob ##> ("/c " <> gLink) + bob <## "group link: known group #team_1" + bob <## "use #team_1 to send messages" + testGroupMsgDecryptError :: HasCallStack => FilePath -> IO () testGroupMsgDecryptError tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index da6cbd156f..0d7683c4d7 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -28,6 +28,11 @@ chatProfileTests = do it "delete connection requests when contact link deleted" testDeleteConnectionRequests it "auto-reply message" testAutoReplyMessage it "auto-reply message in incognito" testAutoReplyMessageInIncognito + describe "contact address connection plan" $ do + it "contact address ok to connect; known contact" testPlanAddressOkKnown + it "own contact address" testPlanAddressOwn + it "connecting via contact address" testPlanAddressConnecting + it "re-connect with deleted contact" testPlanAddressContactDeletedReconnected describe "incognito" $ do it "connect incognito via invitation link" testConnectIncognitoInvitationLink it "connect incognito via contact address" testConnectIncognitoContactAddress @@ -369,7 +374,8 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $ (alice <## "bob (Bob): contact is connected") bob ##> ("/c " <> cLink) - bob <## "alice (Alice): contact already exists" + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" alice @@@ [("@bob", lastChatFeature)] bob @@@ [("@alice", lastChatFeature), (":2", ""), (":1", "")] bob ##> "/_delete :1" @@ -382,7 +388,8 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $ bob @@@ [("@alice", "hey")] bob ##> ("/c " <> cLink) - bob <## "alice (Alice): contact already exists" + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" alice <##> bob alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi"), (0, "hey"), (1, "hi"), (0, "hey")]) @@ -440,7 +447,8 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile (alice <## "robert (Robert): contact is connected") bob ##> ("/c " <> cLink) - bob <## "alice (Alice): contact already exists" + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" alice @@@ [("@robert", lastChatFeature)] bob @@@ [("@alice", lastChatFeature), (":3", ""), (":2", ""), (":1", "")] bob ##> "/_delete :1" @@ -455,7 +463,8 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile bob @@@ [("@alice", "hey")] bob ##> ("/c " <> cLink) - bob <## "alice (Alice): contact already exists" + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" alice <##> bob alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi"), (0, "hey"), (1, "hi"), (0, "hey")]) @@ -566,6 +575,154 @@ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $ ] ] +testPlanAddressOkKnown :: HasCallStack => FilePath -> IO () +testPlanAddressOkKnown = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/ad" + cLink <- getContactLink alice True + + bob ##> ("/_connect plan 1 " <> cLink) + bob <## "contact address: ok to connect" + + bob ##> ("/c " <> cLink) + alice <#? bob + alice @@@ [("<@bob", "")] + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + alice <##> bob + + bob ##> ("/_connect plan 1 " <> cLink) + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" + + bob ##> ("/c " <> cLink) + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" + +testPlanAddressOwn :: HasCallStack => FilePath -> IO () +testPlanAddressOwn tmp = + withNewTestChat tmp "alice" aliceProfile $ \alice -> do + alice ##> "/ad" + cLink <- getContactLink alice True + + alice ##> ("/_connect plan 1 " <> cLink) + alice <## "contact address: own address" + + alice ##> ("/c " <> cLink) + alice <## "connection request sent!" + alice <## "alice_1 (Alice) wants to connect to you!" + alice <## "to accept: /ac alice_1" + alice <## ("to reject: /rc alice_1 (the sender will NOT be notified)") + alice @@@ [("<@alice_1", ""), (":2","")] + alice ##> "/ac alice_1" + alice <## "alice_1 (Alice): accepting contact request..." + alice + <### [ "alice_1 (Alice): contact is connected", + "alice_2 (Alice): contact is connected" + ] + + alice @@@ [("@alice_1", lastChatFeature), ("@alice_2", lastChatFeature)] + alice `send` "@alice_2 hi" + alice + <### [ WithTime "@alice_2 hi", + WithTime "alice_1> hi" + ] + alice `send` "@alice_1 hey" + alice + <### [ WithTime "@alice_1 hey", + WithTime "alice_2> hey" + ] + alice @@@ [("@alice_1", "hey"), ("@alice_2", "hey")] + + alice ##> ("/_connect plan 1 " <> cLink) + alice <## "contact address: own address" + + alice ##> ("/c " <> cLink) + alice <## "alice_2 (Alice): contact already exists" + +testPlanAddressConnecting :: HasCallStack => FilePath -> IO () +testPlanAddressConnecting tmp = do + cLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do + alice ##> "/ad" + getContactLink alice True + withNewTestChat tmp "bob" bobProfile $ \bob -> do + bob ##> ("/c " <> cLink) + bob <## "connection request sent!" + withTestChat tmp "alice" $ \alice -> do + alice <## "Your address is active! To show: /sa" + alice <## "bob (Bob) wants to connect to you!" + alice <## "to accept: /ac bob" + alice <## "to reject: /rc bob (the sender will NOT be notified)" + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + withTestChat tmp "bob" $ \bob -> do + threadDelay 500000 + bob @@@ [("@alice", "")] + bob ##> ("/_connect plan 1 " <> cLink) + bob <## "contact address: connecting to contact alice" + + bob ##> ("/c " <> cLink) + bob <## "contact address: connecting to contact alice" + +testPlanAddressContactDeletedReconnected :: HasCallStack => FilePath -> IO () +testPlanAddressContactDeletedReconnected = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + alice ##> "/ad" + cLink <- getContactLink alice True + + bob ##> ("/c " <> cLink) + alice <#? bob + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + alice <##> bob + + bob ##> ("/_connect plan 1 " <> cLink) + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" + + bob ##> ("/c " <> cLink) + bob <## "contact address: known contact alice" + bob <## "use @alice to send messages" + + alice ##> "/d bob" + alice <## "bob: contact is deleted" + bob <## "alice (Alice) deleted contact with you" + + bob ##> ("/_connect plan 1 " <> cLink) + bob <## "contact address: ok to connect" + + bob ##> ("/c " <> cLink) + bob <## "connection request sent!" + alice <## "bob (Bob) wants to connect to you!" + alice <## "to accept: /ac bob" + alice <## "to reject: /rc bob (the sender will NOT be notified)" + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alice_1 (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + + alice #> "@bob hi" + bob <# "alice_1> hi" + bob #> "@alice_1 hey" + alice <# "bob> hey" + + bob ##> ("/_connect plan 1 " <> cLink) + bob <## "contact address: known contact alice_1" + bob <## "use @alice_1 to send messages" + + bob ##> ("/c " <> cLink) + bob <## "contact address: known contact alice_1" + bob <## "use @alice_1 to send messages" + testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO () testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do From 4ecf94dfad04d93a4515a6e0b4c7338a0b8487fc Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Wed, 11 Oct 2023 09:50:11 +0100 Subject: [PATCH 4/4] core: move CLI notifications and active chat to view layer (for remote CLI) (#3196) * core: move CLI notifications to view layer (to allow notifications in remote CLI) * remove unused * refactor activeTo * move activeTo to ChatTerminal * refactor * move back * remove extension --- apps/simplex-bot-advanced/Main.hs | 2 +- apps/simplex-bot/Main.hs | 2 +- apps/simplex-broadcast-bot/Main.hs | 2 +- apps/simplex-chat/Main.hs | 2 +- apps/simplex-chat/Server.hs | 2 +- apps/simplex-directory-service/Main.hs | 2 +- src/Simplex/Chat.hs | 183 +++++++++------------- src/Simplex/Chat/Controller.hs | 25 +-- src/Simplex/Chat/Core.hs | 6 +- src/Simplex/Chat/Messages.hs | 6 +- src/Simplex/Chat/Mobile.hs | 2 +- src/Simplex/Chat/Store/Profiles.hs | 2 +- src/Simplex/Chat/Terminal.hs | 8 +- src/Simplex/Chat/Terminal/Input.hs | 38 +++-- src/Simplex/Chat/Terminal/Notification.hs | 3 +- src/Simplex/Chat/Terminal/Output.hs | 133 +++++++++++++++- src/Simplex/Chat/Types.hs | 2 - src/Simplex/Chat/View.hs | 2 +- tests/Bots/BroadcastTests.hs | 2 +- tests/Bots/DirectoryTests.hs | 2 +- tests/ChatClient.hs | 4 +- 21 files changed, 249 insertions(+), 181 deletions(-) diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs index 04d8e4ffa1..2af76d9961 100644 --- a/apps/simplex-bot-advanced/Main.hs +++ b/apps/simplex-bot-advanced/Main.hs @@ -24,7 +24,7 @@ import Text.Read main :: IO () main = do opts <- welcomeGetOpts - simplexChatCore terminalChatConfig opts Nothing mySquaringBot + simplexChatCore terminalChatConfig opts mySquaringBot welcomeGetOpts :: IO ChatOpts welcomeGetOpts = do diff --git a/apps/simplex-bot/Main.hs b/apps/simplex-bot/Main.hs index d4ad9f9079..c24f9c251f 100644 --- a/apps/simplex-bot/Main.hs +++ b/apps/simplex-bot/Main.hs @@ -13,7 +13,7 @@ import Text.Read main :: IO () main = do opts <- welcomeGetOpts - simplexChatCore terminalChatConfig opts Nothing $ + simplexChatCore terminalChatConfig opts $ chatBotRepl welcomeMessage $ \_contact msg -> pure $ case readMaybe msg :: Maybe Integer of Just n -> msg <> " * " <> msg <> " = " <> show (n * n) diff --git a/apps/simplex-broadcast-bot/Main.hs b/apps/simplex-broadcast-bot/Main.hs index 15bb743b56..3130437e0f 100644 --- a/apps/simplex-broadcast-bot/Main.hs +++ b/apps/simplex-broadcast-bot/Main.hs @@ -8,4 +8,4 @@ import Simplex.Chat.Terminal (terminalChatConfig) main :: IO () main = do opts <- welcomeGetOpts - simplexChatCore terminalChatConfig (mkChatOpts opts) Nothing $ broadcastBot opts + simplexChatCore terminalChatConfig (mkChatOpts opts) $ broadcastBot opts diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index 8dd02623e2..f5d95e57f0 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -27,7 +27,7 @@ main = do welcome opts t <- withTerminal pure simplexChatTerminal terminalChatConfig opts t - else simplexChatCore terminalChatConfig opts Nothing $ \user cc -> do + else simplexChatCore terminalChatConfig opts $ \user cc -> do r <- sendChatCmdStr cc chatCmd ts <- getCurrentTime tz <- getCurrentTimeZone diff --git a/apps/simplex-chat/Server.hs b/apps/simplex-chat/Server.hs index 6f198340f8..d96350cd29 100644 --- a/apps/simplex-chat/Server.hs +++ b/apps/simplex-chat/Server.hs @@ -30,7 +30,7 @@ import UnliftIO.STM simplexChatServer :: ChatServerConfig -> ChatConfig -> ChatOpts -> IO () simplexChatServer srvCfg cfg opts = - simplexChatCore cfg opts Nothing . const $ runChatServer srvCfg + simplexChatCore cfg opts . const $ runChatServer srvCfg data ChatServerConfig = ChatServerConfig { chatPort :: ServiceName, diff --git a/apps/simplex-directory-service/Main.hs b/apps/simplex-directory-service/Main.hs index 434e42d851..af9c9dd252 100644 --- a/apps/simplex-directory-service/Main.hs +++ b/apps/simplex-directory-service/Main.hs @@ -12,4 +12,4 @@ main :: IO () main = do opts@DirectoryOpts {directoryLog} <- welcomeGetOpts st <- restoreDirectoryStore directoryLog - simplexChatCore terminalChatConfig (mkChatOpts opts) Nothing $ directoryService st opts + simplexChatCore terminalChatConfig (mkChatOpts opts) $ directoryService st opts diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 6f43f5c0f8..5e2a231c97 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -183,13 +183,11 @@ createChatDatabase filePrefix key confirmMigrations = runExceptT $ do agentStore <- ExceptT $ createAgentStore (agentStoreFile filePrefix) key confirmMigrations pure ChatDatabase {chatStore, agentStore} -newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController -newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} sendToast = do +newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> IO ChatController +newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, 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} - sendNotification = fromMaybe (const $ pure ()) sendToast firstTime = dbNew chatStore - activeTo <- newTVarIO ActiveNone currentUser <- newTVarIO user servers <- agentServers config smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore @@ -197,7 +195,6 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen idsDrg <- newTVarIO =<< liftIO drgNew inputQ <- newTBQueueIO tbqSize outputQ <- newTBQueueIO tbqSize - notifyQ <- newTBQueueIO tbqSize subscriptionMode <- newTVarIO SMSubscribe chatLock <- newEmptyTMVarIO sndFiles <- newTVarIO M.empty @@ -213,7 +210,34 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg tempDirectory <- newTVarIO tempDir contactMergeEnabled <- newTVarIO True - pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile, contactMergeEnabled} + pure + ChatController + { firstTime, + currentUser, + smpAgent, + agentAsync, + chatStore, + chatStoreChanged, + idsDrg, + inputQ, + outputQ, + subscriptionMode, + chatLock, + sndFiles, + rcvFiles, + currentCalls, + config, + filesFolder, + expireCIThreads, + expireCIFlags, + cleanupManagerAsync, + timedItemThreads, + showLiveItems, + userXFTPFileConfig, + tempDirectory, + logFilePath = logFile, + contactMergeEnabled + } where configServers :: DefaultAgentServers configServers = @@ -260,7 +284,7 @@ startChatController subConns enableExpireCIs startXFTPWorkers = do readTVarIO s >>= maybe (start s users) (pure . fst) where start s users = do - a1 <- async $ race_ notificationSubscriber agentSubscriber + a1 <- async agentSubscriber a2 <- if subConns then Just <$> async (subscribeUsers False users) @@ -376,7 +400,6 @@ processChatCommand = \case user <- withStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts storeServers user smpServers storeServers user xftpServers - setActive ActiveNone atomically . writeTVar u $ Just user pure $ CRActiveUser user where @@ -402,7 +425,6 @@ processChatCommand = \case user' <- privateGetUser userId' validateUserPassword user user' viewPwd_ withStoreCtx' (Just "APISetActiveUser, setActiveUser") $ \db -> setActiveUser db userId' - setActive ActiveNone let user'' = user' {activeUser = True} asks currentUser >>= atomically . (`writeTVar` Just user'') pure $ CRActiveUser user'' @@ -532,7 +554,7 @@ processChatCommand = \case CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIGetChatItems pagination search -> withUser $ \user -> do chatItems <- withStore $ \db -> getAllChatItems db user pagination search - pure $ CRChatItems user chatItems + pure $ CRChatItems user Nothing chatItems APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do (aci@(AChatItem cType dir _ ci), versions) <- withStore $ \db -> (,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId) @@ -546,7 +568,7 @@ processChatCommand = \case pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses} APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user@User {userId} -> withChatLock "sendMessage" $ case cType of CTDirect -> do - ct@Contact {contactId, localDisplayName = c, contactUsed} <- withStore $ \db -> getContact db user chatId + ct@Contact {contactId, contactUsed} <- withStore $ \db -> getContact db user chatId assertDirectAllowed user MDSnd ct XMsgNew_ unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct if isVoice mc && not (featureAllowed SCFVoice forUser ct) @@ -563,7 +585,6 @@ processChatCommand = \case ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live forM_ (timed_ >>= timedDeleteAt') $ startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) - setActive $ ActiveC c pure $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) where setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) @@ -614,7 +635,7 @@ processChatCommand = \case assertUserGroupRole gInfo GRAuthor send g where - send g@(Group gInfo@GroupInfo {groupId, membership, localDisplayName = gName} ms) + send g@(Group gInfo@GroupInfo {groupId, membership} ms) | isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice | not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles | otherwise = do @@ -629,7 +650,6 @@ processChatCommand = \case createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew forM_ (timed_ >>= timedDeleteAt') $ startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci) - setActive $ ActiveG gName 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)) @@ -734,7 +754,7 @@ processChatCommand = \case unzipMaybe3 _ = (Nothing, Nothing, Nothing) APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of CTDirect -> do - (ct@Contact {contactId, localDisplayName = c}, cci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId + (ct@Contact {contactId}, cci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId assertDirectAllowed user MDSnd ct XMsgUpdate_ case cci of CChatItem SMDSnd ci@ChatItem {meta = CIMeta {itemSharedMsgId, itemTimed, itemLive, editable}, content = ciContent} -> do @@ -750,13 +770,12 @@ processChatCommand = \case addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) updateDirectChatItem' db user contactId ci (CISndMsgContent mc) live $ Just msgId startUpdatedTimedItemThread user (ChatRef CTDirect contactId) ci ci' - setActive $ ActiveC c pure $ CRChatItemUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci') else pure $ CRChatItemNotChanged user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) _ -> throwChatError CEInvalidChatItemUpdate CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate CTGroup -> do - Group gInfo@GroupInfo {groupId, localDisplayName = gName} ms <- withStore $ \db -> getGroup db user chatId + Group gInfo@GroupInfo {groupId} ms <- withStore $ \db -> getGroup db user chatId assertUserGroupRole gInfo GRAuthor cci <- withStore $ \db -> getGroupChatItem db user chatId itemId case cci of @@ -773,7 +792,6 @@ processChatCommand = \case addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) updateGroupChatItem db user groupId ci (CISndMsgContent mc) live $ Just msgId startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' - setActive $ ActiveG gName pure $ CRChatItemUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci') else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) _ -> throwChatError CEInvalidChatItemUpdate @@ -782,13 +800,12 @@ processChatCommand = \case CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of CTDirect -> do - (ct@Contact {localDisplayName = c}, ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, editable}})) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId + (ct, ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, editable}})) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId case (mode, msgDir, itemSharedMsgId, editable) of (CIDMInternal, _, _, _) -> deleteDirectCI user ct ci True False (CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do assertDirectAllowed user MDSnd ct XMsgDel_ (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgDel itemSharedMId Nothing) - setActive $ ActiveC c if featureAllowed SCFFullDelete forUser ct then deleteDirectCI user ct ci True False else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime @@ -898,7 +915,7 @@ processChatCommand = \case _ -> pure $ chatCmdError (Just user) "not supported" APIDeleteChat (ChatRef cType chatId) notify -> withUser $ \user@User {userId} -> case cType of CTDirect -> do - ct@Contact {localDisplayName} <- withStore $ \db -> getContact db user chatId + ct <- withStore $ \db -> getContact db user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct withChatLock "deleteChat direct" . procCmd $ do deleteFilesAndConns user filesInfo @@ -910,7 +927,6 @@ processChatCommand = \case -- (possibly, race condition on integrity check?) withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct withStore' $ \db -> deleteContact db user ct - unsetActive $ ActiveC localDisplayName pure $ CRContactDeleted user ct CTContactConnection -> withChatLock "deleteChat contactConnection" . procCmd $ do conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId @@ -1698,11 +1714,10 @@ processChatCommand = \case LastMessages (Just chatName) count search -> withUser $ \user -> do chatRef <- getChatRef user chatName chatResp <- processChatCommand $ APIGetChat chatRef (CPLast count) search - setActive $ chatActiveTo chatName - pure $ CRChatItems user (aChatItems . chat $ chatResp) + pure $ CRChatItems user (Just chatName) (aChatItems . chat $ chatResp) LastMessages Nothing count search -> withUser $ \user -> do chatItems <- withStore $ \db -> getAllChatItems db user (CPLast count) search - pure $ CRChatItems user chatItems + pure $ CRChatItems user Nothing chatItems LastChatItemId (Just chatName) index -> withUser $ \user -> do chatRef <- getChatRef user chatName chatResp <- processChatCommand (APIGetChat chatRef (CPLast $ index + 1) Nothing) @@ -1714,10 +1729,10 @@ processChatCommand = \case chatItem <- withStore $ \db -> do chatRef <- getChatRefViaItemId db user itemId getAChatItem db user chatRef itemId - pure $ CRChatItems user ((: []) chatItem) + pure $ CRChatItems user Nothing ((: []) chatItem) ShowChatItem Nothing -> withUser $ \user -> do chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing - pure $ CRChatItems user chatItems + pure $ CRChatItems user Nothing chatItems ShowChatItemInfo chatName msg -> withUser $ \user -> do chatRef <- getChatRef user chatName itemId <- getChatItemIdByText user chatRef msg @@ -2059,8 +2074,7 @@ processChatCommand = \case when (memberRemoved membership) $ throwChatError CEGroupMemberUserRemoved unless (memberActive membership) $ throwChatError CEGroupMemberNotActive delGroupChatItem :: User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> m ChatResponse - delGroupChatItem user gInfo@GroupInfo {localDisplayName = gName} ci msgId byGroupMember = do - setActive $ ActiveG gName + delGroupChatItem user gInfo ci msgId byGroupMember = do deletedTs <- liftIO getCurrentTime if groupFeatureAllowed SGFFullDelete gInfo then deleteGroupCI user gInfo ci True False byGroupMember deletedTs @@ -2117,7 +2131,6 @@ processChatCommand = \case let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole ci <- saveSndChatItem user (CDDirectSnd ct) msg content toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) - setActive $ ActiveG localDisplayName sndContactCITimed :: Bool -> Contact -> Maybe Int -> m (Maybe CITimed) sndContactCITimed live = sndCITimed_ live . contactTimedTTL sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> m (Maybe CITimed) @@ -2167,7 +2180,6 @@ processChatCommand = \case users <- withStore' getUsers unless (length users > 1 && (isJust (viewPwdHash user) || length (filter (isNothing . viewPwdHash) users) > 1)) $ throwChatError (CECantDeleteLastUser userId) - setActive ActiveNone deleteChatUser :: User -> Bool -> m ChatResponse deleteChatUser user delSMPQueues = do filesInfo <- withStore' (`getUserFileInfo` user) @@ -2867,17 +2879,16 @@ processAgentMessageNoConn :: forall m. ChatMonad m => ACommand 'Agent 'AENone -> processAgentMessageNoConn = \case CONNECT p h -> hostEvent $ CRHostConnected p h DISCONNECT p h -> hostEvent $ CRHostDisconnected p h - DOWN srv conns -> serverEvent srv conns CRContactsDisconnected "disconnected" - UP srv conns -> serverEvent srv conns CRContactsSubscribed "connected" + DOWN srv conns -> serverEvent srv conns CRContactsDisconnected + UP srv conns -> serverEvent srv conns CRContactsSubscribed SUSPENDED -> toView CRChatSuspended DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId where hostEvent :: ChatResponse -> m () hostEvent = whenM (asks $ hostEvents . config) . toView - serverEvent srv@(SMPServer host _ _) conns event str = do - cs <- withStore' $ \db -> getConnectionsContacts db conns + serverEvent srv conns event = do + cs <- withStore' (`getConnectionsContacts` conns) toView $ event srv cs - showToast ("server " <> str) (safeDecodeUtf8 $ strEncode host) processAgentMsgSndFile :: forall m. ChatMonad m => ACorrId -> SndFileId -> ACommand 'Agent 'AESndFile -> m () processAgentMsgSndFile _corrId aFileId msg = @@ -3014,10 +3025,7 @@ processAgentMsgRcvFile _corrId aFileId msg = processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m () processAgentMessageConn user _ agentConnId END = withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= \case - RcvDirectMsgConnection _ (Just ct@Contact {localDisplayName = c}) -> do - toView $ CRContactAnotherClient user ct - whenUserNtfs user $ showToast (c <> "> ") "connected to another client" - unsetActive $ ActiveC c + RcvDirectMsgConnection _ (Just ct) -> toView $ CRContactAnotherClient user ct entity -> toView $ CRSubscriptionEnd user entity processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do entity <- withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus @@ -3084,7 +3092,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () - Just ct@Contact {localDisplayName = c, contactId} -> case agentMsg of + Just ct@Contact {contactId} -> case agentMsg of INV (ACR _ cReq) -> -- [async agent commands] XGrpMemIntro continuation on receiving INV withCompletedCommand conn agentMsg $ \_ -> @@ -3169,9 +3177,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) toView $ CRContactConnected user ct (fmap fromLocalProfile incognitoProfile) when (directOrUsed ct) $ createFeatureEnabledItems ct - whenUserNtfs user $ do - setActive $ ActiveC c - showToast (c <> "> ") "connected" when (contactConnInitiated conn) $ do let Connection {groupLinkId} = conn doProbeContacts = isJust groupLinkId @@ -3248,7 +3253,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do _ -> pure () processGroupMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> m () - processGroupMessage agentMsg connEntity conn@Connection {connId, connectionCode} gInfo@GroupInfo {groupId, localDisplayName = gName, groupProfile, membership, chatSettings} m = case agentMsg of + processGroupMessage agentMsg connEntity conn@Connection {connId, connectionCode} gInfo@GroupInfo {groupId, groupProfile, membership, chatSettings} m = case agentMsg of INV (ACR _ cReq) -> withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> case cReq of @@ -3338,15 +3343,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do let GroupInfo {groupProfile = GroupProfile {description}} = gInfo memberConnectedChatItem gInfo m forM_ description $ groupDescriptionChatItem gInfo m - whenUserNtfs user $ do - setActive $ ActiveG gName - showToast ("#" <> gName) "you are connected to group" GCInviteeMember -> do memberConnectedChatItem gInfo m toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} - whenGroupNtfs user gInfo $ do - setActive $ ActiveG gName - showToast ("#" <> gName) $ "member " <> m.localDisplayName <> " is connected" intros <- withStore' $ \db -> createIntroductions db members m void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m forM_ intros $ \intro -> @@ -3642,7 +3641,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do profileContactRequest invId chatVRange p xContactId_ = do withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId chatVRange p xContactId_) >>= \case CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact - CORRequest cReq@UserContactRequest {localDisplayName} -> do + CORRequest cReq -> do withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case Just (UserContactLink {autoAccept}, groupId_, _) -> case autoAccept of @@ -3657,10 +3656,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo ct <- acceptContactRequestAsync user cReq profileMode toView $ CRAcceptingGroupJoinRequest user gInfo ct - _ -> do - toView $ CRReceivedContactRequest user cReq - whenUserNtfs user $ - showToast (localDisplayName <> "> ") "wants to connect to you" + _ -> toView $ CRReceivedContactRequest user cReq _ -> pure () incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> m () @@ -3751,13 +3747,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvMsgContent $ MCText descr) Nothing notifyMemberConnected :: GroupInfo -> GroupMember -> Maybe Contact -> m () - notifyMemberConnected gInfo m@GroupMember {localDisplayName = c} ct_ = do + notifyMemberConnected gInfo m ct_ = do memberConnectedChatItem gInfo m toView $ CRConnectedToGroupMember user gInfo m ct_ - let g = groupName' gInfo - whenGroupNtfs user gInfo $ do - setActive $ ActiveG g - showToast ("#" <> g) $ "member " <> c <> " is connected" probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m () probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do @@ -3819,7 +3811,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do messageError = toView . CRMessageError user "error" newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m () - newContentMessage ct@Contact {localDisplayName = c, contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do + newContentMessage ct@Contact {contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct checkIntegrityCreateItem (CDDirectRcv ct) msgMeta let ExtMsgContent content fInv_ _ _ = mcExtMsgContent mc @@ -3832,23 +3824,18 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do if isVoice content && not (featureAllowed SCFVoice forContact ct) then do void $ newChatItem (CIRcvChatFeatureRejected CFVoice) Nothing Nothing False - setActive $ ActiveC c else do let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc timed_ = rcvContactCITimed ct itemTTL live = fromMaybe False live_ file_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct - ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live + newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live autoAcceptFile file_ - whenContactNtfs user ct $ do - showMsgToast (c <> "> ") content formattedText - setActive $ ActiveC c where newChatItem ciContent ciFile_ timed_ live = do ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}) - pure ci autoAcceptFile :: Maybe (RcvFileTransfer, CIFile 'MDRcv) -> m () autoAcceptFile = mapM_ $ \(ft, CIFile {fileSize}) -> do @@ -3907,7 +3894,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do pure (ft, CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol}) messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () - messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do + messageUpdate ct@Contact {contactId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta updateRcvChatItem `catchCINotFound` \_ -> do -- This patches initial sharedMsgId into chat item when locally deleted chat item @@ -3919,7 +3906,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do createChatItemVersion db (chatItemId' ci) brokerTs mc updateDirectChatItem' db user contactId ci content live Nothing toView $ CRChatItemUpdated user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci') - setActive $ ActiveC c where MsgMeta {broker = (_, brokerTs)} = msgMeta content = CIRcvMsgContent mc @@ -4006,7 +3992,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do e -> throwError e newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m () - newGroupContentMessage gInfo m@GroupMember {localDisplayName = c, memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta + newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} msgMeta | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles | otherwise = do @@ -4036,20 +4022,15 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do toView cr createItem timed_ live = do file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m - ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live + newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live autoAcceptFile file_ - let g = groupName' gInfo - whenGroupNtfs user gInfo $ do - showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText - setActive $ ActiveG g newChatItem ciContent ciFile_ timed_ live = do ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_ groupMsgToView gInfo m ci {reactions} msgMeta - pure ci groupMessageUpdate :: GroupInfo -> GroupMember -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () - groupMessageUpdate gInfo@GroupInfo {groupId, localDisplayName = g} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ = + groupMessageUpdate gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId, memberId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl_ live_ = updateRcvChatItem `catchCINotFound` \_ -> do -- This patches initial sharedMsgId into chat item when locally deleted chat item -- received an update from the sender, so that it can be referenced later (e.g. by broadcast delete). @@ -4060,7 +4041,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do createChatItemVersion db (chatItemId' ci) brokerTs mc updateGroupChatItem db user groupId ci content live Nothing toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') - setActive $ ActiveG g where MsgMeta {broker = (_, brokerTs)} = msgMeta content = CIRcvMsgContent mc @@ -4079,7 +4059,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do addInitialAndNewCIVersions db (chatItemId' ci) (chatItemTs' ci, oldMC) (brokerTs, mc) updateGroupChatItem db user groupId ci content live $ Just msgId toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') - setActive $ ActiveG g startUpdatedTimedItemThread user (ChatRef CTGroup groupId) ci ci' else toView $ CRChatItemNotChanged user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci) else messageError "x.msg.update: group member attempted to update a message of another member" @@ -4115,7 +4094,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- TODO remove once XFile is discontinued processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m () - processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do + processFileInvitation' ct fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta ChatConfig {fileChunkSize} <- asks config inline <- receiveInlineMode fInv Nothing fileChunkSize @@ -4124,13 +4103,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) - whenContactNtfs user ct $ do - showToast (c <> "> ") "wants to send a file" - setActive $ ActiveC c -- TODO remove once XFile is discontinued processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m () - processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do + processGroupFileInvitation' gInfo m fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do ChatConfig {fileChunkSize} <- asks config inline <- receiveInlineMode fInv Nothing fileChunkSize RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId m fInv inline fileChunkSize @@ -4138,10 +4114,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent $ MCFile "") ciFile Nothing False groupMsgToView gInfo m ci msgMeta - let g = groupName' gInfo - whenGroupNtfs user gInfo $ do - showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file" - setActive $ ActiveG g receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> m (Maybe InlineFileMode) receiveInlineMode FileInvitation {fileSize, fileInline, fileDescr} mc_ chSize = case (fileInline, fileDescr) of @@ -4322,8 +4294,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} - whenContactNtfs user ct $ - showToast ("#" <> localDisplayName <> " " <> c <> "> ") "invited you to join the group" where sameGroupLinkId :: Maybe GroupLinkId -> Maybe GroupLinkId -> Bool sameGroupLinkId (Just gli) (Just gli') = gli == gli' @@ -5470,29 +5440,20 @@ getCreateActiveUser st testView = do getWithPrompt :: String -> IO String getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine -whenUserNtfs :: ChatMonad' m => User -> m () -> m () -whenUserNtfs User {showNtfs, activeUser} = when $ showNtfs || activeUser +userNtf :: User -> Bool +userNtf User {showNtfs, activeUser} = showNtfs || activeUser -whenContactNtfs :: ChatMonad' m => User -> Contact -> m () -> m () -whenContactNtfs user Contact {chatSettings} = whenUserNtfs user . when (enableNtfs chatSettings) +chatNtf :: User -> ChatInfo c -> Bool +chatNtf user = \case + DirectChat ct -> contactNtf user ct + GroupChat g -> groupNtf user g + _ -> False -whenGroupNtfs :: ChatMonad' m => User -> GroupInfo -> m () -> m () -whenGroupNtfs user GroupInfo {chatSettings} = whenUserNtfs user . when (enableNtfs chatSettings) +contactNtf :: User -> Contact -> Bool +contactNtf user Contact {chatSettings} = userNtf user && enableNtfs chatSettings -showMsgToast :: ChatMonad' m => Text -> MsgContent -> Maybe MarkdownList -> m () -showMsgToast from mc md_ = showToast from $ maybe (msgContentText mc) (mconcat . map hideSecret) md_ - where - hideSecret :: FormattedText -> Text - hideSecret FormattedText {format = Just Secret} = "..." - hideSecret FormattedText {text} = text - -showToast :: ChatMonad' m => Text -> Text -> m () -showToast title text = atomically . (`writeTBQueue` Notification {title, text}) =<< asks notifyQ - -notificationSubscriber :: ChatMonad' m => m () -notificationSubscriber = do - ChatController {notifyQ, sendNotification} <- ask - forever $ atomically (readTBQueue notifyQ) >>= liftIO . sendNotification +groupNtf :: User -> GroupInfo -> Bool +groupNtf user GroupInfo {chatSettings} = userNtf user && enableNtfs chatSettings withUser' :: ChatMonad m => (User -> m ChatResponse) -> m ChatResponse withUser' action = diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 3466371da8..d97d59c5c5 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -34,8 +34,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) import Data.String import Data.Text (Text) -import Data.Time (NominalDiffTime) -import Data.Time.Clock (UTCTime) +import Data.Time (NominalDiffTime, UTCTime) import Data.Version (showVersion) import GHC.Generics (Generic) import Language.Haskell.TH (Exp, Q, runIO) @@ -153,20 +152,10 @@ defaultInlineFilesConfig = receiveInstant = True -- allow receiving instant files, within receiveChunks limit } -data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName - deriving (Eq) - -chatActiveTo :: ChatName -> ActiveTo -chatActiveTo (ChatName cType name) = case cType of - CTDirect -> ActiveC name - CTGroup -> ActiveG name - _ -> ActiveNone - data ChatDatabase = ChatDatabase {chatStore :: SQLiteStore, agentStore :: SQLiteStore} data ChatController = ChatController { currentUser :: TVar (Maybe User), - activeTo :: TVar ActiveTo, firstTime :: Bool, smpAgent :: AgentClient, agentAsync :: TVar (Maybe (Async (), Maybe (Async ()))), @@ -175,8 +164,6 @@ data ChatController = ChatController idsDrg :: TVar ChaChaDRG, inputQ :: TBQueue String, outputQ :: TBQueue (Maybe CorrId, ChatResponse), - notifyQ :: TBQueue Notification, - sendNotification :: Notification -> IO (), subscriptionMode :: TVar SubscriptionMode, chatLock :: Lock, sndFiles :: TVar (Map Int64 Handle), @@ -433,7 +420,7 @@ data ChatResponse | CRApiChats {user :: User, chats :: [AChat]} | CRChats {chats :: [AChat]} | CRApiChat {user :: User, chat :: AChat} - | CRChatItems {user :: User, chatItems :: [AChatItem]} + | CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]} | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo} | CRChatItemId User (Maybe ChatItemId) | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList} @@ -1074,14 +1061,6 @@ mkChatError = ChatError . CEException . show chatCmdError :: Maybe User -> String -> ChatResponse chatCmdError user = CRChatCmdError user . ChatError . CECommandError -setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m () -setActive to = asks activeTo >>= atomically . (`writeTVar` to) - -unsetActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m () -unsetActive a = asks activeTo >>= atomically . (`modifyTVar` unset) - where - unset a' = if a == a' then ActiveNone else a' - toView :: ChatMonad' m => ChatResponse -> m () toView event = do q <- asks outputQ diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 4af161ab41..870779cfda 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -14,8 +14,8 @@ import Simplex.Chat.Types import System.Exit (exitFailure) import UnliftIO.Async -simplexChatCore :: ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> (User -> ChatController -> IO ()) -> IO () -simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} sendToast chat = +simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO () +simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} chat = case logAgent of Just level -> do setLogLevel level @@ -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 sendToast + cc <- newChatController db (Just u) cfg opts runSimplexChat opts u cc chat runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO () diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 79463d2107..3831fad03e 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -50,8 +50,10 @@ import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection deriving (Eq, Show, Ord, Generic) -data ChatName = ChatName ChatType Text - deriving (Show) +data ChatName = ChatName {chatType :: ChatType, chatName :: Text} + deriving (Show, Generic) + +instance ToJSON ChatName where toEncoding = J.genericToEncoding J.defaultOptions chatTypeStr :: ChatType -> String chatTypeStr = \case diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 3d841f18c4..0a970d2c8e 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -196,7 +196,7 @@ chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do where initialize st db = do user_ <- getActiveUser_ st - newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix dbKey) Nothing + newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix dbKey) migrate createStore dbFile confirmMigrations = ExceptT $ (first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey confirmMigrations) diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index 5b5a6eb671..fa573e4e60 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -87,7 +87,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode) import Simplex.Messaging.Transport.Client (TransportHost) -import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8) +import Simplex.Messaging.Util (safeDecodeUtf8) createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT StoreError IO User createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index 0ef3d3bace..68aaa51318 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/src/Simplex/Chat/Terminal.hs @@ -15,7 +15,6 @@ import Simplex.Chat.Core import Simplex.Chat.Help (chatWelcome) import Simplex.Chat.Options import Simplex.Chat.Terminal.Input -import Simplex.Chat.Terminal.Notification import Simplex.Chat.Terminal.Output import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) import Simplex.Messaging.Client (defaultNetworkConfig) @@ -40,10 +39,9 @@ terminalChatConfig = } simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO () -simplexChatTerminal cfg opts t = do - sendToast <- if muteNotifications opts then pure Nothing else Just <$> initializeNotifications - handle checkDBKeyError . simplexChatCore cfg opts sendToast $ \u cc -> do - ct <- newChatTerminal t +simplexChatTerminal cfg opts t = + handle checkDBKeyError . simplexChatCore cfg opts $ \u cc -> do + ct <- newChatTerminal t opts when (firstTime cc) . printToTerminal ct $ chatWelcome u runChatTerminal ct cc diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 8841f15ffd..0fd95cf680 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -57,14 +57,26 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do cmd = parseChatCommand bs unless (isMessage cmd) $ echo s r <- runReaderT (execChatCommand bs) cc - case r of - CRChatCmdError _ _ -> when (isMessage cmd) $ echo s - CRChatError _ _ -> when (isMessage cmd) $ echo s - _ -> pure () + processResp s cmd r printRespToTerminal ct cc False r startLiveMessage cmd r where echo s = printToTerminal ct [plain s] + processResp s cmd = \case + CRActiveUser _ -> setActive ct "" + CRChatItems u chatName_ _ -> whenCurrUser cc u $ mapM_ (setActive ct . chatActiveTo) chatName_ + CRNewChatItem u (AChatItem _ SMDSnd cInfo _) -> whenCurrUser cc u $ setActiveChat ct cInfo + CRChatItemUpdated u (AChatItem _ SMDSnd cInfo _) -> whenCurrUser cc u $ setActiveChat ct cInfo + CRChatItemDeleted u (AChatItem _ _ cInfo _) _ _ _ -> whenCurrUser cc u $ setActiveChat ct cInfo + CRContactDeleted u c -> whenCurrUser cc u $ unsetActiveContact ct c + CRGroupDeletedUser u g -> whenCurrUser cc u $ unsetActiveGroup ct g + CRSentGroupInvitation u g _ _ -> whenCurrUser cc u $ setActiveGroup ct g + CRChatCmdError _ _ -> when (isMessage cmd) $ echo s + CRChatError _ _ -> when (isMessage cmd) $ echo s + CRCmdOk _ -> case cmd of + Right APIDeleteUser {} -> setActive ct "" + _ -> pure () + _ -> pure () isMessage = \case Right SendMessage {} -> True Right SendLiveMessage {} -> True @@ -134,7 +146,7 @@ runTerminalInput ct cc = withChatTerm ct $ do receiveFromTTY cc ct receiveFromTTY :: forall m. MonadTerminal m => ChatController -> ChatTerminal -> m () -receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState} = +receiveFromTTY cc@ChatController {inputQ, currentUser, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} = forever $ getKey >>= liftIO . processKey >> withTermLock ct (updateInput ct) where processKey :: (Key, Modifiers) -> IO () @@ -153,11 +165,11 @@ receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, chatStore} ct@C when (inputString ts /= "" || isLive) $ atomically (submitInput live ts) >>= mapM_ (uncurry endLiveMessage) update key = do - ac <- readTVarIO activeTo + chatPrefix <- readTVarIO activeTo live <- isJust <$> readTVarIO liveMessageState ts <- readTVarIO termState user_ <- readTVarIO currentUser - ts' <- updateTermState user_ chatStore ac live (width termSize) key ts + ts' <- updateTermState user_ chatStore chatPrefix live (width termSize) key ts atomically $ writeTVar termState $! ts' endLiveMessage :: String -> LiveMessage -> IO () @@ -203,8 +215,8 @@ data AutoComplete | ACCommand Text | ACNone -updateTermState :: Maybe User -> SQLiteStore -> ActiveTo -> Bool -> Int -> (Key, Modifiers) -> TerminalState -> IO TerminalState -updateTermState user_ st ac live tw (key, ms) ts@TerminalState {inputString = s, inputPosition = p, autoComplete = acp} = case key of +updateTermState :: Maybe User -> SQLiteStore -> String -> Bool -> Int -> (Key, Modifiers) -> TerminalState -> IO TerminalState +updateTermState user_ st chatPrefix live tw (key, ms) ts@TerminalState {inputString = s, inputPosition = p, autoComplete = acp} = case key of CharKey c | ms == mempty || ms == shiftKey -> pure $ insertChars $ charsWithContact [c] | ms == altKey && c == 'b' -> pure $ setPosition prevWordPos @@ -326,17 +338,13 @@ updateTermState user_ st ac live tw (key, ms) ts@TerminalState {inputString = s, charsWithContact cs | live = cs | null s && cs /= "@" && cs /= "#" && cs /= "/" && cs /= ">" && cs /= "\\" && cs /= "!" && cs /= "+" && cs /= "-" = - contactPrefix <> cs + chatPrefix <> cs | (s == ">" || s == "\\" || s == "!") && cs == " " = - cs <> contactPrefix + cs <> chatPrefix | otherwise = cs insertChars = ts' . if p >= length s then append else insert append cs = let s' = s <> cs in (s', length s') insert cs = let (b, a) = splitAt p s in (b <> cs <> a, p + length cs) - contactPrefix = case ac of - ActiveNone -> "" - ActiveC c -> "@" <> T.unpack c <> " " - ActiveG g -> "#" <> T.unpack g <> " " backDeleteChar | p == 0 || null s = ts | p >= length s = ts' (init s, length s - 1) diff --git a/src/Simplex/Chat/Terminal/Notification.hs b/src/Simplex/Chat/Terminal/Notification.hs index 98031fe525..87bed5be1a 100644 --- a/src/Simplex/Chat/Terminal/Notification.hs +++ b/src/Simplex/Chat/Terminal/Notification.hs @@ -13,13 +13,14 @@ import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T -import Simplex.Chat.Types import Simplex.Messaging.Util (catchAll_) import System.Directory (createDirectoryIfMissing, doesFileExist, findExecutable, getAppUserDataDirectory) import System.FilePath (combine) import System.Info (os) import System.Process (readCreateProcess, shell) +data Notification = Notification {title :: Text, text :: Text} + initializeNotifications :: IO (Notification -> IO ()) initializeNotifications = hideException <$> case os of diff --git a/src/Simplex/Chat/Terminal/Output.hs b/src/Simplex/Chat/Terminal/Output.hs index db6f16f3ca..556e4f792e 100644 --- a/src/Simplex/Chat/Terminal/Output.hs +++ b/src/Simplex/Chat/Terminal/Output.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,13 +15,24 @@ import Control.Monad.Catch (MonadMask) import Control.Monad.Except import Control.Monad.Reader import Data.List (intercalate) +import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (getCurrentTimeZone) -import Simplex.Chat (processChatCommand) +import Simplex.Chat (processChatCommand, chatNtf, contactNtf, groupNtf, userNtf) import Simplex.Chat.Controller -import Simplex.Chat.Messages hiding (NewChatItem (..)) +import Simplex.Chat.Markdown +import Simplex.Chat.Messages +import Simplex.Chat.Messages.CIContent (CIContent(..), SMsgDirection (..)) +import Simplex.Chat.Options +import Simplex.Chat.Protocol (MsgContent (..), msgContentText) import Simplex.Chat.Styled +import Simplex.Chat.Terminal.Notification (Notification (..), initializeNotifications) +import Simplex.Chat.Types (Contact, GroupInfo (..), User (..), UserContactRequest (..)) import Simplex.Chat.View +import Simplex.Messaging.Agent.Protocol +import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Util (safeDecodeUtf8) import System.Console.ANSI.Types import System.IO (IOMode (..), hPutStrLn, withFile) import System.Mem.Weak (Weak) @@ -34,7 +46,9 @@ data ChatTerminal = ChatTerminal termSize :: Size, liveMessageState :: TVar (Maybe LiveMessage), nextMessageRow :: TVar Int, - termLock :: TMVar () + termLock :: TMVar (), + sendNotification :: Maybe (Notification -> IO ()), + activeTo :: TVar String } data TerminalState = TerminalState @@ -79,16 +93,28 @@ instance WithTerminal VirtualTerminal where withChatTerm :: (MonadIO m, MonadMask m) => ChatTerminal -> (forall t. WithTerminal t => TerminalT t m a) -> m a withChatTerm ChatTerminal {termDevice = TerminalDevice t} action = withTerm t $ runTerminalT action -newChatTerminal :: WithTerminal t => t -> IO ChatTerminal -newChatTerminal t = do +newChatTerminal :: WithTerminal t => t -> ChatOpts -> IO ChatTerminal +newChatTerminal t opts = do termSize <- withTerm t . runTerminalT $ getWindowSize let lastRow = height termSize - 1 termState <- newTVarIO mkTermState liveMessageState <- newTVarIO Nothing termLock <- newTMVarIO () nextMessageRow <- newTVarIO lastRow + sendNotification <- if muteNotifications opts then pure Nothing else Just <$> initializeNotifications + activeTo <- newTVarIO "" -- threadDelay 500000 -- this delay is the same as timeout in getTerminalSize - return ChatTerminal {termDevice = TerminalDevice t, termState, termSize, liveMessageState, nextMessageRow, termLock} + pure + ChatTerminal + { termDevice = TerminalDevice t, + termState, + termSize, + liveMessageState, + nextMessageRow, + termLock, + sendNotification, + activeTo + } mkTermState :: TerminalState mkTermState = @@ -122,6 +148,7 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d _ -> printToTerminal ct liveItems <- readTVarIO showLiveItems responseString cc liveItems r >>= printResp + responseNotification ct cc r where markChatItemRead (AChatItem _ _ chat item@ChatItem {chatDir, meta = CIMeta {itemStatus}}) = case (muted chat chatDir, itemStatus) of @@ -132,6 +159,100 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d _ -> pure () logResponse path s = withFile path AppendMode $ \h -> mapM_ (hPutStrLn h . unStyle) s +responseNotification :: ChatTerminal -> ChatController -> ChatResponse -> IO () +responseNotification t@ChatTerminal {sendNotification} cc = \case + CRNewChatItem u (AChatItem _ SMDRcv cInfo ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) -> + when (chatNtf u cInfo) $ do + whenCurrUser cc u $ setActiveChat t cInfo + case (cInfo, chatDir) of + (DirectChat ct, _) -> sendNtf (viewContactName ct <> "> ", text) + (GroupChat g, CIGroupRcv m) -> sendNtf (fromGroup_ g m, text) + _ -> pure () + where + text = msgText mc formattedText + CRChatItemUpdated u (AChatItem _ SMDRcv cInfo ChatItem {content = CIRcvMsgContent _}) -> + whenCurrUser cc u $ when (chatNtf u cInfo) $ setActiveChat t cInfo + CRContactConnected u ct _ -> when (contactNtf u ct) $ do + whenCurrUser cc u $ setActiveContact t ct + sendNtf (viewContactName ct <> "> ", "connected") + CRContactAnotherClient u ct -> do + whenCurrUser cc u $ unsetActiveContact t ct + when (contactNtf u ct) $ sendNtf (viewContactName ct <> "> ", "connected to another client") + CRContactsDisconnected srv _ -> serverNtf srv "disconnected" + CRContactsSubscribed srv _ -> serverNtf srv "connected" + CRReceivedGroupInvitation u g ct _ _ -> + when (contactNtf u ct) $ + sendNtf ("#" <> viewGroupName g <> " " <> viewContactName ct <> "> ", "invited you to join the group") + CRUserJoinedGroup u g _ -> when (groupNtf u g) $ do + whenCurrUser cc u $ setActiveGroup t g + sendNtf ("#" <> viewGroupName g, "you are connected to group") + CRJoinedGroupMember u g m -> + when (groupNtf u g) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected") + CRConnectedToGroupMember u g m _ -> + when (groupNtf u g) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected") + CRReceivedContactRequest u UserContactRequest {localDisplayName = n} -> + when (userNtf u) $ sendNtf (viewName n <> ">", "wants to connect to you") + _ -> pure () + where + sendNtf = maybe (\_ -> pure ()) (. uncurry Notification) sendNotification + serverNtf (SMPServer host _ _) str = sendNtf ("server " <> str, safeDecodeUtf8 $ strEncode host) + +msgText :: MsgContent -> Maybe MarkdownList -> Text +msgText (MCFile _) _ = "wants to send a file" +msgText mc md_ = maybe (msgContentText mc) (mconcat . map hideSecret) md_ + where + hideSecret :: FormattedText -> Text + hideSecret FormattedText {format = Just Secret} = "..." + hideSecret FormattedText {text} = text + +chatActiveTo :: ChatName -> String +chatActiveTo (ChatName cType name) = case cType of + CTDirect -> T.unpack $ "@" <> viewName name <> " " + CTGroup -> T.unpack $ "#" <> viewName name <> " " + _ -> "" + +chatInfoActiveTo :: ChatInfo c -> String +chatInfoActiveTo = \case + DirectChat c -> contactActiveTo c + GroupChat g -> groupActiveTo g + _ -> "" + +contactActiveTo :: Contact -> String +contactActiveTo c = T.unpack $ "@" <> viewContactName c <> " " + +groupActiveTo :: GroupInfo -> String +groupActiveTo g = T.unpack $ "#" <> viewGroupName g <> " " + +setActiveChat :: ChatTerminal -> ChatInfo c -> IO () +setActiveChat t = setActive t . chatInfoActiveTo + +setActiveContact :: ChatTerminal -> Contact -> IO () +setActiveContact t = setActive t . contactActiveTo + +setActiveGroup :: ChatTerminal -> GroupInfo -> IO () +setActiveGroup t = setActive t . groupActiveTo + +setActive :: ChatTerminal -> String -> IO () +setActive ChatTerminal {activeTo} to = atomically $ writeTVar activeTo to + +unsetActiveContact :: ChatTerminal -> Contact -> IO () +unsetActiveContact t = unsetActive t . contactActiveTo + +unsetActiveGroup :: ChatTerminal -> GroupInfo -> IO () +unsetActiveGroup t = unsetActive t . groupActiveTo + +unsetActive :: ChatTerminal -> String -> IO () +unsetActive ChatTerminal {activeTo} to' = atomically $ modifyTVar activeTo unset + where + unset to = if to == to' then "" else to + +whenCurrUser :: ChatController -> User -> IO () -> IO () +whenCurrUser cc u a = do + u_ <- readTVarIO $ currentUser cc + when (sameUser u u_) a + where + sameUser User {userId = uId} = maybe False $ \User {userId} -> userId == uId + printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> ChatResponse -> IO () printRespToTerminal ct cc liveItems r = responseString cc liveItems r >>= printToTerminal ct diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 864ebd7227..de56baad92 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1424,8 +1424,6 @@ serializeIntroStatus = \case GMIntroToConnected -> "to-con" GMIntroConnected -> "con" -data Notification = Notification {title :: Text, text :: Text} - textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index bb5e854cd2..f60b7cd82f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -103,7 +103,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewChatItem chat item False ts tz <> viewItemReactions item - CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems + CRChatItems u _ chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId] CRChatItemStatusUpdated u ci -> ttyUser u $ viewChatItemStatusUpdated ci ts tz testView showReceipts diff --git a/tests/Bots/BroadcastTests.hs b/tests/Bots/BroadcastTests.hs index ae2d67c7f0..ed0b9e069a 100644 --- a/tests/Bots/BroadcastTests.hs +++ b/tests/Bots/BroadcastTests.hs @@ -26,7 +26,7 @@ withBroadcastBot :: BroadcastBotOpts -> IO () -> IO () withBroadcastBot opts test = bracket (forkIO bot) killThread (\_ -> threadDelay 500000 >> test) where - bot = simplexChatCore testCfg (mkChatOpts opts) Nothing $ broadcastBot opts + bot = simplexChatCore testCfg (mkChatOpts opts) $ broadcastBot opts broadcastBotProfile :: Profile broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadcast Bot", image = Nothing, contactLink = Nothing, preferences = Nothing} diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 0e315190c5..3e1c32a6f7 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -827,7 +827,7 @@ runDirectory cfg opts@DirectoryOpts {directoryLog} action = do threadDelay 500000 action `finally` (mapM_ hClose (directoryLogFile st) >> killThread t) where - bot st = simplexChatCore cfg (mkChatOpts opts) Nothing $ directoryService st opts + bot st = simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts registerGroup :: TestCC -> TestCC -> String -> String -> IO () registerGroup su u n fn = registerGroupId su u n fn 1 1 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 7da5263253..aae3b5c4c7 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -161,8 +161,8 @@ startTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefi startTestChat_ :: ChatDatabase -> ChatConfig -> ChatOpts -> User -> IO TestCC startTestChat_ db cfg opts user = do t <- withVirtualTerminal termSettings pure - ct <- newChatTerminal t - cc <- newChatController db (Just user) cfg opts Nothing -- no notifications + ct <- newChatTerminal t opts + cc <- newChatController db (Just user) cfg opts chatAsync <- async . runSimplexChat opts user cc . const $ runChatTerminal ct atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry termQ <- newTQueueIO