diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 0c7a55b148..8785360693 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -293,4 +293,37 @@ jobs: body: | ${{ steps.windows_build.outputs.bin_hash }} + - name: Windows build desktop + id: windows_desktop_build + if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest' + env: + SIMPLEX_CI_REPO_URL: ${{ secrets.SIMPLEX_CI_REPO_URL }} + shell: bash + run: | + scripts/desktop/build-lib-windows.sh + cd apps/multiplatform + ./gradlew packageMsi + path=$(echo $PWD/release/main/msi/*imple*.msi | sed 's#/\([a-z]\)#\1:#' | sed 's#/#\\#g') + echo "package_path=$path" >> $GITHUB_OUTPUT + echo "package_hash=$(echo SHA2-512\(${{ matrix.desktop_asset_name }}\)= $(openssl sha512 $path | cut -d' ' -f 2))" >> $GITHUB_OUTPUT + + - name: Windows upload desktop package to release + if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest' + uses: svenstaro/upload-release-action@v2 + with: + repo_token: ${{ secrets.GITHUB_TOKEN }} + file: ${{ steps.windows_desktop_build.outputs.package_path }} + asset_name: ${{ matrix.desktop_asset_name }} + tag: ${{ github.ref }} + + - name: Windows update desktop package hash + if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest' + uses: softprops/action-gh-release@v1 + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + with: + append_body: true + body: | + ${{ steps.windows_desktop_build.outputs.package_hash }} + # Windows / 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/Shared/Views/Chat/ChatView.swift b/apps/ios/Shared/Views/Chat/ChatView.swift index 389080efc5..81473709cb 100644 --- a/apps/ios/Shared/Views/Chat/ChatView.swift +++ b/apps/ios/Shared/Views/Chat/ChatView.swift @@ -965,7 +965,7 @@ struct ChatView: View { func toggleNotifications(_ chat: Chat, enableNtfs: Bool) { var chatSettings = chat.chatInfo.chatSettings ?? ChatSettings.defaults - chatSettings.enableNtfs = enableNtfs + chatSettings.enableNtfs = enableNtfs ? .all : .none updateChatSettings(chat, chatSettings: chatSettings) } diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj index 18021e3079..35d0b1de8a 100644 --- a/apps/ios/SimpleX.xcodeproj/project.pbxproj +++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj @@ -85,6 +85,11 @@ 5CA059ED279559F40002BEB4 /* ContentView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA059C4279559F40002BEB4 /* ContentView.swift */; }; 5CA059EF279559F40002BEB4 /* Assets.xcassets in Resources */ = {isa = PBXBuildFile; fileRef = 5CA059C5279559F40002BEB4 /* Assets.xcassets */; }; 5CA7DFC329302AF000F7FDDE /* AppSheet.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CA7DFC229302AF000F7FDDE /* AppSheet.swift */; }; + 5CA8D0162AD746C8001FD661 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CA8D0112AD746C8001FD661 /* libgmpxx.a */; }; + 5CA8D0172AD746C8001FD661 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CA8D0122AD746C8001FD661 /* libffi.a */; }; + 5CA8D0182AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CA8D0132AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b.a */; }; + 5CA8D0192AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b-ghc8.10.7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CA8D0142AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b-ghc8.10.7.a */; }; + 5CA8D01A2AD746C8001FD661 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CA8D0152AD746C8001FD661 /* libgmp.a */; }; 5CADE79A29211BB900072E13 /* PreferencesView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CADE79929211BB900072E13 /* PreferencesView.swift */; }; 5CADE79C292131E900072E13 /* ContactPreferencesView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CADE79B292131E900072E13 /* ContactPreferencesView.swift */; }; 5CB0BA882826CB3A00B3292C /* InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CB0BA862826CB3A00B3292C /* InfoPlist.strings */; }; @@ -114,11 +119,6 @@ 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 */; }; - 5CC739972AD44E2E009470A9 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739922AD44E2E009470A9 /* libgmp.a */; }; - 5CC739982AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739932AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a */; }; - 5CC739992AD44E2E009470A9 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739942AD44E2E009470A9 /* libffi.a */; }; - 5CC7399A2AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739952AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a */; }; - 5CC7399B2AD44E2E009470A9 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739962AD44E2E009470A9 /* libgmpxx.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 */; }; @@ -358,6 +358,11 @@ 5CA85D0A297218AA0095AF72 /* it */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = it; path = it.lproj/Localizable.strings; sourceTree = ""; }; 5CA85D0C297219EF0095AF72 /* it */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = it; path = "it.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = ""; }; 5CA85D0D297219EF0095AF72 /* it */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = it; path = it.lproj/InfoPlist.strings; sourceTree = ""; }; + 5CA8D0112AD746C8001FD661 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = ""; }; + 5CA8D0122AD746C8001FD661 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; + 5CA8D0132AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b.a"; sourceTree = ""; }; + 5CA8D0142AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b-ghc8.10.7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b-ghc8.10.7.a"; sourceTree = ""; }; + 5CA8D0152AD746C8001FD661 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; 5CAB912529E93F9400F34A95 /* pl */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = pl; path = pl.lproj/Localizable.strings; sourceTree = ""; }; 5CAC41182A192D8400C331A2 /* ja */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ja; path = ja.lproj/Localizable.strings; sourceTree = ""; }; 5CAC411A2A192DE800C331A2 /* ja */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ja; path = "ja.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = ""; }; @@ -395,11 +400,6 @@ 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 = ""; }; - 5CC739922AD44E2E009470A9 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; - 5CC739932AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a"; sourceTree = ""; }; - 5CC739942AD44E2E009470A9 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; - 5CC739952AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a"; sourceTree = ""; }; - 5CC739962AD44E2E009470A9 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.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 = ( - 5CC739982AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a in Frameworks */, + 5CA8D0162AD746C8001FD661 /* libgmpxx.a in Frameworks */, + 5CA8D01A2AD746C8001FD661 /* libgmp.a in Frameworks */, + 5CA8D0182AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b.a in Frameworks */, + 5CA8D0192AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b-ghc8.10.7.a in Frameworks */, 5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */, - 5CC739972AD44E2E009470A9 /* libgmp.a in Frameworks */, - 5CC7399A2AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a in Frameworks */, - 5CC739992AD44E2E009470A9 /* libffi.a in Frameworks */, 5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */, - 5CC7399B2AD44E2E009470A9 /* libgmpxx.a in Frameworks */, + 5CA8D0172AD746C8001FD661 /* libffi.a in Frameworks */, ); runOnlyForDeploymentPostprocessing = 0; }; @@ -574,11 +574,11 @@ 5C764E5C279C70B7000C6508 /* Libraries */ = { isa = PBXGroup; children = ( - 5CC739942AD44E2E009470A9 /* libffi.a */, - 5CC739922AD44E2E009470A9 /* libgmp.a */, - 5CC739962AD44E2E009470A9 /* libgmpxx.a */, - 5CC739932AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a */, - 5CC739952AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a */, + 5CA8D0122AD746C8001FD661 /* libffi.a */, + 5CA8D0152AD746C8001FD661 /* libgmp.a */, + 5CA8D0112AD746C8001FD661 /* libgmpxx.a */, + 5CA8D0142AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b-ghc8.10.7.a */, + 5CA8D0132AD746C8001FD661 /* libHSsimplex-chat-5.4.0.1-7lTZkX9ojv2DbehL2eOY1b.a */, ); path = Libraries; sourceTree = ""; diff --git a/apps/ios/SimpleXChat/API.swift b/apps/ios/SimpleXChat/API.swift index 0d59fe55c7..c7e94a2dc0 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/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index 951f726be9..d65b9b3283 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -1182,17 +1182,23 @@ public struct KeepAliveOpts: Codable, Equatable { } public struct ChatSettings: Codable { - public var enableNtfs: Bool + public var enableNtfs: MsgFilter public var sendRcpts: Bool? public var favorite: Bool - public init(enableNtfs: Bool, sendRcpts: Bool?, favorite: Bool) { + public init(enableNtfs: MsgFilter, sendRcpts: Bool?, favorite: Bool) { self.enableNtfs = enableNtfs self.sendRcpts = sendRcpts self.favorite = favorite } - public static let defaults: ChatSettings = ChatSettings(enableNtfs: true, sendRcpts: nil, favorite: false) + public static let defaults: ChatSettings = ChatSettings(enableNtfs: .all, sendRcpts: nil, favorite: false) +} + +public enum MsgFilter: String, Codable { + case none + case all + case mentions } public struct UserMsgReceiptSettings: Codable { 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/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index f9996d8400..37e4f0316a 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -1292,7 +1292,7 @@ public enum ChatInfo: Identifiable, Decodable, NamedChat { } public var ntfsEnabled: Bool { - self.chatSettings?.enableNtfs ?? false + self.chatSettings?.enableNtfs == .all } public var chatSettings: ChatSettings? { @@ -1758,6 +1758,7 @@ public struct GroupMember: Identifiable, Decodable { public var memberRole: GroupMemberRole public var memberCategory: GroupMemberCategory public var memberStatus: GroupMemberStatus + public var memberSettings: GroupMemberSettings public var invitedBy: InvitedBy public var localDisplayName: ContactName public var memberProfile: LocalProfile @@ -1851,6 +1852,7 @@ public struct GroupMember: Identifiable, Decodable { memberRole: .admin, memberCategory: .inviteeMember, memberStatus: .memComplete, + memberSettings: GroupMemberSettings(showMessages: true), invitedBy: .user, localDisplayName: "alice", memberProfile: LocalProfile.sampleData, @@ -1860,6 +1862,10 @@ public struct GroupMember: Identifiable, Decodable { ) } +public struct GroupMemberSettings: Decodable { + var showMessages: Bool +} + public struct GroupMemberRef: Decodable { var groupMemberId: Int64 var profile: Profile @@ -1983,8 +1989,8 @@ public enum ConnectionEntity: Decodable { public var ntfsEnabled: Bool { switch self { - case let .rcvDirectMsgConnection(contact): return contact?.chatSettings.enableNtfs ?? false - case let .rcvGroupMsgConnection(groupInfo, _): return groupInfo.chatSettings.enableNtfs + case let .rcvDirectMsgConnection(contact): return contact?.chatSettings.enableNtfs == .all + case let .rcvGroupMsgConnection(groupInfo, _): return groupInfo.chatSettings.enableNtfs == .all case .sndFileConnection: return false case .rcvFileConnection: return false case let .userContactConnection(userContact): return userContact.groupId == nil diff --git a/apps/ios/SimpleXChat/SimpleX.h b/apps/ios/SimpleXChat/SimpleX.h index 9db3f06ae7..250f1cb73f 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); diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt index 8687ac390a..88ad78612c 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt @@ -12,7 +12,6 @@ import chat.simplex.common.ui.theme.* import chat.simplex.common.views.call.* import chat.simplex.common.views.chat.ComposeState import chat.simplex.common.views.helpers.* -import chat.simplex.common.views.onboarding.OnboardingStage import chat.simplex.res.MR import dev.icerock.moko.resources.ImageResource import dev.icerock.moko.resources.StringResource @@ -726,7 +725,7 @@ sealed class ChatInfo: SomeChat, NamedChat { override val apiId get() = contactConnection.apiId override val ready get() = contactConnection.ready override val sendMsgEnabled get() = contactConnection.sendMsgEnabled - override val ntfsEnabled get() = contactConnection.incognito + override val ntfsEnabled get() = false override val incognito get() = contactConnection.incognito override fun featureEnabled(feature: ChatFeature) = contactConnection.featureEnabled(feature) override val timedMessagesTTL: Int? get() = contactConnection.timedMessagesTTL @@ -822,7 +821,7 @@ data class Contact( (ready && active && !(activeConn.connectionStats?.ratchetSyncSendProhibited ?: false)) || nextSendGrpInv val nextSendGrpInv get() = contactGroupMemberId != null && !contactGrpInvSent - override val ntfsEnabled get() = chatSettings.enableNtfs + override val ntfsEnabled get() = chatSettings.enableNtfs == MsgFilter.All override val incognito get() = contactConnIncognito override fun featureEnabled(feature: ChatFeature) = when (feature) { ChatFeature.TimedMessages -> mergedPreferences.timedMessages.enabled.forUser @@ -869,7 +868,7 @@ data class Contact( activeConn = Connection.sampleData, contactUsed = true, contactStatus = ContactStatus.Active, - chatSettings = ChatSettings(enableNtfs = true, sendRcpts = null, favorite = false), + chatSettings = ChatSettings(enableNtfs = MsgFilter.All, sendRcpts = null, favorite = false), userPreferences = ChatPreferences.sampleData, mergedPreferences = ContactUserPreferences.sampleData, createdAt = Clock.System.now(), @@ -1009,7 +1008,7 @@ data class GroupInfo ( override val apiId get() = groupId override val ready get() = membership.memberActive override val sendMsgEnabled get() = membership.memberActive - override val ntfsEnabled get() = chatSettings.enableNtfs + override val ntfsEnabled get() = chatSettings.enableNtfs == MsgFilter.All override val incognito get() = membership.memberIncognito override fun featureEnabled(feature: ChatFeature) = when (feature) { ChatFeature.TimedMessages -> fullGroupPreferences.timedMessages.on @@ -1041,7 +1040,7 @@ data class GroupInfo ( fullGroupPreferences = FullGroupPreferences.sampleData, membership = GroupMember.sampleData, hostConnCustomUserProfileId = null, - chatSettings = ChatSettings(enableNtfs = true, sendRcpts = null, favorite = false), + chatSettings = ChatSettings(enableNtfs = MsgFilter.All, sendRcpts = null, favorite = false), createdAt = Clock.System.now(), updatedAt = Clock.System.now() ) @@ -1073,6 +1072,7 @@ data class GroupMember ( var memberRole: GroupMemberRole, var memberCategory: GroupMemberCategory, var memberStatus: GroupMemberStatus, + var memberSettings: GroupMemberSettings, var invitedBy: InvitedBy, val localDisplayName: String, val memberProfile: LocalProfile, @@ -1140,6 +1140,7 @@ data class GroupMember ( memberRole = GroupMemberRole.Member, memberCategory = GroupMemberCategory.InviteeMember, memberStatus = GroupMemberStatus.MemComplete, + memberSettings = GroupMemberSettings(showMessages = true), invitedBy = InvitedBy.IBUser(), localDisplayName = "alice", memberProfile = LocalProfile.sampleData, @@ -1150,6 +1151,9 @@ data class GroupMember ( } } +@Serializable +data class GroupMemberSettings(val showMessages: Boolean) {} + @Serializable class GroupMemberRef( val groupMemberId: Long, @@ -1844,6 +1848,7 @@ enum class SndCIStatusProgress { @Serializable sealed class CIDeleted { @Serializable @SerialName("deleted") class Deleted(val deletedTs: Instant?): CIDeleted() + @Serializable @SerialName("blocked") class Blocked(val deletedTs: Instant?): CIDeleted() @Serializable @SerialName("moderated") class Moderated(val deletedTs: Instant?, val byGroupMember: GroupMember): CIDeleted() } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt index 43043d65fe..3644268ba3 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt @@ -2472,15 +2472,22 @@ data class KeepAliveOpts( @Serializable data class ChatSettings( - val enableNtfs: Boolean, + val enableNtfs: MsgFilter, val sendRcpts: Boolean?, val favorite: Boolean ) { companion object { - val defaults: ChatSettings = ChatSettings(enableNtfs = true, sendRcpts = null, favorite = false) + val defaults: ChatSettings = ChatSettings(enableNtfs = MsgFilter.All, sendRcpts = null, favorite = false) } } +@Serializable +enum class MsgFilter { + @SerialName("all") All, + @SerialName("none") None, + @SerialName("mentions") Mentions, +} + @Serializable data class UserMsgReceiptSettings(val enable: Boolean, val clearOverrides: Boolean) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt index 41c94f21d9..566c981811 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chatlist/ChatListNavLinkView.kt @@ -595,8 +595,8 @@ fun groupInvitationAcceptedAlert() { ) } -fun toggleNotifications(chat: Chat, enableNtfs: Boolean, chatModel: ChatModel, currentState: MutableState? = null) { - val chatSettings = (chat.chatInfo.chatSettings ?: ChatSettings.defaults).copy(enableNtfs = enableNtfs) +fun toggleNotifications(chat: Chat, enableAllNtfs: Boolean, chatModel: ChatModel, currentState: MutableState? = null) { + val chatSettings = (chat.chatInfo.chatSettings ?: ChatSettings.defaults).copy(enableNtfs = if (enableAllNtfs) MsgFilter.All else MsgFilter.None) updateChatSettings(chat, chatSettings, chatModel, currentState) } @@ -627,7 +627,7 @@ fun updateChatSettings(chat: Chat, chatSettings: ChatSettings, chatModel: ChatMo } if (res && newChatInfo != null) { chatModel.updateChatInfo(newChatInfo) - if (!chatSettings.enableNtfs) { + if (chatSettings.enableNtfs != MsgFilter.All) { ntfManager.cancelNotificationsForChat(chat.id) } val current = currentState?.value diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs index 8d596c9707..50d7005e34 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 c2ad7e7eb6..ccfc6a4848 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -28,7 +28,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 rh <- readTVarIO $ currentRemoteHost cc let cmdRH = rh -- response RemoteHost is the same as for the command itself r <- sendChatCmdStr cc chatCmd diff --git a/apps/simplex-chat/Server.hs b/apps/simplex-chat/Server.hs index d32005e573..3f4484eac6 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/package.yaml b/package.yaml index 861d0c494a..df2624ac83 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: simplex-chat -version: 5.4.0.0 +version: 5.4.0.1 #synopsis: #description: homepage: https://github.com/simplex-chat/simplex-chat#readme diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 4fc023bc3b..512f1427c9 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: simplex-chat -version: 5.4.0.0 +version: 5.4.0.1 category: Web, System, Services, Cryptography homepage: https://github.com/simplex-chat/simplex-chat#readme author: simplex.chat @@ -115,7 +115,9 @@ library Simplex.Chat.Migrations.M20230914_member_probes Simplex.Chat.Migrations.M20230926_contact_status Simplex.Chat.Migrations.M20231002_conn_initiated - Simplex.Chat.Migrations.M20231005_remote_controller + Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash + Simplex.Chat.Migrations.M20231010_member_settings + Simplex.Chat.Migrations.M20231020_remote_controller Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index fe4f9338db..618ed6f187 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -185,13 +185,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 currentRemoteHost <- newTVarIO Nothing servers <- agentServers config @@ -200,7 +198,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 @@ -218,7 +215,38 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg tempDirectory <- newTVarIO tempDir contactMergeEnabled <- newTVarIO True - pure ChatController {activeTo, firstTime, currentUser, currentRemoteHost, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, remoteHostSessions, remoteCtrlSession, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile, contactMergeEnabled} + pure + ChatController + { + firstTime, + currentUser, + currentRemoteHost, + smpAgent, + agentAsync, + chatStore, + chatStoreChanged, + idsDrg, + inputQ, + outputQ, + subscriptionMode, + chatLock, + sndFiles, + rcvFiles, + currentCalls, + remoteHostSessions, + remoteCtrlSession, + config, + filesFolder, + expireCIThreads, + expireCIFlags, + cleanupManagerAsync, + timedItemThreads, + showLiveItems, + userXFTPFileConfig, + tempDirectory, + logFilePath = logFile, + contactMergeEnabled + } where configServers :: DefaultAgentServers configServers = @@ -265,7 +293,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) @@ -389,7 +417,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 @@ -415,7 +442,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'' @@ -473,11 +499,11 @@ processChatCommand = \case DeleteUser uName delSMPQueues viewPwd_ -> withUserName uName $ \userId -> APIDeleteUser userId delSMPQueues viewPwd_ StartChat subConns enableExpireCIs startXFTPWorkers -> withUser' $ \_ -> asks agentAsync >>= readTVarIO >>= \case - Just _ -> pure $ CRChatRunning Nothing - _ -> checkStoreNotChanged $ startChatController subConns enableExpireCIs startXFTPWorkers $> CRChatStarted Nothing + Just _ -> pure CRChatRunning + _ -> checkStoreNotChanged $ startChatController subConns enableExpireCIs startXFTPWorkers $> CRChatStarted APIStopChat -> do ask >>= stopChatController - pure $ CRChatStopped Nothing + pure CRChatStopped APIActivateChat -> withUser $ \_ -> do restoreCalls withAgent foregroundAgent @@ -545,7 +571,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) @@ -559,7 +585,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) @@ -576,7 +602,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)) @@ -627,7 +652,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 @@ -642,7 +667,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)) @@ -747,7 +771,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 @@ -763,13 +787,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 @@ -786,7 +809,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 @@ -795,20 +817,19 @@ 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, CChatItem msgDir ci@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 (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete CTGroup -> do Group gInfo ms <- withStore $ \db -> getGroup db user chatId - ci@(CChatItem msgDir ChatItem {meta = CIMeta {itemSharedMsgId, editable}}) <- withStore $ \db -> getGroupChatItem db user chatId itemId + CChatItem msgDir ci@ChatItem {meta = CIMeta {itemSharedMsgId, editable}} <- withStore $ \db -> getGroupChatItem db user chatId itemId case (mode, msgDir, itemSharedMsgId, editable) of (CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime (CIDMBroadcast, SMDSnd, Just itemSharedMId, True) -> do @@ -820,7 +841,7 @@ processChatCommand = \case CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db user gId - ci@(CChatItem _ ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}}) <- withStore $ \db -> getGroupChatItem db user gId itemId + CChatItem _ ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}} <- withStore $ \db -> getGroupChatItem db user gId itemId case (chatDir, itemSharedMsgId) of (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do when (groupMemberId /= mId) $ throwChatError CEInvalidChatItemDelete @@ -911,11 +932,11 @@ 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 - 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 @@ -923,7 +944,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 @@ -1175,7 +1195,7 @@ processChatCommand = \case ct <- getContact db user chatId liftIO $ updateContactSettings db user chatId chatSettings pure ct - withAgent $ \a -> toggleConnectionNtfs a (contactConnId ct) (enableNtfs chatSettings) + withAgent $ \a -> toggleConnectionNtfs a (contactConnId ct) (chatHasNtfs chatSettings) ok user CTGroup -> do ms <- withStore $ \db -> do @@ -1183,9 +1203,17 @@ processChatCommand = \case liftIO $ updateGroupSettings db user chatId chatSettings pure ms forM_ (filter memberActive ms) $ \m -> forM_ (memberConnId m) $ \connId -> - withAgent (\a -> toggleConnectionNtfs a connId $ enableNtfs chatSettings) `catchChatError` (toView . CRChatError (Just user)) + withAgent (\a -> toggleConnectionNtfs a connId $ chatHasNtfs chatSettings) `catchChatError` (toView . CRChatError (Just user)) ok user _ -> pure $ chatCmdError (Just user) "not supported" + APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do + m <- withStore $ \db -> do + liftIO $ updateGroupMemberSettings db user gId gMemberId settings + getGroupMember db user gId gMemberId + when (memberActive m) $ forM_ (memberConnId m) $ \connId -> do + let ntfOn = showMessages $ memberSettings m + withAgent (\a -> toggleConnectionNtfs a connId ntfOn) `catchChatError` (toView . CRChatError (Just user)) + ok user APIContactInfo contactId -> withUser $ \user@User {userId} -> do -- [incognito] print user's incognito profile for this contact ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db user contactId @@ -1280,6 +1308,11 @@ processChatCommand = \case _ -> throwChatError CEGroupMemberNotActive SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn}) SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_}) + SetShowMemberMessages gName mName showMessages -> withUser $ \user -> do + (gId, mId) <- getGroupAndMemberId user gName mName + m <- withStore $ \db -> getGroupMember db user gId mId + let settings = (memberSettings m) {showMessages} + processChatCommand $ APISetMemberSettings gId mId settings ContactInfo cName -> withContactName cName APIContactInfo ShowGroupInfo gName -> withUser $ \user -> do groupId <- withStore $ \db -> getGroupIdByName db user gName @@ -1324,6 +1357,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 @@ -1336,11 +1371,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 -> @@ -1436,7 +1476,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 @@ -1704,11 +1744,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) @@ -1720,10 +1759,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 @@ -1949,19 +1988,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 @@ -2000,7 +2056,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') @@ -2059,9 +2115,8 @@ processChatCommand = \case when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined g) 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 :: MsgDirectionI d => User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Maybe GroupMember -> m ChatResponse + delGroupChatItem user gInfo ci msgId byGroupMember = do deletedTs <- liftIO getCurrentTime if groupFeatureAllowed SGFFullDelete gInfo then deleteGroupCI user gInfo ci True False byGroupMember deletedTs @@ -2071,10 +2126,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 @@ -2122,7 +2173,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) @@ -2172,7 +2222,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) @@ -2193,6 +2242,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 = @@ -2758,10 +2855,10 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do waitChatStarted case cType of CTDirect -> do - (ct, ci) <- withStoreCtx (Just "deleteTimedItem, getContact ...") $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId + (ct, CChatItem _ ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId deleteDirectCI user ct ci True True >>= toView CTGroup -> do - (gInfo, ci) <- withStoreCtx (Just "deleteTimedItem, getGroupInfo ...") $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId + (gInfo, CChatItem _ ci) <- withStore $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId deletedTs <- liftIO getCurrentTime deleteGroupCI user gInfo ci True True Nothing deletedTs >>= toView _ -> toView . CRChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType" @@ -2824,17 +2921,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" - SUSPENDED -> toView $ CRChatSuspended Nothing + 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 = @@ -2971,10 +3067,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 @@ -3041,7 +3134,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 $ \_ -> @@ -3126,9 +3219,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 @@ -3205,7 +3295,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 @@ -3287,7 +3377,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do updateGroupMemberStatus db userId membership GSMemConnected -- possible improvement: check for each pending message, requires keeping track of connection state unless (connDisabled conn) $ sendPendingGroupMessages user m conn - withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ enableNtfs chatSettings + withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings case memberCategory m of GCHostMember -> do toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} @@ -3295,15 +3385,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 -> @@ -3599,7 +3683,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 @@ -3614,10 +3698,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 () @@ -3708,13 +3789,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 @@ -3776,7 +3853,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 @@ -3789,23 +3866,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 @@ -3864,7 +3936,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 @@ -3876,7 +3948,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 @@ -3903,7 +3974,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do deleteRcvChatItem `catchCINotFound` (toView . CRChatItemDeletedNotFound user ct) where deleteRcvChatItem = do - ci@(CChatItem msgDir _) <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId + CChatItem msgDir ci <- withStore $ \db -> getDirectChatItemBySharedMsgId db user contactId sharedMsgId case msgDir of SMDRcv -> if featureAllowed SCFFullDelete forContact ct @@ -3963,7 +4034,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 @@ -3984,29 +4055,24 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do createItem timed_ live | groupFeatureAllowed SGFFullDelete gInfo = do ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta CIRcvModerated Nothing timed_ False - ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo (CChatItem SMDRcv ci) moderator moderatedAt - toView $ CRNewChatItem user ci' + ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt + toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci' | otherwise = do file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta (CIRcvMsgContent content) (snd <$> file_) timed_ False - cr <- markGroupCIDeleted user gInfo (CChatItem SMDRcv ci) createdByMsgId False (Just moderator) moderatedAt - toView cr + toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt createItem timed_ live = do file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m - ChatItem {formattedText} <- 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 (CIRcvMsgContent content) (snd <$> file_) timed_ live + when (showMessages $ memberSettings m) $ autoAcceptFile file_ newChatItem ciContent ciFile_ timed_ live = do ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ msgMeta ciContent ciFile_ timed_ live + ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_ - groupMsgToView gInfo m ci {reactions} msgMeta - pure ci + groupMsgToView gInfo m ci' {reactions} msgMeta 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). @@ -4015,9 +4081,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) msgMeta content Nothing timed_ live ci' <- withStore' $ \db -> do createChatItemVersion db (chatItemId' ci) brokerTs mc - updateGroupChatItem db user groupId ci content live Nothing + ci' <- updateGroupChatItem db user groupId ci content live Nothing + blockedMember m ci' $ markGroupChatItemBlocked db user gInfo ci' toView $ CRChatItemUpdated user (AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci') - setActive $ ActiveG g where MsgMeta {broker = (_, brokerTs)} = msgMeta content = CIRcvMsgContent mc @@ -4036,7 +4102,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" @@ -4046,7 +4111,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do groupMessageDelete gInfo@GroupInfo {groupId, membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} MsgMeta {broker = (_, brokerTs)} = do let msgMemberId = fromMaybe memberId sndMemberId_ withStore' (\db -> runExceptT $ getGroupMemberCIBySharedMsgId db user groupId msgMemberId sharedMsgId) >>= \case - Right ci@(CChatItem _ ChatItem {chatDir}) -> case chatDir of + Right (CChatItem _ ci@ChatItem {chatDir}) -> case chatDir of CIGroupRcv mem | sameMemberId memberId mem && msgMemberId == memberId -> delete ci Nothing >>= toView | otherwise -> deleteMsg mem ci @@ -4056,7 +4121,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do | senderRole < GRAdmin -> messageError $ "x.msg.del: message not found, message of another member with insufficient member permissions, " <> tshow e | otherwise -> withStore' $ \db -> createCIModeration db gInfo m msgMemberId sharedMsgId msgId brokerTs where - deleteMsg :: GroupMember -> CChatItem 'CTGroup -> m () + deleteMsg :: MsgDirectionI d => GroupMember -> ChatItem 'CTGroup d -> m () deleteMsg mem ci = case sndMemberId_ of Just sndMemberId | sameMemberId sndMemberId mem -> checkRole mem $ delete ci (Just m) >>= toView @@ -4066,13 +4131,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do | senderRole < GRAdmin || senderRole < memberRole = messageError "x.msg.del: message of another member with insufficient member permissions" | otherwise = a + delete :: MsgDirectionI d => ChatItem 'CTGroup d -> Maybe GroupMember -> m ChatResponse delete ci byGroupMember | groupFeatureAllowed SGFFullDelete gInfo = deleteGroupCI user gInfo ci False False byGroupMember brokerTs | otherwise = markGroupCIDeleted user gInfo ci msgId False byGroupMember brokerTs -- 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 @@ -4081,24 +4147,23 @@ 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 let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP 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 + ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci + groupMsgToView gInfo m ci' msgMeta + + blockedMember :: Monad m' => GroupMember -> ChatItem c d -> m' (ChatItem c d) -> m' (ChatItem c d) + blockedMember m ci blockedCI + | showMessages (memberSettings m) = pure ci + | otherwise = blockedCI receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> m (Maybe InlineFileMode) receiveInlineMode FileInvitation {fileSize, fileInline, fileDescr} mc_ chSize = case (fileInline, fileDescr) of @@ -4255,7 +4320,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) @@ -4268,6 +4333,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 @@ -4278,8 +4344,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' @@ -4618,7 +4682,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do toView $ CRJoinedGroupMemberConnecting user gInfo m newMember xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m () - xGrpMemIntro gInfo@GroupInfo {chatSettings = ChatSettings {enableNtfs}} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do + xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memberChatVRange _) = do case memberCategory m of GCHostMember -> do members <- withStore' $ \db -> getGroupMembers db user gInfo @@ -4638,7 +4702,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId subMode _ -> messageError "x.grp.mem.intro can be only sent by host member" where - createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv enableNtfs SCMInvitation subMode + createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> m () sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do @@ -4661,7 +4725,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do _ -> messageError "x.grp.mem.inv can be only sent by invitee member" xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> m () - xGrpMemFwd gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m memInfo@(MemberInfo memId memRole memberChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do + xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memberChatVRange _) introInv@IntroInvitation {groupConnReq, directConnReq} = do checkHostRole m memRole members <- withStore' $ \db -> getGroupMembers db user gInfo toMember <- case find (sameMemberId memId) members of @@ -4676,8 +4740,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- [incognito] send membership incognito profile, create direct connection as incognito dm <- directMessage $ XGrpMemInfo membership.memberId (fromLocalProfile $ memberProfile membership) -- [async agent commands] no continuation needed, but commands should be asynchronous for stability - groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode - directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr dm subMode + groupConnIds <- joinAgentConnectionAsync user (chatHasNtfs chatSettings) groupConnReq dm subMode + directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user True dcr dm subMode let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode @@ -5201,20 +5265,22 @@ mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs cur meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs currentTs currentTs pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file} -deleteDirectCI :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> Bool -> Bool -> m ChatResponse -deleteDirectCI user ct ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed = do +deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse +deleteDirectCI user ct ci@ChatItem {file} byUser timed = do deleteCIFile user file withStoreCtx' (Just "deleteDirectCI, deleteDirectChatItem") $ \db -> deleteDirectChatItem db user ct ci - pure $ CRChatItemDeleted user (AChatItem SCTDirect msgDir (DirectChat ct) deletedItem) Nothing byUser timed + pure $ CRChatItemDeleted user (AChatItem SCTDirect msgDirection (DirectChat ct) ci) Nothing byUser timed -deleteGroupCI :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse -deleteGroupCI user gInfo ci@(CChatItem msgDir deletedItem@ChatItem {file}) byUser timed byGroupMember_ deletedTs = do +deleteGroupCI :: (ChatMonad m, MsgDirectionI d) => User -> GroupInfo -> ChatItem 'CTGroup d -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse +deleteGroupCI user gInfo ci@ChatItem {file} byUser timed byGroupMember_ deletedTs = do deleteCIFile user file toCi <- withStoreCtx' (Just "deleteGroupCI, deleteGroupChatItem ...") $ \db -> case byGroupMember_ of Nothing -> deleteGroupChatItem db user gInfo ci $> Nothing Just m -> Just <$> updateGroupChatItemModerated db user gInfo ci m deletedTs - pure $ CRChatItemDeleted user (AChatItem SCTGroup msgDir (GroupChat gInfo) deletedItem) toCi byUser timed + pure $ CRChatItemDeleted user (gItem ci) (gItem <$> toCi) byUser timed + where + gItem = AChatItem SCTGroup msgDirection (GroupChat gInfo) deleteCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m () deleteCIFile user file_ = @@ -5222,25 +5288,21 @@ deleteCIFile user file_ = fileAgentConnIds <- deleteFile' user (mkCIFileInfo file) True deleteAgentConnectionsAsync user fileAgentConnIds -markDirectCIDeleted :: ChatMonad m => User -> Contact -> CChatItem 'CTDirect -> MessageId -> Bool -> UTCTime -> m ChatResponse -markDirectCIDeleted user ct@Contact {contactId} ci@(CChatItem _ ChatItem {file}) msgId byUser deletedTs = do +markDirectCIDeleted :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> MessageId -> Bool -> UTCTime -> m ChatResponse +markDirectCIDeleted user ct ci@ChatItem {file} msgId byUser deletedTs = do cancelCIFile user file - toCi <- withStore $ \db -> do - liftIO $ markDirectChatItemDeleted db user ct ci msgId deletedTs - getDirectChatItem db user contactId (cchatItemId ci) - pure $ CRChatItemDeleted user (ctItem ci) (Just $ ctItem toCi) byUser False + ci' <- withStore' $ \db -> markDirectChatItemDeleted db user ct ci msgId deletedTs + pure $ CRChatItemDeleted user (ctItem ci) (Just $ ctItem ci') byUser False where - ctItem (CChatItem msgDir ci') = AChatItem SCTDirect msgDir (DirectChat ct) ci' + ctItem = AChatItem SCTDirect msgDirection (DirectChat ct) -markGroupCIDeleted :: ChatMonad m => User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse -markGroupCIDeleted user gInfo@GroupInfo {groupId} ci@(CChatItem _ ChatItem {file}) msgId byUser byGroupMember_ deletedTs = do +markGroupCIDeleted :: (ChatMonad m, MsgDirectionI d) => User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse +markGroupCIDeleted user gInfo ci@ChatItem {file} msgId byUser byGroupMember_ deletedTs = do cancelCIFile user file - toCi <- withStore $ \db -> do - liftIO $ markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_ deletedTs - getGroupChatItem db user groupId (cchatItemId ci) - pure $ CRChatItemDeleted user (gItem ci) (Just $ gItem toCi) byUser False + ci' <- withStore' $ \db -> markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_ deletedTs + pure $ CRChatItemDeleted user (gItem ci) (Just $ gItem ci') byUser False where - gItem (CChatItem msgDir ci') = AChatItem SCTGroup msgDir (GroupChat gInfo) ci' + gItem = AChatItem SCTGroup msgDirection (GroupChat gInfo) cancelCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m () cancelCIFile user file_ = @@ -5426,30 +5488,6 @@ 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 - -whenContactNtfs :: ChatMonad' m => User -> Contact -> m () -> m () -whenContactNtfs user Contact {chatSettings} = whenUserNtfs user . when (enableNtfs chatSettings) - -whenGroupNtfs :: ChatMonad' m => User -> GroupInfo -> m () -> m () -whenGroupNtfs user GroupInfo {chatSettings} = whenUserNtfs user . when (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 - withUser' :: ChatMonad m => (User -> m ChatResponse) -> m ChatResponse withUser' action = asks currentUser @@ -5487,9 +5525,12 @@ withAgent action = chatCommandP :: Parser ChatCommand chatCommandP = choice - [ "/mute " *> ((`SetShowMessages` False) <$> chatNameP), - "/unmute " *> ((`SetShowMessages` True) <$> chatNameP), + [ "/mute " *> ((`SetShowMessages` MFNone) <$> chatNameP), + "/unmute " *> ((`SetShowMessages` MFAll) <$> chatNameP), + "/unmute mentions " *> ((`SetShowMessages` MFMentions) <$> chatNameP), "/receipts " *> (SetSendReceipts <$> chatNameP <* " " <*> ((Just <$> onOffP) <|> ("default" $> Nothing))), + "/block #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure False), + "/unblock #" *> (SetShowMemberMessages <$> displayName <* A.space <*> (char_ '@' *> displayName) <*> pure True), "/_create user " *> (CreateActiveUser <$> jsonP), "/create user " *> (CreateActiveUser <$> newUserP), "/users" $> ListUsers, @@ -5593,6 +5634,7 @@ chatCommandP = ("/network" <|> "/net") $> APIGetNetworkConfig, "/reconnect" $> ReconnectAllServers, "/_settings " *> (APISetChatSettings <$> chatRefP <* A.space <*> jsonP), + "/_member settings #" *> (APISetMemberSettings <$> A.decimal <* A.space <*> A.decimal <* A.space <*> jsonP), "/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal), "/_info #" *> (APIGroupInfo <$> A.decimal), "/_info @" *> (APIContactInfo <$> A.decimal), @@ -5667,6 +5709,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 6671ba7440..d224978d13 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -38,8 +38,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) @@ -159,21 +158,11 @@ 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), currentRemoteHost :: TVar (Maybe RemoteHostId), - activeTo :: TVar ActiveTo, firstTime :: Bool, smpAgent :: AgentClient, agentAsync :: TVar (Maybe (Async (), Maybe (Async ()))), @@ -182,8 +171,6 @@ data ChatController = ChatController idsDrg :: TVar ChaChaDRG, inputQ :: TBQueue String, outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse), - notifyQ :: TBQueue Notification, - sendNotification :: Notification -> IO (), subscriptionMode :: TVar SubscriptionMode, chatLock :: Lock, sndFiles :: TVar (Map Int64 Handle), @@ -313,6 +300,7 @@ data ChatCommand | APIGetNetworkConfig | ReconnectAllServers | APISetChatSettings ChatRef ChatSettings + | APISetMemberSettings GroupId GroupMemberId GroupMemberSettings | APIContactInfo ContactId | APIGroupInfo GroupId | APIGroupMemberInfo GroupId GroupMemberId @@ -328,8 +316,9 @@ data ChatCommand | APIVerifyGroupMember GroupId GroupMemberId (Maybe Text) | APIEnableContact ContactId | APIEnableGroupMember GroupId GroupMemberId - | SetShowMessages ChatName Bool + | SetShowMessages ChatName MsgFilter | SetSendReceipts ChatName (Maybe Bool) + | SetShowMemberMessages GroupName ContactName Bool | ContactInfo ContactName | ShowGroupInfo GroupName | GroupMemberInfo GroupName ContactName @@ -350,6 +339,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) @@ -473,14 +463,14 @@ allowRemoteCommand = \case data ChatResponse = CRActiveUser {user :: User} | CRUsersList {users :: [UserInfo]} - | CRChatStarted {_nullary :: Maybe Int} - | CRChatRunning {_nullary :: Maybe Int} - | CRChatStopped {_nullary :: Maybe Int} - | CRChatSuspended {_nullary :: Maybe Int} + | CRChatStarted + | CRChatRunning + | CRChatStopped + | CRChatSuspended | 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} @@ -537,6 +527,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} @@ -640,14 +631,14 @@ data ChatResponse | CRRemoteHostDeleted {remoteHostId :: RemoteHostId} | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]} | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId} - | CRRemoteCtrlStarted {_nullary :: Maybe Int} + | CRRemoteCtrlStarted | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrl} -- registered fingerprint, may connect | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId} | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId} | CRRemoteCtrlConnecting {remoteCtrlId :: RemoteCtrlId, displayName :: Text} | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text} - | CRRemoteCtrlStopped {_nullary :: Maybe Int} + | CRRemoteCtrlStopped | CRRemoteCtrlDeleted {remoteCtrlId :: RemoteCtrlId} | CRSQLResult {rows :: [Text]} | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]} @@ -732,6 +723,76 @@ data RemoteCtrlInfo = RemoteCtrlInfo instance ToJSON RemoteCtrlInfo where toEncoding = J.genericToEncoding J.defaultOptions +data ConnectionPlan + = CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan} + | CPContactAddress {contactAddressPlan :: ContactAddressPlan} + | CPGroupLink {groupLinkPlan :: GroupLinkPlan} + deriving (Show, Generic) + +instance FromJSON ConnectionPlan where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CP" + +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 FromJSON InvitationLinkPlan where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "ILP" + +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 FromJSON ContactAddressPlan where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CAP" + +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 FromJSON GroupLinkPlan where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "GLP" + +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) @@ -1013,6 +1074,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)} @@ -1173,8 +1235,7 @@ data RemoteCtrlSession = RemoteCtrlSession hostServer :: Maybe (Async ()), discovered :: TMap C.KeyHash TransportHost, accepted :: TMVar RemoteCtrlId, - remoteOutputQ :: TBQueue ChatResponse, - remoteNotifyQ :: TBQueue Notification + remoteOutputQ :: TBQueue ChatResponse } type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m) @@ -1212,14 +1273,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' - -- | Emit local events. toView :: ChatMonad' m => ChatResponse -> m () toView event = do diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 5f5a27e772..c5eb19f286 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 87bd8f4ef0..79496bb1f2 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, FromJSON) + +instance ToJSON ChatName where toEncoding = J.genericToEncoding J.defaultOptions chatTypeStr :: ChatType -> String chatTypeStr = \case @@ -170,6 +172,19 @@ instance (ChatTypeI c, MsgDirectionI d) => ToJSON (ChatItem c d) where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} +isMention :: ChatItem c d -> Bool +isMention ChatItem {chatDir, quotedItem} = case chatDir of + CIDirectRcv -> userItem quotedItem + CIGroupRcv _ -> userItem quotedItem + _ -> False + where + userItem = \case + Nothing -> False + Just CIQuote {chatDir = cd} -> case cd of + CIQDirectSnd -> True + CIQGroupSnd -> True + _ -> False + data CIDirection (c :: ChatType) (d :: MsgDirection) where CIDirectSnd :: CIDirection 'CTDirect 'MDSnd CIDirectRcv :: CIDirection 'CTDirect 'MDRcv @@ -271,26 +286,6 @@ ciReactionAllowed :: ChatItem c d -> Bool ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False ciReactionAllowed ChatItem {content} = isJust $ ciMsgContent content -data CIDeletedState = CIDeletedState - { markedDeleted :: Bool, - deletedByMember :: Maybe GroupMember - } - deriving (Show, Eq) - -chatItemDeletedState :: ChatItem c d -> Maybe CIDeletedState -chatItemDeletedState ChatItem {meta = CIMeta {itemDeleted}, content} = - ciDeletedToDeletedState <$> itemDeleted - where - ciDeletedToDeletedState cid = - case content of - CISndModerated -> CIDeletedState {markedDeleted = False, deletedByMember = byMember cid} - CIRcvModerated -> CIDeletedState {markedDeleted = False, deletedByMember = byMember cid} - _ -> CIDeletedState {markedDeleted = True, deletedByMember = byMember cid} - byMember :: CIDeleted c -> Maybe GroupMember - byMember = \case - CIModerated _ m -> Just m - CIDeleted _ -> Nothing - data ChatDirection (c :: ChatType) (d :: MsgDirection) where CDDirectSnd :: Contact -> ChatDirection 'CTDirect 'MDSnd CDDirectRcv :: Contact -> ChatDirection 'CTDirect 'MDRcv @@ -1012,7 +1007,7 @@ data MsgMetaJSON = MsgMetaJSON serverTs :: UTCTime, sndId :: Int64 } - deriving (Eq, Show, FromJSON, Generic) + deriving (Eq, Show, Generic, FromJSON) instance ToJSON MsgMetaJSON where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} @@ -1079,6 +1074,7 @@ msgDeliveryStatusT' s = data CIDeleted (c :: ChatType) where CIDeleted :: Maybe UTCTime -> CIDeleted c + CIBlocked :: Maybe UTCTime -> CIDeleted 'CTGroup CIModerated :: Maybe UTCTime -> GroupMember -> CIDeleted 'CTGroup deriving instance Show (CIDeleted c) @@ -1094,6 +1090,7 @@ instance ChatTypeI c => ToJSON (CIDeleted c) where data JSONCIDeleted = JCIDDeleted {deletedTs :: Maybe UTCTime, chatType :: ChatType} + | JCIBlocked {deletedTs :: Maybe UTCTime} | JCIDModerated {deletedTs :: Maybe UTCTime, byGroupMember :: GroupMember} deriving (Show, Generic) @@ -1107,16 +1104,19 @@ instance ToJSON JSONCIDeleted where jsonCIDeleted :: forall d. ChatTypeI d => CIDeleted d -> JSONCIDeleted jsonCIDeleted = \case CIDeleted ts -> JCIDDeleted ts (toChatType $ chatTypeI @d) + CIBlocked ts -> JCIBlocked ts CIModerated ts m -> JCIDModerated ts m jsonACIDeleted :: JSONCIDeleted -> ACIDeleted jsonACIDeleted = \case JCIDDeleted ts cType -> case aChatType cType of ACT c -> ACIDeleted c $ CIDeleted ts + JCIBlocked ts -> ACIDeleted SCTGroup $ CIBlocked ts JCIDModerated ts m -> ACIDeleted SCTGroup (CIModerated ts m) itemDeletedTs :: CIDeleted d -> Maybe UTCTime itemDeletedTs = \case CIDeleted ts -> ts + CIBlocked ts -> ts CIModerated ts _ -> ts data ChatItemInfo = ChatItemInfo diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index 8f9a453bde..7836e7232a 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -21,12 +21,8 @@ import Data.Int (Int64) import Data.Text (Text) import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Type.Equality -import Data.Typeable (Typeable) import Data.Word (Word32) -import Database.SQLite.Simple (ResultError (..), SQLData (..)) -import Database.SQLite.Simple.FromField (Field, FromField (..), returnError) -import Database.SQLite.Simple.Internal (Field (..)) -import Database.SQLite.Simple.Ok +import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) import GHC.Generics (Generic) import Simplex.Chat.Protocol @@ -52,14 +48,6 @@ instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgD instance ToField MsgDirection where toField = toField . msgDirectionInt -fromIntField_ :: Typeable a => (Int64 -> Maybe a) -> Field -> Ok a -fromIntField_ fromInt = \case - f@(Field (SQLInteger i) _) -> - case fromInt i of - Just x -> Ok x - _ -> returnError ConversionFailed f ("invalid integer: " <> show i) - f -> returnError ConversionFailed f "expecting SQLInteger column type" - data SMsgDirection (d :: MsgDirection) where SMDRcv :: SMsgDirection 'MDRcv SMDSnd :: SMsgDirection 'MDSnd @@ -524,8 +512,8 @@ data JSONCIContent | JCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} | JCIRcvChatFeatureRejected {feature :: ChatFeature} | JCIRcvGroupFeatureRejected {groupFeature :: GroupFeature} - | JCISndModerated {_nullary :: Maybe Int} - | JCIRcvModerated {_nullary :: Maybe Int} + | JCISndModerated + | JCIRcvModerated | JCIInvalidJSON {direction :: MsgDirection, json :: Text} jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent @@ -553,8 +541,8 @@ jsonCIContent = \case CISndGroupFeature groupFeature preference param -> JCISndGroupFeature {groupFeature, preference, param} CIRcvChatFeatureRejected feature -> JCIRcvChatFeatureRejected {feature} CIRcvGroupFeatureRejected groupFeature -> JCIRcvGroupFeatureRejected {groupFeature} - CISndModerated -> JCISndModerated Nothing - CIRcvModerated -> JCISndModerated Nothing + CISndModerated -> JCISndModerated + CIRcvModerated -> JCISndModerated CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json aciContentJSON :: JSONCIContent -> ACIContent @@ -582,8 +570,8 @@ aciContentJSON = \case JCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param JCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature JCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature - JCISndModerated _ -> ACIContent SMDSnd CISndModerated - JCIRcvModerated _ -> ACIContent SMDRcv CIRcvModerated + JCISndModerated -> ACIContent SMDSnd CISndModerated + JCIRcvModerated -> ACIContent SMDRcv CIRcvModerated JCIInvalidJSON dir json -> case fromMsgDirection dir of AMsgDirection d -> ACIContent d $ CIInvalidJSON json @@ -612,8 +600,8 @@ data DBJSONCIContent | DBJCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} | DBJCIRcvChatFeatureRejected {feature :: ChatFeature} | DBJCIRcvGroupFeatureRejected {groupFeature :: GroupFeature} - | DBJCISndModerated {_nullary :: Maybe Int} - | DBJCIRcvModerated {_nullary :: Maybe Int} + | DBJCISndModerated + | DBJCIRcvModerated | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text} dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent @@ -641,8 +629,8 @@ dbJsonCIContent = \case CISndGroupFeature groupFeature preference param -> DBJCISndGroupFeature {groupFeature, preference, param} CIRcvChatFeatureRejected feature -> DBJCIRcvChatFeatureRejected {feature} CIRcvGroupFeatureRejected groupFeature -> DBJCIRcvGroupFeatureRejected {groupFeature} - CISndModerated -> DBJCISndModerated Nothing - CIRcvModerated -> DBJCIRcvModerated Nothing + CISndModerated -> DBJCISndModerated + CIRcvModerated -> DBJCIRcvModerated CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json aciContentDBJSON :: DBJSONCIContent -> ACIContent @@ -670,8 +658,8 @@ aciContentDBJSON = \case DBJCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param DBJCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature DBJCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature - DBJCISndModerated _ -> ACIContent SMDSnd CISndModerated - DBJCIRcvModerated _ -> ACIContent SMDRcv CIRcvModerated + DBJCISndModerated -> ACIContent SMDSnd CISndModerated + DBJCIRcvModerated -> ACIContent SMDRcv CIRcvModerated DBJCIInvalidJSON dir json -> case fromMsgDirection dir of AMsgDirection d -> ACIContent d $ CIInvalidJSON json 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/M20231010_member_settings.hs b/src/Simplex/Chat/Migrations/M20231010_member_settings.hs new file mode 100644 index 0000000000..e31203e572 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20231010_member_settings.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20231010_member_settings where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20231010_member_settings :: Query +m20231010_member_settings = + [sql| +ALTER TABLE group_members ADD COLUMN show_messages INTEGER NOT NULL DEFAULT 1; +|] + +down_m20231010_member_settings :: Query +down_m20231010_member_settings = + [sql| +ALTER TABLE group_members DROP COLUMN show_messages; +|] diff --git a/src/Simplex/Chat/Migrations/M20231005_remote_controller.hs b/src/Simplex/Chat/Migrations/M20231020_remote_controller.hs similarity index 84% rename from src/Simplex/Chat/Migrations/M20231005_remote_controller.hs rename to src/Simplex/Chat/Migrations/M20231020_remote_controller.hs index 0cb8634999..a54e45cf58 100644 --- a/src/Simplex/Chat/Migrations/M20231005_remote_controller.hs +++ b/src/Simplex/Chat/Migrations/M20231020_remote_controller.hs @@ -1,12 +1,12 @@ {-# LANGUAGE QuasiQuotes #-} -module Simplex.Chat.Migrations.M20231005_remote_controller where +module Simplex.Chat.Migrations.M20231020_remote_controller where import Database.SQLite.Simple (Query) import Database.SQLite.Simple.QQ (sql) -m20231005_remote_controller :: Query -m20231005_remote_controller = +m20231020_remote_controller :: Query +m20231020_remote_controller = [sql| CREATE TABLE remote_hosts ( -- hosts known to a controlling app remote_host_id INTEGER PRIMARY KEY AUTOINCREMENT, @@ -25,8 +25,8 @@ CREATE TABLE remote_controllers ( -- controllers known to a hosting app ); |] -down_m20231005_remote_controller :: Query -down_m20231005_remote_controller = +down_m20231020_remote_controller :: Query +down_m20231020_remote_controller = [sql| DROP TABLE remote_hosts; DROP TABLE remote_controllers; diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index c4f96e2513..09ff4b628f 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 @@ -144,6 +145,7 @@ CREATE TABLE group_members( created_at TEXT CHECK(created_at NOT NULL), updated_at TEXT CHECK(updated_at NOT NULL), member_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL, + show_messages INTEGER NOT NULL DEFAULT 1, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -752,3 +754,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/Mobile.hs b/src/Simplex/Chat/Mobile.hs index d388ddbea0..aebd622c55 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -209,7 +209,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/Protocol.hs b/src/Simplex/Chat/Protocol.hs index cb937441f9..50d58b2a48 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -381,6 +381,11 @@ mcExtMsgContent = \case MCQuote _ c -> c MCForward c -> c +isQuote :: MsgContainer -> Bool +isQuote = \case + MCQuote {} -> True + _ -> False + data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent} deriving (Eq, Show, Generic) diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index b81ba33cda..96d15ee8ae 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -280,9 +280,9 @@ storeRemoteFile http localFile = do notOk -> Nothing <$ logError ("Bad response status: " <> tshow notOk) where uri = "/store?" <> HTTP.renderSimpleQuery False [("file_name", utf8String $ takeFileName localFile)] - putFile timeout c path hs file = liftIO $ do + putFile timeout' c path hs file = liftIO $ do fileSize <- fromIntegral <$> getFileSize file - HTTP2.sendRequestDirect c (req fileSize) timeout + HTTP2.sendRequestDirect c (req fileSize) timeout' where req size = HTTP2Client.requestFile "PUT" path hs (HTTP2Client.FileSpec file 0 size) @@ -388,7 +388,6 @@ startRemoteCtrl execChatCommand = Nothing -> do size <- asks $ tbqSize . config remoteOutputQ <- newTBQueueIO size - remoteNotifyQ <- newTBQueueIO size discovered <- newTVarIO mempty discoverer <- async $ discoverRemoteCtrls discovered accepted <- newEmptyTMVarIO @@ -403,9 +402,9 @@ startRemoteCtrl execChatCommand = toView $ CRRemoteCtrlConnected {remoteCtrlId, displayName} _ <- waitCatch server chatWriteVar remoteCtrlSession Nothing - toView $ CRRemoteCtrlStopped Nothing - chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ, remoteNotifyQ} - pure $ CRRemoteCtrlStarted Nothing + toView CRRemoteCtrlStopped + chatWriteVar remoteCtrlSession $ Just RemoteCtrlSession {discoverer, supervisor, hostServer = Nothing, discovered, accepted, remoteOutputQ} + pure CRRemoteCtrlStarted discoverRemoteCtrls :: (ChatMonad m) => TM.TMap C.KeyHash TransportHost -> m () discoverRemoteCtrls discovered = Discovery.withListener go @@ -477,7 +476,7 @@ stopRemoteCtrl = Just rcs -> do cancelRemoteCtrlSession rcs $ do chatWriteVar remoteCtrlSession Nothing - toView $ CRRemoteCtrlStopped Nothing + toView CRRemoteCtrlStopped pure $ CRCmdOk Nothing cancelRemoteCtrlSession_ :: (MonadUnliftIO m) => RemoteCtrlSession -> m () diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index 383db3c59c..3ef77cbb65 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) @@ -78,10 +79,10 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0 |] (userId, contactId) - toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact + toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" @@ -96,11 +97,11 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, - mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, + mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, -- GroupInfo {membership = GroupMember {memberProfile}} pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, -- from GroupMember - m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) @@ -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..30e45a82dc 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, @@ -89,6 +92,7 @@ module Simplex.Chat.Store.Groups associateContactWithMemberRecord, deleteOldProbes, updateGroupSettings, + updateGroupMemberSettings, getXGrpMemIntroContDirect, getXGrpMemIntroContGroup, getHostConnId, @@ -128,30 +132,31 @@ import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>)) import Simplex.Messaging.Version import UnliftIO.STM -type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow +type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow -type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) +type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) -type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences)) +type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences)) toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) = let membership = toGroupMember userContactId userMemberRow - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs} toGroupMember :: Int64 -> GroupMemberRow -> GroupMember -toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) = +toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) = let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} + memberSettings = GroupMemberSettings {showMessages} invitedBy = toInvitedBy userContactId invitedById activeConn = Nothing in GroupMember {..} toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember -toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) = - Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences)) +toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) = + Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences)) toMaybeGroupMember _ _ = Nothing createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO () @@ -247,11 +252,11 @@ getGroupAndMember db User {userId, userContactId} groupMemberId = g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, - mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, + mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, -- GroupInfo {membership = GroupMember {memberProfile}} pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, -- from GroupMember - m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, 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, @@ -297,7 +302,7 @@ createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do insertedRowId db memberId <- liftIO $ encodedRandomBytes gVar 12 membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs - let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False} + let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs} -- | creates a new group record for the group the current user was invited to, or returns an existing one @@ -342,7 +347,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo insertedRowId db GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs - let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False} + let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId) getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId @@ -366,6 +371,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me memberRole, memberCategory, memberStatus, + memberSettings = defaultMemberSettings, invitedBy, localDisplayName, memberProfile, @@ -405,6 +411,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 @@ -479,7 +496,7 @@ getUserGroupDetails db User {userId, userContactId} _contactId_ search_ = db [sql| SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, - mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, + mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences FROM groups g JOIN group_profiles gp USING (group_profile_id) @@ -544,7 +561,7 @@ groupMemberQuery :: Query groupMemberQuery = [sql| SELECT - m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, 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, @@ -651,6 +668,7 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con memberRole, memberCategory = GCInviteeMember, memberStatus = GSMemInvited, + memberSettings = defaultMemberSettings, invitedBy = IBUser, localDisplayName, memberProfile = profile, @@ -801,7 +819,8 @@ createNewMember_ |] (groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt) groupMemberId <- insertedRowId db - pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn} + let memberSettings = defaultMemberSettings + pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, memberSettings, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn} checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId) checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} = @@ -999,11 +1018,11 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} = g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupInfo {membership} mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, - mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, + mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, -- GroupInfo {membership = GroupMember {memberProfile}} pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, -- via GroupMember - m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, 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, @@ -1092,7 +1111,7 @@ getGroupInfo db User {userId, userContactId} groupId = g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, - mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, + mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences FROM groups g JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id @@ -1102,6 +1121,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) $ @@ -1459,6 +1507,18 @@ updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO () updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} = DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId) +updateGroupMemberSettings :: DB.Connection -> User -> GroupId -> GroupMemberId -> GroupMemberSettings -> IO () +updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {showMessages} = do + currentTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE group_members + SET show_messages = ?, updated_at = ? + WHERE user_id = ? AND group_id = ? AND group_member_id = ? + |] + (showMessages, currentTs, userId, gId, gMemberId) + getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont)) getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do fmap join . maybeFirstRow toCont $ diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 9ad0e8edc8..1c317f235b 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -50,6 +51,7 @@ module Simplex.Chat.Store.Messages deleteGroupChatItem, updateGroupChatItemModerated, markGroupChatItemDeleted, + markGroupChatItemBlocked, updateDirectChatItemsRead, getDirectUnreadTimedItems, setDirectChatItemDeleteAt, @@ -438,7 +440,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe SELECT i.chat_item_id, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, - m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, + m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) @@ -548,7 +550,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts, -- GroupMember - membership mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, - mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, + mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences, -- ChatStats COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat, @@ -558,17 +560,17 @@ getGroupChatPreviews_ db User {userId, userContactId} = do f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, -- Maybe GroupMember - sender m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, - m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, + m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, -- quoted ChatItem ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, - rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, + rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences, -- deleted by GroupMember dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category, - dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, + dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences FROM groups g JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id @@ -962,9 +964,9 @@ type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool) -type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId) :. (Bool, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow +type ChatItemRow = (Int64, ChatItemTs, AMsgDirection, Text, Text, ACIStatus, Maybe SharedMsgId) :. (Int, Maybe UTCTime, Maybe Bool, UTCTime, UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow -type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe AMsgDirection, Maybe Text, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId) :. (Maybe Bool, Maybe UTCTime, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow +type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe AMsgDirection, Maybe Text, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId) :. (Maybe Int, Maybe UTCTime, Maybe Bool, Maybe UTCTime, Maybe UTCTime) :. ChatItemModeRow :. MaybeCIFIleRow type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool) @@ -1007,7 +1009,9 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d ciMeta content status = - let itemDeleted' = if itemDeleted then Just (CIDeleted @'CTDirect deletedTs) else Nothing + let itemDeleted' = case itemDeleted of + DBCINotDeleted -> Nothing + _ -> Just (CIDeleted @'CTDirect deletedTs) itemEdited' = fromMaybe False itemEdited in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt ciTimed :: Maybe CITimed @@ -1063,10 +1067,10 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTGroup d ciMeta content status = - let itemDeleted' = - if itemDeleted - then Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_) - else Nothing + let itemDeleted' = case itemDeleted of + DBCINotDeleted -> Nothing + DBCIBlocked -> Just (CIBlocked deletedTs) + _ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_) itemEdited' = fromMaybe False itemEdited in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt ciTimed :: Maybe CITimed @@ -1225,8 +1229,8 @@ createChatItemVersion db itemId itemVersionTs msgContent = |] (itemId, toMCText msgContent, itemVersionTs) -deleteDirectChatItem :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> IO () -deleteDirectChatItem db User {userId} Contact {contactId} (CChatItem _ ci) = do +deleteDirectChatItem :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect d -> IO () +deleteDirectChatItem db User {userId} Contact {contactId} ci = do let itemId = chatItemId' ci deleteChatItemMessages_ db itemId deleteChatItemVersions_ db itemId @@ -1257,8 +1261,8 @@ deleteChatItemVersions_ :: DB.Connection -> ChatItemId -> IO () deleteChatItemVersions_ db itemId = DB.execute db "DELETE FROM chat_item_versions WHERE chat_item_id = ?" (Only itemId) -markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> MessageId -> UTCTime -> IO () -markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci) msgId deletedTs = do +markDirectChatItemDeleted :: DB.Connection -> User -> Contact -> ChatItem 'CTDirect d -> MessageId -> UTCTime -> IO (ChatItem 'CTDirect d) +markDirectChatItemDeleted db User {userId} Contact {contactId} ci@ChatItem {meta} msgId deletedTs = do currentTs <- liftIO getCurrentTime let itemId = chatItemId' ci insertChatItemMessage_ db itemId msgId currentTs @@ -1266,10 +1270,11 @@ markDirectChatItemDeleted db User {userId} Contact {contactId} (CChatItem _ ci) db [sql| UPDATE chat_items - SET item_deleted = 1, item_deleted_ts = ?, updated_at = ? + SET item_deleted = ?, item_deleted_ts = ?, updated_at = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ? |] - (deletedTs, currentTs, userId, contactId, itemId) + (DBCIDeleted, deletedTs, currentTs, userId, contactId, itemId) + pure ci {meta = meta {itemDeleted = Just $ CIDeleted $ Just deletedTs}} getDirectChatItemBySharedMsgId :: DB.Connection -> User -> ContactId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTDirect) getDirectChatItemBySharedMsgId db user@User {userId} contactId sharedMsgId = do @@ -1380,8 +1385,8 @@ updateGroupChatItem_ db User {userId} groupId ChatItem {content, meta} msgId_ = ((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, itemLive, updatedAt) :. ciTimedRow itemTimed :. (userId, groupId, itemId)) forM_ msgId_ $ \msgId -> insertChatItemMessage_ db itemId msgId updatedAt -deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> IO () -deleteGroupChatItem db User {userId} g@GroupInfo {groupId} (CChatItem _ ci) = do +deleteGroupChatItem :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> IO () +deleteGroupChatItem db User {userId} g@GroupInfo {groupId} ci = do let itemId = chatItemId' ci deleteChatItemMessages_ db itemId deleteChatItemVersions_ db itemId @@ -1394,10 +1399,10 @@ deleteGroupChatItem db User {userId} g@GroupInfo {groupId} (CChatItem _ ci) = do |] (userId, groupId, itemId) -updateGroupChatItemModerated :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> GroupMember -> UTCTime -> IO AChatItem -updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatItem msgDir ci) m@GroupMember {groupMemberId} deletedTs = do +updateGroupChatItemModerated :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> GroupMember -> UTCTime -> IO (ChatItem 'CTGroup d) +updateGroupChatItemModerated db User {userId} GroupInfo {groupId} ci m@GroupMember {groupMemberId} deletedTs = do currentTs <- getCurrentTime - let toContent = msgDirToModeratedContent_ msgDir + let toContent = msgDirToModeratedContent_ $ msgDirection @d toText = ciModeratedText itemId = chatItemId' ci deleteChatItemMessages_ db itemId @@ -1411,24 +1416,47 @@ updateGroupChatItemModerated db User {userId} gInfo@GroupInfo {groupId} (CChatIt WHERE user_id = ? AND group_id = ? AND chat_item_id = ? |] (deletedTs, groupMemberId, toContent, toText, currentTs, userId, groupId, itemId) - pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) (ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just currentTs) m), editable = False}, formattedText = Nothing}) + pure $ ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just currentTs) m), editable = False}, formattedText = Nothing} -markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> MessageId -> Maybe GroupMember -> UTCTime -> IO () -markGroupChatItemDeleted db User {userId} GroupInfo {groupId} (CChatItem _ ci) msgId byGroupMember_ deletedTs = do +pattern DBCINotDeleted :: Int +pattern DBCINotDeleted = 0 + +pattern DBCIDeleted :: Int +pattern DBCIDeleted = 1 + +pattern DBCIBlocked :: Int +pattern DBCIBlocked = 2 + +markGroupChatItemDeleted :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Maybe GroupMember -> UTCTime -> IO (ChatItem 'CTGroup d) +markGroupChatItemDeleted db User {userId} GroupInfo {groupId} ci@ChatItem {meta} msgId byGroupMember_ deletedTs = do currentTs <- liftIO getCurrentTime let itemId = chatItemId' ci - deletedByGroupMemberId = case byGroupMember_ of - Just GroupMember {groupMemberId} -> Just groupMemberId - _ -> Nothing + (deletedByGroupMemberId, itemDeleted) = case byGroupMember_ of + Just m@GroupMember {groupMemberId} -> (Just groupMemberId, Just $ CIModerated (Just deletedTs) m) + _ -> (Nothing, Just $ CIDeleted @'CTGroup (Just deletedTs)) insertChatItemMessage_ db itemId msgId currentTs DB.execute db [sql| UPDATE chat_items - SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ? + SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ? |] - (deletedTs, deletedByGroupMemberId, currentTs, userId, groupId, itemId) + (DBCIDeleted, deletedTs, deletedByGroupMemberId, currentTs, userId, groupId, itemId) + pure ci {meta = meta {itemDeleted}} + +markGroupChatItemBlocked :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv) +markGroupChatItemBlocked db User {userId} GroupInfo {groupId} ci@ChatItem {meta} = do + deletedTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE chat_items + SET item_deleted = ?, item_deleted_ts = ?, updated_at = ? + WHERE user_id = ? AND group_id = ? AND chat_item_id = ? + |] + (DBCIBlocked, deletedTs, deletedTs, userId, groupId, chatItemId' ci) + pure ci {meta = meta {itemDeleted = Just $ CIBlocked $ Just deletedTs}} getGroupChatItemBySharedMsgId :: DB.Connection -> User -> GroupId -> GroupMemberId -> SharedMsgId -> ExceptT StoreError IO (CChatItem 'CTGroup) getGroupChatItemBySharedMsgId db user@User {userId} groupId groupMemberId sharedMsgId = do @@ -1486,17 +1514,17 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, - m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, + m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences, -- quoted ChatItem ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, - rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, + rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id, rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences, -- deleted by GroupMember dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category, - dbm.member_status, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, + dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences FROM chat_items i LEFT JOIN files f ON f.chat_item_id = i.chat_item_id diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 16bfff9fcf..176dc4cbf1 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -83,7 +83,9 @@ 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.M20231005_remote_controller +import Simplex.Chat.Migrations.M20231009_via_group_link_uri_hash +import Simplex.Chat.Migrations.M20231010_member_settings +import Simplex.Chat.Migrations.M20231020_remote_controller import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -167,7 +169,9 @@ schemaMigrations = ("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), - ("20231005_remote_controller", m20231005_remote_controller, Just down_m20231005_remote_controller) + ("20231009_via_group_link_uri_hash", m20231009_via_group_link_uri_hash, Just down_m20231009_via_group_link_uri_hash), + ("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings), + ("20231020_remote_controller", m20231020_remote_controller, Just down_m20231020_remote_controller) ] -- | 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 583de1b9c2..70c8fbc211 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -43,6 +43,7 @@ module Simplex.Chat.Store.Profiles deleteUserAddress, getUserAddress, getUserContactLinkById, + getUserContactLinkByConnReq, updateUserAddressAutoAccept, getProtocolServers, overwriteProtocolServers, @@ -441,6 +442,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/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index fc3da74923..fabe5b9962 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -244,20 +244,20 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId = |] [":user_id" := userId, ":profile_id" := profileId] -type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool) +type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool) toContact :: User -> ContactRow :. ConnectionRow -> Contact toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} activeConn = toConnection connRow - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} - chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite} + chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} in case toMaybeConnection connRow of Just activeConn -> let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn 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 4a73a0fd72..090f06c7b3 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -58,14 +58,26 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do cmd = parseChatCommand bs unless (isMessage cmd) $ echo s r <- runReaderT (execChatCommand rh 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 rh 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 @@ -135,7 +147,7 @@ runTerminalInput ct cc = withChatTerm ct $ do receiveFromTTY cc ct receiveFromTTY :: forall m. MonadTerminal m => ChatController -> ChatTerminal -> m () -receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState} = +receiveFromTTY cc@ChatController {inputQ, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} = forever $ getKey >>= liftIO . processKey >> withTermLock ct (updateInput ct) where processKey :: (Key, Modifiers) -> IO () @@ -154,11 +166,11 @@ receiveFromTTY cc@ChatController {inputQ, activeTo, currentUser, currentRemoteHo 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 () @@ -205,8 +217,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 @@ -328,17 +340,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 e6792129cb..98d4285a2e 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,14 +15,25 @@ 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.Controller -import Simplex.Chat.Messages hiding (NewChatItem (..)) -import Simplex.Chat.Styled -import Simplex.Chat.View +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.Remote.Types (RemoteHostId) +import Simplex.Chat.Styled +import Simplex.Chat.Terminal.Notification (Notification (..), initializeNotifications) +import Simplex.Chat.Types +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) @@ -35,7 +47,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 @@ -80,16 +94,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 = @@ -115,24 +141,119 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} = d forever $ do (_, outputRH, r) <- atomically $ readTBQueue outputQ case r of - CRNewChatItem _ ci -> markChatItemRead ci - CRChatItemUpdated _ ci -> markChatItemRead ci + CRNewChatItem u ci -> markChatItemRead u ci + CRChatItemUpdated u ci -> markChatItemRead u ci _ -> pure () let printResp = case logFilePath of Just path -> if logResponseToFile r then logResponse path else printToTerminal ct _ -> printToTerminal ct liveItems <- readTVarIO showLiveItems responseString cc liveItems outputRH r >>= printResp + responseNotification ct cc r where - markChatItemRead (AChatItem _ _ chat item@ChatItem {chatDir, meta = CIMeta {itemStatus}}) = - case (muted chat chatDir, itemStatus) of - (False, CISRcvNew) -> do - let itemId = chatItemId' item + markChatItemRead u (AChatItem _ _ chat ci@ChatItem {chatDir, meta = CIMeta {itemStatus}}) = + case (chatDirNtf u chat chatDir (isMention ci), itemStatus) of + (True, CISRcvNew) -> do + let itemId = chatItemId' ci chatRef = chatInfoToRef chat void $ runReaderT (runExceptT $ processChatCommand (APIChatRead chatRef (Just (itemId, itemId)))) cc _ -> 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 ci@ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) -> + when (chatDirNtf u cInfo chatDir $ isMention ci) $ 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 ci@ChatItem {chatDir, content = CIRcvMsgContent _}) -> + whenCurrUser cc u $ when (chatDirNtf u cInfo chatDir $ isMention ci) $ setActiveChat t cInfo + CRContactConnected u ct _ -> when (contactNtf u ct False) $ 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 False) $ 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 False) $ + sendNtf ("#" <> viewGroupName g <> " " <> viewContactName ct <> "> ", "invited you to join the group") + CRUserJoinedGroup u g _ -> when (groupNtf u g False) $ do + whenCurrUser cc u $ setActiveGroup t g + sendNtf ("#" <> viewGroupName g, "you are connected to group") + CRJoinedGroupMember u g m -> + when (groupNtf u g False) $ sendNtf ("#" <> viewGroupName g, "member " <> viewMemberName m <> " is connected") + CRConnectedToGroupMember u g m _ -> + when (groupNtf u g False) $ 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 -> Maybe RemoteHostId -> ChatResponse -> IO () printRespToTerminal ct cc liveItems outputRH r = responseString cc liveItems outputRH r >>= printToTerminal ct diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 7c96b98b78..5e861abb07 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -39,7 +39,11 @@ import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime) -import Database.SQLite.Simple.FromField (FromField (..)) +import Data.Typeable (Typeable) +import Database.SQLite.Simple (ResultError (..), SQLData (..)) +import Database.SQLite.Simple.FromField (returnError, FromField(..)) +import Database.SQLite.Simple.Internal (Field (..)) +import Database.SQLite.Simple.Ok import Database.SQLite.Simple.ToField (ToField (..)) import GHC.Generics (Generic) import Simplex.Chat.Types.Preferences @@ -48,7 +52,7 @@ import Simplex.FileTransfer.Description (FileDigest) import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId) import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON) +import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON, taggedObjectJSON, enumJSON) import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI) import Simplex.Messaging.Util ((<$?>)) import Simplex.Messaging.Version @@ -194,6 +198,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 @@ -369,7 +376,7 @@ contactAndGroupIds = \case -- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties) data ChatSettings = ChatSettings - { enableNtfs :: Bool, + { enableNtfs :: MsgFilter, sendRcpts :: Maybe Bool, favorite :: Bool } @@ -380,13 +387,48 @@ instance ToJSON ChatSettings where toEncoding = J.genericToEncoding J.defaultOpt defaultChatSettings :: ChatSettings defaultChatSettings = ChatSettings - { enableNtfs = True, + { enableNtfs = MFAll, sendRcpts = Nothing, favorite = False } -pattern DisableNtfs :: ChatSettings -pattern DisableNtfs <- ChatSettings {enableNtfs = False} +chatHasNtfs :: ChatSettings -> Bool +chatHasNtfs ChatSettings {enableNtfs} = enableNtfs /= MFNone + +data MsgFilter = MFNone | MFAll | MFMentions + deriving (Eq, Show, Generic) + +instance FromJSON MsgFilter where + parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MF" + +instance ToJSON MsgFilter where + toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MF" + toJSON = J.genericToJSON . enumJSON $ dropPrefix "MF" + +instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP + +instance ToField MsgFilter where toField = toField . msgFilterInt + +msgFilterInt :: MsgFilter -> Int +msgFilterInt = \case + MFNone -> 0 + MFAll -> 1 + MFMentions -> 2 + +msgFilterIntP :: Int64 -> Maybe MsgFilter +msgFilterIntP = \case + 0 -> Just MFNone + 1 -> Just MFAll + 2 -> Just MFMentions + _ -> Just MFAll + +fromIntField_ :: Typeable a => (Int64 -> Maybe a) -> Field -> Ok a +fromIntField_ fromInt = \case + f@(Field (SQLInteger i) _) -> + case fromInt i of + Just x -> Ok x + _ -> returnError ConversionFailed f ("invalid integer: " <> show i) + f -> returnError ConversionFailed f "expecting SQLInteger column type" featureAllowed :: SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool featureAllowed feature forWhom Contact {mergedPreferences} = @@ -614,6 +656,7 @@ data GroupMember = GroupMember memberRole :: GroupMemberRole, memberCategory :: GroupMemberCategory, memberStatus :: GroupMemberStatus, + memberSettings :: GroupMemberSettings, invitedBy :: InvitedBy, localDisplayName :: ContactName, -- for membership, memberProfile can be either user's profile or incognito profile, based on memberIncognito test. @@ -751,6 +794,16 @@ instance ToJSON GroupMemberRole where toJSON = strToJSON toEncoding = strToJEncoding +data GroupMemberSettings = GroupMemberSettings + { showMessages :: Bool + } + deriving (Eq, Show, Generic, FromJSON) + +instance ToJSON GroupMemberSettings where toEncoding = J.genericToEncoding J.defaultOptions + +defaultMemberSettings :: GroupMemberSettings +defaultMemberSettings = GroupMemberSettings {showMessages = True} + newtype Probe = Probe {unProbe :: ByteString} deriving (Eq, Show) @@ -1261,6 +1314,9 @@ data Connection = Connection } deriving (Eq, Show, Generic) +connReady :: Connection -> Bool +connReady Connection {connStatus} = connStatus == ConnReady || connStatus == ConnSndReady + authErrDisableCount :: Int authErrDisableCount = 10 @@ -1442,9 +1498,6 @@ serializeIntroStatus = \case GMIntroToConnected -> "to-con" GMIntroConnected -> "con" -data Notification = Notification {title :: Text, text :: Text} - deriving (Show, Generic, FromJSON, ToJSON) - 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 fbe7750af0..834cf78322 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -73,10 +73,10 @@ responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> Curr responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile CRUsersList users -> viewUsersList users - CRChatStarted _ -> ["chat started"] - CRChatRunning _ -> ["chat is running"] - CRChatStopped _ -> ["chat stopped"] - CRChatSuspended _ -> ["chat suspended"] + CRChatStarted -> ["chat started"] + CRChatRunning -> ["chat is running"] + CRChatStopped -> ["chat stopped"] + CRChatSuspended -> ["chat suspended"] CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats] CRChats chats -> viewChats ts tz chats CRApiChat u chat -> ttyUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat] @@ -103,15 +103,15 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] 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 + CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u 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 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 - CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts tz + CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewItemUpdate chat item liveItems ts tz CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci - CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView - CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction showReactions chat reaction added ts tz + CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted u chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView + CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction u chat reaction $ viewItemReaction showReactions chat reaction added ts tz CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"] CRBroadcastSent u mc s f t -> ttyUser u $ viewSentBroadcast mc s f ts tz t CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr @@ -149,6 +149,7 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei 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"] @@ -267,14 +268,14 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei CRRemoteHostDeleted rhId -> ["remote host " <> sShow rhId <> " deleted"] CRRemoteCtrlList cs -> viewRemoteCtrls cs CRRemoteCtrlRegistered rcId -> ["remote controller " <> sShow rcId <> " registered"] - CRRemoteCtrlStarted _ -> ["remote controller started"] + CRRemoteCtrlStarted -> ["remote controller started"] CRRemoteCtrlAnnounce fingerprint -> ["remote controller announced", "connection code:", plain $ strEncode fingerprint] CRRemoteCtrlFound rc -> ["remote controller found:", viewRemoteCtrl rc] CRRemoteCtrlAccepted rcId -> ["remote controller " <> sShow rcId <> " accepted"] CRRemoteCtrlRejected rcId -> ["remote controller " <> sShow rcId <> " rejected"] CRRemoteCtrlConnecting rcId rcName -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName] CRRemoteCtrlConnected rcId rcName -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName] - CRRemoteCtrlStopped _ -> ["remote controller stopped"] + CRRemoteCtrlStopped -> ["remote controller stopped"] CRRemoteCtrlDeleted rcId -> ["remote controller " <> sShow rcId <> " deleted"] CRSQLResult rows -> map plain rows CRSlowSQLQueries {chatQueries, agentQueries} -> @@ -368,24 +369,56 @@ responseToView (currentRH, user_) ChatConfig {logLevel, showReactions, showRecei viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)] contactList :: [ContactRef] -> String contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs - unmuted :: ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString] - unmuted chat ChatItem {chatDir} = unmuted' chat chatDir - unmutedReaction :: ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString] - unmutedReaction chat CIReaction {chatDir} = unmuted' chat chatDir - unmuted' :: ChatInfo c -> CIDirection c d -> [StyledString] -> [StyledString] - unmuted' chat chatDir s - | muted chat chatDir = [] - | otherwise = s + unmuted :: User -> ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString] + unmuted u chat ci@ChatItem {chatDir} = unmuted' u chat chatDir $ isMention ci + unmutedReaction :: User -> ChatInfo c -> CIReaction c d -> [StyledString] -> [StyledString] + unmutedReaction u chat CIReaction {chatDir} = unmuted' u chat chatDir False + unmuted' :: User -> ChatInfo c -> CIDirection c d -> Bool -> [StyledString] -> [StyledString] + unmuted' u chat chatDir mention s + | chatDirNtf u chat chatDir mention = s + | otherwise = [] + +userNtf :: User -> Bool +userNtf User {showNtfs, activeUser} = showNtfs || activeUser + +chatNtf :: User -> ChatInfo c -> Bool -> Bool +chatNtf user cInfo mention = case cInfo of + DirectChat ct -> contactNtf user ct mention + GroupChat g -> groupNtf user g mention + _ -> False + +chatDirNtf :: User -> ChatInfo c -> CIDirection c d -> Bool -> Bool +chatDirNtf user cInfo chatDir mention = case (cInfo, chatDir) of + (DirectChat ct, CIDirectRcv) -> contactNtf user ct mention + (GroupChat g, CIGroupRcv m) -> groupNtf user g mention && showMessages (memberSettings m) + _ -> True + +contactNtf :: User -> Contact -> Bool -> Bool +contactNtf user Contact {chatSettings} mention = + userNtf user && showMessageNtf chatSettings mention + +groupNtf :: User -> GroupInfo -> Bool -> Bool +groupNtf user GroupInfo {chatSettings} mention = + userNtf user && showMessageNtf chatSettings mention + +showMessageNtf :: ChatSettings -> Bool -> Bool +showMessageNtf ChatSettings {enableNtfs} mention = + enableNtfs == MFAll || (mention && enableNtfs == MFMentions) chatItemDeletedText :: ChatItem c d -> Maybe GroupMember -> Maybe Text -chatItemDeletedText ci membership_ = deletedStateToText <$> chatItemDeletedState ci +chatItemDeletedText ChatItem {meta = CIMeta {itemDeleted}, content} membership_ = + deletedText <$> itemDeleted where - deletedStateToText = \CIDeletedState {markedDeleted, deletedByMember} -> - if markedDeleted - then "marked deleted" <> byMember deletedByMember - else "deleted" <> byMember deletedByMember - byMember m_ = case (m_, membership_) of - (Just GroupMember {groupMemberId = mId, localDisplayName = n}, Just GroupMember {groupMemberId = membershipId}) -> + deletedText = \case + CIModerated _ m -> markedDeleted content <> byMember m + CIDeleted _ -> markedDeleted content + CIBlocked _ -> "blocked" + markedDeleted = \case + CISndModerated -> "deleted" + CIRcvModerated -> "deleted" + _ -> "marked deleted" + byMember GroupMember {groupMemberId = mId, localDisplayName = n} = case membership_ of + Just GroupMember {groupMemberId = membershipId} -> " by " <> if mId == membershipId then "you" else n _ -> "" @@ -404,12 +437,6 @@ viewUsersList = mapMaybe userInfo . sortOn ldn <> ["muted" | not showNtfs] <> [plain ("unread: " <> show count) | count /= 0] -muted :: ChatInfo c -> CIDirection c d -> Bool -muted chat chatDir = case (chat, chatDir) of - (DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True - (GroupChat GroupInfo {chatSettings = DisableNtfs}, CIGroupRcv _) -> True - _ -> False - viewGroupSubscribed :: GroupInfo -> [StyledString] viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"] @@ -711,7 +738,7 @@ viewContactsList = in map (\ct -> ctIncognito ct <> ttyFullContact ct <> muted' ct <> alias ct) . sortOn ldn where muted' Contact {chatSettings, localDisplayName = ldn} - | enableNtfs chatSettings = "" + | chatHasNtfs chatSettings = "" | otherwise = " (muted, you can " <> highlight ("/unmute @" <> ldn) <> ")" alias Contact {profile = LocalProfile {localAlias}} | localAlias == "" = "" @@ -844,22 +871,25 @@ viewGroupMembers :: Group -> [StyledString] viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filter (not . removedOrLeft) $ membership : members where removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft - groupMember m = memIncognito m <> ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m - role :: GroupMember -> StyledString - role m = plain . strEncode $ m.memberRole + groupMember m = memIncognito m <> ttyFullMember m <> ": " <> plain (intercalate ", " $ [role m] <> category m <> status m <> muted m) + role :: GroupMember -> String + role m = B.unpack . strEncode $ m.memberRole category m = case memberCategory m of - GCUserMember -> "you, " - GCInviteeMember -> "invited, " - GCHostMember -> "host, " - _ -> "" + GCUserMember -> ["you"] + GCInviteeMember -> ["invited"] + GCHostMember -> ["host"] + _ -> [] status m = case memberStatus m of - GSMemRemoved -> "removed" - GSMemLeft -> "left" - GSMemInvited -> "not yet joined" - GSMemConnected -> "connected" - GSMemComplete -> "connected" - GSMemCreator -> "created group" - _ -> "" + GSMemRemoved -> ["removed"] + GSMemLeft -> ["left"] + GSMemInvited -> ["not yet joined"] + GSMemConnected -> ["connected"] + GSMemComplete -> ["connected"] + GSMemCreator -> ["created group"] + _ -> [] + muted m + | showMessages (memberSettings m) = [] + | otherwise = ["blocked"] viewContactConnected :: Contact -> Maybe Profile -> Bool -> [StyledString] viewContactConnected ct userIncognitoProfile testView = @@ -882,7 +912,7 @@ viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs where ldn_ :: GroupInfo -> Text ldn_ g = T.toLower g.localDisplayName - groupSS (g@GroupInfo {membership, chatSettings}, GroupSummary {currentMembers}) = + groupSS (g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}}, GroupSummary {currentMembers}) = case memberStatus membership of GSMemInvited -> groupInvitation' g s -> membershipIncognito g <> ttyFullGroup g <> viewMemberStatus s @@ -891,9 +921,13 @@ viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs GSMemRemoved -> delete "you are removed" GSMemLeft -> delete "you left" GSMemGroupDeleted -> delete "group deleted" - _ - | enableNtfs chatSettings -> " (" <> memberCount <> ")" - | otherwise -> " (" <> memberCount <> ", muted, you can " <> highlight ("/unmute #" <> viewGroupName g) <> ")" + _ -> " (" <> memberCount <> + case enableNtfs of + MFAll -> ")" + MFNone -> ", muted, " <> unmute + MFMentions -> ", mentions only, " <> unmute + where + unmute = "you can " <> highlight ("/unmute #" <> viewGroupName g) <> ")" delete reason = " (" <> reason <> ", delete local copy: " <> highlight ("/d #" <> viewGroupName g) <> ")" memberCount = sShow currentMembers <> " member" <> if currentMembers == 1 then "" else "s" @@ -1243,6 +1277,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}} @@ -1610,6 +1679,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/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..fae460e908 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 @@ -210,6 +210,8 @@ withTestChatOpts tmp = withTestChatCfgOpts tmp testCfg withTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a withTestChatCfgOpts tmp cfg opts dbPrefix = bracket (startTestChat tmp cfg opts dbPrefix) (\cc -> cc > stopTestChat cc) +-- enable output for specific chat controller, use like this: +-- withNewTestChat tmp "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do ... withTestOutput :: HasCallStack => TestCC -> (HasCallStack => TestCC -> IO a) -> IO a withTestOutput cc runTest = runTest cc {printOutput = True} diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index a5fc7455c8..b4c3c53cd9 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 @@ -66,7 +70,7 @@ chatDirectTests = do it "should not subscribe in NSE and subscribe in the app" testSubscribeAppNSE describe "mute/unmute messages" $ do it "mute/unmute contact" testMuteContact - it "mute/unmute group" testMuteGroup + it "mute/unmute group and member" testMuteGroup describe "multiple users" $ do it "create second user" testCreateSecondUser it "multiple users subscribe and receive messages after restart" testUsersSubscribeAfterRestart @@ -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 $ @@ -1129,14 +1196,79 @@ testMuteGroup = concurrently_ (bob hi") + bob #> "#team hello" + concurrently_ + (alice <# "#team bob> hello") + (cath <# "#team bob> hello") + cath `send` "> #team (hello) hello too!" + cath <# "#team > bob hello" + cath <## " hello too!" + concurrently_ + (bob > bob hello" + alice <## " hello too!" + ) + bob ##> "/unmute mentions #team" + bob <## "ok" + alice `send` "> #team @bob (hello) hey bob!" + alice <# "#team > bob hello" + alice <## " hey bob!" + concurrently_ + ( do bob <# "#team alice> > bob hello" + bob <## " hey bob!" + ) + ( do cath <# "#team alice> > bob hello" + cath <## " hey bob!" + ) + alice `send` "> #team @cath (hello) hey cath!" + alice <# "#team > cath hello too!" + alice <## " hey cath!" + concurrently_ + (bob > cath hello too!" + cath <## " hey cath!" + ) bob ##> "/gs" - bob <## "#team (3 members, muted, you can /unmute #team)" + bob <## "#team (3 members, mentions only, you can /unmute #team)" bob ##> "/unmute #team" bob <## "ok" alice #> "#team hi again" concurrently_ (bob <# "#team alice> hi again") (cath <# "#team alice> hi again") + bob ##> "/block #team alice" + bob <## "ok" + bob ##> "/ms team" + bob <## "bob (Bob): admin, you, connected" + bob <## "alice (Alice): owner, host, connected, blocked" + bob <## "cath (Catherine): admin, connected" + alice #> "#team test 1" + concurrently_ + (bob test 1") + cath #> "#team test 2" + concurrently_ + (bob <# "#team cath> test 2") + (alice <# "#team cath> test 2") + bob ##> "/tail #team 3" + bob <# "#team alice> hi again" + bob <# "#team alice> test 1 [blocked]" + bob <# "#team cath> test 2" + threadDelay 1000000 + bob ##> "/unblock #team alice" + bob <## "ok" + bob ##> "/ms team" + bob <## "bob (Bob): admin, you, connected" + bob <## "alice (Alice): owner, host, connected" + bob <## "cath (Catherine): admin, connected" + alice #> "#team test 3" + concurrently_ + (bob <# "#team alice> test 3") + (cath <# "#team alice> test 3") + cath #> "#team test 4" + concurrently_ + (bob <# "#team cath> test 4") + (alice <# "#team cath> test 4") bob ##> "/gs" bob <## "#team (3 members)" @@ -1870,7 +2002,7 @@ testUserPrivacy = -- shows hidden user when active alice ##> "/users" alice <## "alice (Alice)" - alice <## "alisa (active, hidden, muted)" + alice <## "alisa (active, hidden, muted, unread: 1)" -- hidden message is saved alice ##> "/tail" alice <##? chatHistory diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 9fb6ac7f9b..55d02b9488 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 @@ -1532,7 +1538,6 @@ testGroupDelayedModerationFullDelete tmp = do testGroupAsync :: HasCallStack => FilePath -> IO () testGroupAsync tmp = do - print (0 :: Integer) withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat tmp "bob" bobProfile $ \bob -> do connectUsers alice bob @@ -2251,6 +2256,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 @@ -3015,9 +3251,9 @@ testMemberContactProhibitedRepeatInv = testMemberContactInvitedConnectionReplaced :: HasCallStack => FilePath -> IO () testMemberContactInvitedConnectionReplaced tmp = do - withNewTestChat tmp "alice" aliceProfile $ \alice -> do - withNewTestChat tmp "bob" bobProfile $ \bob -> do - withNewTestChat tmp "cath" cathProfile $ \cath -> do + withNewTestChat tmp "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do + withNewTestChat tmp "bob" bobProfile $ \b -> withTestOutput b $ \bob -> do + withNewTestChat tmp "cath" cathProfile $ \c -> withTestOutput c $ \cath -> do createGroup3 "team" alice bob cath alice ##> "/d bob" @@ -3040,7 +3276,9 @@ testMemberContactInvitedConnectionReplaced tmp = do (alice <## "bob (Bob): contact is connected") (bob <## "alice (Alice): contact is connected") - bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "received invitation to join group team as admin"), (0, "contact deleted"), (0, "hi"), (0, "security code changed")] <> chatFeatures) + bob ##> "/_get chat @2 count=100" + items <- chat <$> getTermLine bob + items `shouldContain` [(0, "received invitation to join group team as admin"), (0, "contact deleted"), (0, "hi"), (0, "security code changed")] withTestChat tmp "bob" $ \bob -> do subscriptions bob 1 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