diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 986287fca0..a5a07a8722 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -270,7 +270,7 @@ jobs: - name: Unix test if: matrix.os != 'windows-latest' - timeout-minutes: 30 + timeout-minutes: 40 shell: bash run: cabal test --test-show-details=direct diff --git a/apps/ios/Shared/Model/SimpleXAPI.swift b/apps/ios/Shared/Model/SimpleXAPI.swift index 1fc6b54390..57dab12a87 100644 --- a/apps/ios/Shared/Model/SimpleXAPI.swift +++ b/apps/ios/Shared/Model/SimpleXAPI.swift @@ -258,6 +258,18 @@ func apiSetEncryptLocalFiles(_ enable: Bool) throws { throw r } +func apiSetPQEncryption(_ enable: Bool) throws { + let r = chatSendCmdSync(.apiSetPQEncryption(enable: enable)) + if case .cmdOk = r { return } + throw r +} + +func apiSetContactPQ(_ contactId: Int64, _ enable: Bool) async throws -> Contact { + let r = await chatSendCmd(.apiSetContactPQ(contactId: contactId, enable: enable)) + if case let .contactPQAllowed(_, contact, _) = r { return contact } + throw r +} + func apiExportArchive(config: ArchiveConfig) async throws { try await sendCommandOkResp(.apiExportArchive(config: config)) } @@ -1244,6 +1256,7 @@ func initializeChat(start: Bool, confirmStart: Bool = false, dbKey: String? = ni try apiSetTempFolder(tempFolder: getTempFilesDirectory().path) try apiSetFilesFolder(filesFolder: getAppFilesDirectory().path) try apiSetEncryptLocalFiles(privacyEncryptLocalFilesGroupDefault.get()) + try apiSetPQEncryption(pqExperimentalEnabledDefault.get()) m.chatInitialized = true m.currentUser = try apiGetActiveUser() if m.currentUser == nil { @@ -1818,6 +1831,12 @@ func processReceivedMsg(_ res: ChatResponse) async { } } } + case let .contactPQEnabled(user, contact, _): + if active(user) { + await MainActor.run { + m.updateContact(contact) + } + } default: logger.debug("unsupported event: \(res.responseType)") } diff --git a/apps/ios/Shared/Views/Chat/ChatInfoView.swift b/apps/ios/Shared/Views/Chat/ChatInfoView.swift index b702c2cc23..86532605db 100644 --- a/apps/ios/Shared/Views/Chat/ChatInfoView.swift +++ b/apps/ios/Shared/Views/Chat/ChatInfoView.swift @@ -103,6 +103,7 @@ struct ChatInfoView: View { @State private var sendReceipts = SendReceipts.userDefault(true) @State private var sendReceiptsUserDefault = true @AppStorage(DEFAULT_DEVELOPER_TOOLS) private var developerTools = false + @AppStorage(GROUP_DEFAULT_PQ_EXPERIMENTAL_ENABLED, store: groupDefaults) private var pqExperimentalEnabled = false enum ChatInfoViewAlert: Identifiable { case clearChatAlert @@ -110,6 +111,7 @@ struct ChatInfoView: View { case switchAddressAlert case abortSwitchAddressAlert case syncConnectionForceAlert + case allowContactPQEncryptionAlert case error(title: LocalizedStringKey, error: LocalizedStringKey = "") var id: String { @@ -119,6 +121,7 @@ struct ChatInfoView: View { case .switchAddressAlert: return "switchAddressAlert" case .abortSwitchAddressAlert: return "abortSwitchAddressAlert" case .syncConnectionForceAlert: return "syncConnectionForceAlert" + case .allowContactPQEncryptionAlert: return "allowContactPQEncryptionAlert" case let .error(title, _): return "error \(title)" } } @@ -165,6 +168,22 @@ struct ChatInfoView: View { } .disabled(!contact.ready || !contact.active) + if pqExperimentalEnabled, + let conn = contact.activeConn { + Section { + infoRow(Text(String("E2E encryption")), conn.connPQEnabled ? "Quantum resistant" : "Standard") + if !conn.pqEncryption { + allowPQButton() + } + } header: { + Text(String("Quantum resistant E2E encryption")) + } footer: { + if !conn.pqEncryption { + Text(String("After allowing quantum resistant encryption, it will be enabled after several messages if your contact also allows it.")) + } + } + } + if let contactLink = contact.contactLink { Section { SimpleXLinkQRCode(uri: contactLink) @@ -237,6 +256,7 @@ struct ChatInfoView: View { case .switchAddressAlert: return switchAddressAlert(switchContactAddress) case .abortSwitchAddressAlert: return abortSwitchAddressAlert(abortSwitchContactAddress) case .syncConnectionForceAlert: return syncConnectionForceAlert({ syncContactConnection(force: true) }) + case .allowContactPQEncryptionAlert: return allowContactPQEncryptionAlert() case let .error(title, error): return mkAlert(title: title, message: error) } } @@ -410,6 +430,15 @@ struct ChatInfoView: View { } } + private func allowPQButton() -> some View { + Button { + alert = .allowContactPQEncryptionAlert + } label: { + Label(String("Allow PQ encryption"), systemImage: "exclamationmark.triangle") + .foregroundColor(.orange) + } + } + private func networkStatusRow() -> some View { HStack { Text("Network status") @@ -543,6 +572,34 @@ struct ChatInfoView: View { } } } + + private func allowContactPQEncryption() { + Task { + do { + let ct = try await apiSetContactPQ(contact.apiId, true) + contact = ct + await MainActor.run { + chatModel.updateContact(contact) + dismiss() + } + } catch let error { + logger.error("allowContactPQEncryption apiSetContactPQ error: \(responseError(error))") + let a = getErrorAlert(error, "Error allowing contact PQ encryption") + await MainActor.run { + alert = .error(title: a.title, error: a.message) + } + } + } + } + + func allowContactPQEncryptionAlert() -> Alert { + Alert( + title: Text(String("Allow quantum resistant encryption?")), + message: Text(String("This is an experimental feature, it is not recommended to enable it for important chats.")), + primaryButton: .destructive(Text(String("Allow")), action: allowContactPQEncryption), + secondaryButton: .cancel() + ) + } } func switchAddressAlert(_ switchAddress: @escaping () -> Void) -> Alert { diff --git a/apps/ios/Shared/Views/Chat/ChatItemView.swift b/apps/ios/Shared/Views/Chat/ChatItemView.swift index 8f67a8f737..d9404547e2 100644 --- a/apps/ios/Shared/Views/Chat/ChatItemView.swift +++ b/apps/ios/Shared/Views/Chat/ChatItemView.swift @@ -111,6 +111,11 @@ struct ChatItemContentView: View { case .rcvModerated: deletedItemView() case .rcvBlocked: deletedItemView() case let .invalidJSON(json): CIInvalidJSONView(json: json) + // TODO proper items + case .sndDirectE2EEInfo: CIEventView(eventText: Text(chatItem.content.text)) + case .rcvDirectE2EEInfo: CIEventView(eventText: Text(chatItem.content.text)) + case .sndGroupE2EEInfo: CIEventView(eventText: Text(chatItem.content.text)) + case .rcvGroupE2EEInfo: CIEventView(eventText: Text(chatItem.content.text)) } } diff --git a/apps/ios/Shared/Views/UserSettings/DeveloperView.swift b/apps/ios/Shared/Views/UserSettings/DeveloperView.swift index 3bbfbfe33e..9b11c6d0f7 100644 --- a/apps/ios/Shared/Views/UserSettings/DeveloperView.swift +++ b/apps/ios/Shared/Views/UserSettings/DeveloperView.swift @@ -12,6 +12,7 @@ import SimpleXChat struct DeveloperView: View { @AppStorage(DEFAULT_DEVELOPER_TOOLS) private var developerTools = false @AppStorage(GROUP_DEFAULT_CONFIRM_DB_UPGRADES, store: groupDefaults) private var confirmDatabaseUpgrades = false + @AppStorage(GROUP_DEFAULT_PQ_EXPERIMENTAL_ENABLED, store: groupDefaults) private var pqExperimentalEnabled = false @Environment(\.colorScheme) var colorScheme var body: some View { @@ -42,9 +43,33 @@ struct DeveloperView: View { } footer: { (developerTools ? Text("Show:") : Text("Hide:")) + Text(" ") + Text("Database IDs and Transport isolation option.") } + + if developerTools { + Section { + settingsRow("key") { + Toggle("Post-quantum E2EE", isOn: $pqExperimentalEnabled) + .onChange(of: pqExperimentalEnabled) { + setPQExperimentalEnabled($0) + } + } + } header: { + Text(String("Experimental")) + } footer: { + Text(String("In this version applies only to new contacts.")) + } + } } } } + + private func setPQExperimentalEnabled(_ enable: Bool) { + do { + try apiSetPQEncryption(enable) + } catch let error { + let err = responseError(error) + logger.error("apiSetPQEncryption \(err)") + } + } } struct DeveloperView_Previews: PreviewProvider { diff --git a/apps/ios/SimpleX.xcodeproj/project.pbxproj b/apps/ios/SimpleX.xcodeproj/project.pbxproj index e36cc54730..1195aed3c5 100644 --- a/apps/ios/SimpleX.xcodeproj/project.pbxproj +++ b/apps/ios/SimpleX.xcodeproj/project.pbxproj @@ -61,11 +61,11 @@ 5C7505A527B679EE00BE3227 /* NavLinkPlain.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C7505A427B679EE00BE3227 /* NavLinkPlain.swift */; }; 5C7505A827B6D34800BE3227 /* ChatInfoToolbar.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C7505A727B6D34800BE3227 /* ChatInfoToolbar.swift */; }; 5C764E89279CBCB3000C6508 /* ChatModel.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C764E88279CBCB3000C6508 /* ChatModel.swift */; }; - 5C777BEC2B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BE72B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N-ghc9.6.3.a */; }; - 5C777BED2B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BE82B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a */; }; - 5C777BEE2B9D21A900C72EFF /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BE92B9D21A900C72EFF /* libffi.a */; }; - 5C777BEF2B9D21A900C72EFF /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BEA2B9D21A900C72EFF /* libgmpxx.a */; }; - 5C777BF02B9D21A900C72EFF /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BEB2B9D21A900C72EFF /* libgmp.a */; }; + 5C777BD82B99B38B00C72EFF /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BD32B99B38B00C72EFF /* libgmp.a */; }; + 5C777BD92B99B38B00C72EFF /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BD42B99B38B00C72EFF /* libgmpxx.a */; }; + 5C777BDA2B99B38B00C72EFF /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BD52B99B38B00C72EFF /* libffi.a */; }; + 5C777BDB2B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BD62B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg-ghc9.6.3.a */; }; + 5C777BDC2B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C777BD72B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a */; }; 5C8F01CD27A6F0D8007D2C8D /* CodeScanner in Frameworks */ = {isa = PBXBuildFile; productRef = 5C8F01CC27A6F0D8007D2C8D /* CodeScanner */; }; 5C93292F29239A170090FFF9 /* ProtocolServersView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C93292E29239A170090FFF9 /* ProtocolServersView.swift */; }; 5C93293129239BED0090FFF9 /* ProtocolServerView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C93293029239BED0090FFF9 /* ProtocolServerView.swift */; }; @@ -325,11 +325,11 @@ 5C7505A427B679EE00BE3227 /* NavLinkPlain.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NavLinkPlain.swift; sourceTree = ""; }; 5C7505A727B6D34800BE3227 /* ChatInfoToolbar.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatInfoToolbar.swift; sourceTree = ""; }; 5C764E88279CBCB3000C6508 /* ChatModel.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatModel.swift; sourceTree = ""; }; - 5C777BE72B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N-ghc9.6.3.a"; sourceTree = ""; }; - 5C777BE82B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a"; sourceTree = ""; }; - 5C777BE92B9D21A900C72EFF /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; - 5C777BEA2B9D21A900C72EFF /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = ""; }; - 5C777BEB2B9D21A900C72EFF /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; + 5C777BD32B99B38B00C72EFF /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = ""; }; + 5C777BD42B99B38B00C72EFF /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = ""; }; + 5C777BD52B99B38B00C72EFF /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = ""; }; + 5C777BD62B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg-ghc9.6.3.a"; sourceTree = ""; }; + 5C777BD72B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a"; sourceTree = ""; }; 5C84FE9129A216C800D95B1A /* nl */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = nl; path = nl.lproj/Localizable.strings; sourceTree = ""; }; 5C84FE9329A2179C00D95B1A /* nl */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = nl; path = "nl.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = ""; }; 5C84FE9429A2179C00D95B1A /* nl */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = nl; path = nl.lproj/InfoPlist.strings; sourceTree = ""; }; @@ -514,13 +514,13 @@ isa = PBXFrameworksBuildPhase; buildActionMask = 2147483647; files = ( - 5C777BEF2B9D21A900C72EFF /* libgmpxx.a in Frameworks */, - 5C777BF02B9D21A900C72EFF /* libgmp.a in Frameworks */, - 5C777BEC2B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N-ghc9.6.3.a in Frameworks */, + 5C777BD92B99B38B00C72EFF /* libgmpxx.a in Frameworks */, + 5C777BDB2B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg-ghc9.6.3.a in Frameworks */, 5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */, + 5C777BD82B99B38B00C72EFF /* libgmp.a in Frameworks */, + 5C777BDA2B99B38B00C72EFF /* libffi.a in Frameworks */, 5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */, - 5C777BEE2B9D21A900C72EFF /* libffi.a in Frameworks */, - 5C777BED2B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a in Frameworks */, + 5C777BDC2B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a in Frameworks */, ); runOnlyForDeploymentPostprocessing = 0; }; @@ -582,11 +582,11 @@ 5C764E5C279C70B7000C6508 /* Libraries */ = { isa = PBXGroup; children = ( - 5C777BE92B9D21A900C72EFF /* libffi.a */, - 5C777BEB2B9D21A900C72EFF /* libgmp.a */, - 5C777BEA2B9D21A900C72EFF /* libgmpxx.a */, - 5C777BE72B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N-ghc9.6.3.a */, - 5C777BE82B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a */, + 5C777BD52B99B38B00C72EFF /* libffi.a */, + 5C777BD32B99B38B00C72EFF /* libgmp.a */, + 5C777BD42B99B38B00C72EFF /* libgmpxx.a */, + 5C777BD62B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg-ghc9.6.3.a */, + 5C777BD72B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a */, ); path = Libraries; sourceTree = ""; diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift index 88bb8910dd..4df419ffef 100644 --- a/apps/ios/SimpleXChat/APITypes.swift +++ b/apps/ios/SimpleXChat/APITypes.swift @@ -32,6 +32,8 @@ public enum ChatCommand { case setTempFolder(tempFolder: String) case setFilesFolder(filesFolder: String) case apiSetEncryptLocalFiles(enable: Bool) + case apiSetPQEncryption(enable: Bool) + case apiSetContactPQ(contactId: Int64, enable: Bool) case apiExportArchive(config: ArchiveConfig) case apiImportArchive(config: ArchiveConfig) case apiDeleteStorage @@ -162,6 +164,8 @@ public enum ChatCommand { case let .setTempFolder(tempFolder): return "/_temp_folder \(tempFolder)" case let .setFilesFolder(filesFolder): return "/_files_folder \(filesFolder)" case let .apiSetEncryptLocalFiles(enable): return "/_files_encrypt \(onOff(enable))" + case let .apiSetPQEncryption(enable): return "/pq \(onOff(enable))" + case let .apiSetContactPQ(contactId, enable): return "/_pq @\(contactId) \(onOff(enable))" case let .apiExportArchive(cfg): return "/_db export \(encodeJSON(cfg))" case let .apiImportArchive(cfg): return "/_db import \(encodeJSON(cfg))" case .apiDeleteStorage: return "/_db delete" @@ -306,6 +310,8 @@ public enum ChatCommand { case .setTempFolder: return "setTempFolder" case .setFilesFolder: return "setFilesFolder" case .apiSetEncryptLocalFiles: return "apiSetEncryptLocalFiles" + case .apiSetPQEncryption: return "apiSetPQEncryption" + case .apiSetContactPQ: return "apiSetContactPQ" case .apiExportArchive: return "apiExportArchive" case .apiImportArchive: return "apiImportArchive" case .apiDeleteStorage: return "apiDeleteStorage" @@ -617,6 +623,9 @@ public enum ChatResponse: Decodable, Error { case remoteCtrlSessionCode(remoteCtrl_: RemoteCtrlInfo?, sessionCode: String) case remoteCtrlConnected(remoteCtrl: RemoteCtrlInfo) case remoteCtrlStopped(rcsState: RemoteCtrlSessionState, rcStopReason: RemoteCtrlStopReason) + // pq + case contactPQAllowed(user: UserRef, contact: Contact, pqEncryption: Bool) + case contactPQEnabled(user: UserRef, contact: Contact, pqEnabled: Bool) // misc case versionInfo(versionInfo: CoreVersionInfo, chatMigrations: [UpMigration], agentMigrations: [UpMigration]) case cmdOk(user: UserRef?) @@ -765,6 +774,8 @@ public enum ChatResponse: Decodable, Error { case .remoteCtrlSessionCode: return "remoteCtrlSessionCode" case .remoteCtrlConnected: return "remoteCtrlConnected" case .remoteCtrlStopped: return "remoteCtrlStopped" + case .contactPQAllowed: return "contactPQAllowed" + case .contactPQEnabled: return "contactPQAllowed" case .versionInfo: return "versionInfo" case .cmdOk: return "cmdOk" case .chatCmdError: return "chatCmdError" @@ -915,6 +926,8 @@ public enum ChatResponse: Decodable, Error { case let .remoteCtrlSessionCode(remoteCtrl_, sessionCode): return "remoteCtrl_:\n\(String(describing: remoteCtrl_))\nsessionCode: \(sessionCode)" case let .remoteCtrlConnected(remoteCtrl): return String(describing: remoteCtrl) case .remoteCtrlStopped: return noDetails + case let .contactPQAllowed(u, contact, pqEncryption): return withUser(u, "contact: \(String(describing: contact))\npqEncryption: \(pqEncryption)") + case let .contactPQEnabled(u, contact, pqEnabled): return withUser(u, "contact: \(String(describing: contact))\npqEnabled: \(pqEnabled)") case let .versionInfo(versionInfo, chatMigrations, agentMigrations): return "\(String(describing: versionInfo))\n\nchat migrations: \(chatMigrations.map(\.upName))\n\nagent migrations: \(agentMigrations.map(\.upName))" case .cmdOk: return noDetails case let .chatCmdError(u, chatError): return withUser(u, String(describing: chatError)) diff --git a/apps/ios/SimpleXChat/AppGroup.swift b/apps/ios/SimpleXChat/AppGroup.swift index ceb7d9d7db..47e250b7e9 100644 --- a/apps/ios/SimpleXChat/AppGroup.swift +++ b/apps/ios/SimpleXChat/AppGroup.swift @@ -39,6 +39,7 @@ let GROUP_DEFAULT_STORE_DB_PASSPHRASE = "storeDBPassphrase" let GROUP_DEFAULT_INITIAL_RANDOM_DB_PASSPHRASE = "initialRandomDBPassphrase" public let GROUP_DEFAULT_CONFIRM_DB_UPGRADES = "confirmDBUpgrades" public let GROUP_DEFAULT_CALL_KIT_ENABLED = "callKitEnabled" +public let GROUP_DEFAULT_PQ_EXPERIMENTAL_ENABLED = "pqExperimentalEnabled" public let APP_GROUP_NAME = "group.chat.simplex.app" @@ -67,6 +68,7 @@ public func registerGroupDefaults() { GROUP_DEFAULT_PRIVACY_ENCRYPT_LOCAL_FILES: true, GROUP_DEFAULT_CONFIRM_DB_UPGRADES: false, GROUP_DEFAULT_CALL_KIT_ENABLED: true, + GROUP_DEFAULT_PQ_EXPERIMENTAL_ENABLED: false, ]) } @@ -193,6 +195,8 @@ public let confirmDBUpgradesGroupDefault = BoolDefault(defaults: groupDefaults, public let callKitEnabledGroupDefault = BoolDefault(defaults: groupDefaults, forKey: GROUP_DEFAULT_CALL_KIT_ENABLED) +public let pqExperimentalEnabledDefault = BoolDefault(defaults: groupDefaults, forKey: GROUP_DEFAULT_PRIVACY_ENCRYPT_LOCAL_FILES) + public class DateDefault { var defaults: UserDefaults var key: String diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index 997f6e3537..3463bfca18 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -1532,22 +1532,32 @@ public struct Connection: Decodable { public var viaGroupLink: Bool public var customUserProfileId: Int64? public var connectionCode: SecurityCode? + public var pqSupport: Bool + public var pqEncryption: Bool + public var pqSndEnabled: Bool? + public var pqRcvEnabled: Bool? public var connectionStats: ConnectionStats? = nil private enum CodingKeys: String, CodingKey { - case connId, agentConnId, peerChatVRange, connStatus, connLevel, viaGroupLink, customUserProfileId, connectionCode + case connId, agentConnId, peerChatVRange, connStatus, connLevel, viaGroupLink, customUserProfileId, connectionCode, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled } public var id: ChatId { get { ":\(connId)" } } + public var connPQEnabled: Bool { + pqSndEnabled == true && pqRcvEnabled == true + } + static let sampleData = Connection( connId: 1, agentConnId: "abc", peerChatVRange: VersionRange(minVersion: 1, maxVersion: 1), connStatus: .ready, connLevel: 0, - viaGroupLink: false + viaGroupLink: false, + pqSupport: false, + pqEncryption: false ) } @@ -2300,6 +2310,10 @@ public struct ChatItem: Identifiable, Decodable { case .sndModerated: return false case .rcvModerated: return false case .rcvBlocked: return false + case .sndDirectE2EEInfo: return false + case .rcvDirectE2EEInfo: return false + case .sndGroupE2EEInfo: return false + case .rcvGroupE2EEInfo: return false case .invalidJSON: return false } } @@ -2735,6 +2749,10 @@ public enum CIContent: Decodable, ItemContent { case sndModerated case rcvModerated case rcvBlocked + case sndDirectE2EEInfo(e2eeInfo: E2EEInfo) + case rcvDirectE2EEInfo(e2eeInfo: E2EEInfo) + case sndGroupE2EEInfo(e2eeInfo: E2EEInfo) + case rcvGroupE2EEInfo(e2eeInfo: E2EEInfo) case invalidJSON(json: String) public var text: String { @@ -2766,11 +2784,25 @@ public enum CIContent: Decodable, ItemContent { case .sndModerated: return NSLocalizedString("moderated", comment: "moderated chat item") case .rcvModerated: return NSLocalizedString("moderated", comment: "moderated chat item") case .rcvBlocked: return NSLocalizedString("blocked by admin", comment: "blocked chat item") + case let .sndDirectE2EEInfo(e2eeInfo): return directE2EEInfoToText(e2eeInfo) + case let .rcvDirectE2EEInfo(e2eeInfo): return directE2EEInfoToText(e2eeInfo) + case .sndGroupE2EEInfo: return e2eeInfoNoPQText + case .rcvGroupE2EEInfo: return e2eeInfoNoPQText case .invalidJSON: return NSLocalizedString("invalid data", comment: "invalid chat item") } } } + private func directE2EEInfoToText(_ e2eeInfo: E2EEInfo) -> String { + e2eeInfo.pqEnabled + ? NSLocalizedString("This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery.", comment: "E2EE info chat item") + : e2eeInfoNoPQText + } + + private var e2eeInfoNoPQText: String { + NSLocalizedString("This conversation is protected by end-to-end encryption with perfect forward secrecy, repudiation and break-in recovery.", comment: "E2EE info chat item") + } + static func featureText(_ feature: Feature, _ enabled: String, _ param: Int?) -> String { feature.hasParam ? "\(feature.text): \(timeText(param))" @@ -3457,6 +3489,10 @@ public enum CIGroupInvitationStatus: String, Decodable { case expired } +public struct E2EEInfo: Decodable { + public var pqEnabled: Bool +} + public enum RcvDirectEvent: Decodable { case contactDeleted case profileUpdated(fromProfile: Profile, toProfile: Profile) @@ -3574,7 +3610,8 @@ public enum RcvConnEvent: Decodable { case switchQueue(phase: SwitchPhase) case ratchetSync(syncStatus: RatchetSyncState) case verificationCodeReset - + case pqEnabled(enabled: Bool) + var text: String { switch self { case let .switchQueue(phase): @@ -3586,6 +3623,12 @@ public enum RcvConnEvent: Decodable { return ratchetSyncStatusToText(syncStatus) case .verificationCodeReset: return NSLocalizedString("security code changed", comment: "chat item text") + case let .pqEnabled(enabled): + if enabled { + return NSLocalizedString("quantum resistant e2e encryption", comment: "chat item text") + } else { + return NSLocalizedString("standard end-to-end encryption", comment: "chat item text") + } } } } @@ -3603,6 +3646,7 @@ func ratchetSyncStatusToText(_ ratchetSyncStatus: RatchetSyncState) -> String { public enum SndConnEvent: Decodable { case switchQueue(phase: SwitchPhase, member: GroupMemberRef?) case ratchetSync(syncStatus: RatchetSyncState, member: GroupMemberRef?) + case pqEnabled(enabled: Bool) var text: String { switch self { @@ -3626,6 +3670,12 @@ public enum SndConnEvent: Decodable { } } return ratchetSyncStatusToText(syncStatus) + case let .pqEnabled(enabled): + if enabled { + return NSLocalizedString("quantum resistant e2e encryption", comment: "chat item text") + } else { + return NSLocalizedString("standard end-to-end encryption", comment: "chat item text") + } } } } 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 21bfb1daa3..df1dec330d 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 @@ -1123,11 +1123,19 @@ data class Connection( val viaGroupLink: Boolean, val customUserProfileId: Long? = null, val connectionCode: SecurityCode? = null, + val pqSupport: Boolean, + val pqEncryption: Boolean, + val pqSndEnabled: Boolean? = null, + val pqRcvEnabled: Boolean? = null, val connectionStats: ConnectionStats? = null ) { val id: ChatId get() = ":$connId" + + val connPQEnabled: Boolean + get() = pqSndEnabled == true && pqRcvEnabled == true + companion object { - val sampleData = Connection(connId = 1, agentConnId = "abc", connStatus = ConnStatus.Ready, connLevel = 0, viaGroupLink = false, peerChatVRange = VersionRange(1, 1), customUserProfileId = null) + val sampleData = Connection(connId = 1, agentConnId = "abc", connStatus = ConnStatus.Ready, connLevel = 0, viaGroupLink = false, peerChatVRange = VersionRange(1, 1), customUserProfileId = null, pqSupport = false, pqEncryption = false) } } @@ -1853,6 +1861,10 @@ data class ChatItem ( is CIContent.SndModerated -> false is CIContent.RcvModerated -> false is CIContent.RcvBlocked -> false + is CIContent.SndDirectE2EEInfo -> false + is CIContent.RcvDirectE2EEInfo -> false + is CIContent.SndGroupE2EEInfo -> false + is CIContent.RcvGroupE2EEInfo -> false is CIContent.InvalidJSON -> false } @@ -2283,6 +2295,10 @@ sealed class CIContent: ItemContent { @Serializable @SerialName("sndModerated") object SndModerated: CIContent() { override val msgContent: MsgContent? get() = null } @Serializable @SerialName("rcvModerated") object RcvModerated: CIContent() { override val msgContent: MsgContent? get() = null } @Serializable @SerialName("rcvBlocked") object RcvBlocked: CIContent() { override val msgContent: MsgContent? get() = null } + @Serializable @SerialName("sndDirectE2EEInfo") class SndDirectE2EEInfo(val e2eeInfo: E2EEInfo): CIContent() { override val msgContent: MsgContent? get() = null } + @Serializable @SerialName("rcvDirectE2EEInfo") class RcvDirectE2EEInfo(val e2eeInfo: E2EEInfo): CIContent() { override val msgContent: MsgContent? get() = null } + @Serializable @SerialName("sndGroupE2EEInfo") class SndGroupE2EEInfo(val e2eeInfo: E2EEInfo): CIContent() { override val msgContent: MsgContent? get() = null } + @Serializable @SerialName("rcvGroupE2EEInfo") class RcvGroupE2EEInfo(val e2eeInfo: E2EEInfo): CIContent() { override val msgContent: MsgContent? get() = null } @Serializable @SerialName("invalidJSON") data class InvalidJSON(val json: String): CIContent() { override val msgContent: MsgContent? get() = null } override val text: String get() = when (this) { @@ -2312,6 +2328,10 @@ sealed class CIContent: ItemContent { is SndModerated -> generalGetString(MR.strings.moderated_description) is RcvModerated -> generalGetString(MR.strings.moderated_description) is RcvBlocked -> generalGetString(MR.strings.blocked_by_admin_item_description) + is SndDirectE2EEInfo -> directE2EEInfoToText(e2eeInfo) + is RcvDirectE2EEInfo -> directE2EEInfoToText(e2eeInfo) + is SndGroupE2EEInfo -> e2eeInfoNoPQText + is RcvGroupE2EEInfo -> e2eeInfoNoPQText is InvalidJSON -> "invalid data" } @@ -2330,6 +2350,15 @@ sealed class CIContent: ItemContent { } companion object { + fun directE2EEInfoToText(e2EEInfo: E2EEInfo): String = + if (e2EEInfo.pqEnabled) { + generalGetString(MR.strings.e2ee_info_pq) + } else { + e2eeInfoNoPQText + } + + private val e2eeInfoNoPQText: String = generalGetString(MR.strings.e2ee_info_no_pq) + fun featureText(feature: Feature, enabled: String, param: Int?): String = if (feature.hasParam) { "${feature.text}: ${timeText(param)}" @@ -2744,6 +2773,9 @@ enum class CIGroupInvitationStatus { @SerialName("expired") Expired; } +@Serializable +class E2EEInfo (val pqEnabled: Boolean) {} + object MsgContentSerializer : KSerializer { override val descriptor: SerialDescriptor = buildSerialDescriptor("MsgContent", PolymorphicKind.SEALED) { element("MCText", buildClassSerialDescriptor("MCText") { @@ -3097,6 +3129,7 @@ sealed class RcvConnEvent { @Serializable @SerialName("switchQueue") class SwitchQueue(val phase: SwitchPhase): RcvConnEvent() @Serializable @SerialName("ratchetSync") class RatchetSync(val syncStatus: RatchetSyncState): RcvConnEvent() @Serializable @SerialName("verificationCodeReset") object VerificationCodeReset: RcvConnEvent() + @Serializable @SerialName("pqEnabled") class PQEnabled(val enabled: Boolean): RcvConnEvent() val text: String get() = when (this) { is SwitchQueue -> when (phase) { @@ -3105,6 +3138,11 @@ sealed class RcvConnEvent { } is RatchetSync -> ratchetSyncStatusToText(syncStatus) is VerificationCodeReset -> generalGetString(MR.strings.rcv_conn_event_verification_code_reset) + is PQEnabled -> if (enabled) { + generalGetString(MR.strings.conn_event_enabled_pq) + } else { + generalGetString(MR.strings.conn_event_disabled_pq) + } } } @@ -3122,6 +3160,7 @@ fun ratchetSyncStatusToText(ratchetSyncStatus: RatchetSyncState): String { sealed class SndConnEvent { @Serializable @SerialName("switchQueue") class SwitchQueue(val phase: SwitchPhase, val member: GroupMemberRef? = null): SndConnEvent() @Serializable @SerialName("ratchetSync") class RatchetSync(val syncStatus: RatchetSyncState, val member: GroupMemberRef? = null): SndConnEvent() + @Serializable @SerialName("pqEnabled") class PQEnabled(val enabled: Boolean): SndConnEvent() val text: String get() = when (this) { @@ -3150,6 +3189,12 @@ sealed class SndConnEvent { } ratchetSyncStatusToText(syncStatus) } + + is PQEnabled -> if (enabled) { + generalGetString(MR.strings.conn_event_enabled_pq) + } else { + generalGetString(MR.strings.conn_event_disabled_pq) + } } } 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 1a20449695..d695b2c608 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 @@ -156,6 +156,7 @@ class AppPreferences { val confirmDBUpgrades = mkBoolPreference(SHARED_PREFS_CONFIRM_DB_UPGRADES, false) val selfDestruct = mkBoolPreference(SHARED_PREFS_SELF_DESTRUCT, false) val selfDestructDisplayName = mkStrPreference(SHARED_PREFS_SELF_DESTRUCT_DISPLAY_NAME, null) + val pqExperimentalEnabled = mkBoolPreference(SHARED_PREFS_PQ_EXPERIMENTAL_ENABLED, false) val currentTheme = mkStrPreference(SHARED_PREFS_CURRENT_THEME, DefaultTheme.SYSTEM.name) val systemDarkTheme = mkStrPreference(SHARED_PREFS_SYSTEM_DARK_THEME, DefaultTheme.SIMPLEX.name) @@ -312,6 +313,7 @@ class AppPreferences { private const val SHARED_PREFS_CONFIRM_DB_UPGRADES = "ConfirmDBUpgrades" private const val SHARED_PREFS_SELF_DESTRUCT = "LocalAuthenticationSelfDestruct" private const val SHARED_PREFS_SELF_DESTRUCT_DISPLAY_NAME = "LocalAuthenticationSelfDestructDisplayName" + private const val SHARED_PREFS_PQ_EXPERIMENTAL_ENABLED = "PQExperimentalEnabled" private const val SHARED_PREFS_CURRENT_THEME = "CurrentTheme" private const val SHARED_PREFS_SYSTEM_DARK_THEME = "SystemDarkTheme" private const val SHARED_PREFS_THEMES = "Themes" @@ -633,6 +635,15 @@ object ChatController { suspend fun apiSetEncryptLocalFiles(enable: Boolean) = sendCommandOkResp(null, CC.ApiSetEncryptLocalFiles(enable)) + suspend fun apiSetPQEncryption(enable: Boolean) = sendCommandOkResp(null, CC.ApiSetPQEncryption(enable)) + + suspend fun apiSetContactPQ(rh: Long?, contactId: Long, enable: Boolean): Contact? { + val r = sendCmd(rh, CC.ApiSetContactPQ(contactId, enable)) + if (r is CR.ContactPQAllowed) return r.contact + apiErrorAlert("apiSetContactPQ", "Error allowing contact PQ", r) + return null + } + suspend fun apiExportArchive(config: ArchiveConfig) { val r = sendCmd(null, CC.ApiExportArchive(config)) if (r is CR.CmdOk) return @@ -2016,6 +2027,10 @@ object ChatController { } } } + is CR.ContactPQEnabled -> + if (active(r.user)) { + chatModel.updateContact(rhId, r.contact) + } is CR.ChatCmdError -> when { r.chatError is ChatError.ChatErrorAgent && r.chatError.agentError is AgentErrorType.CRITICAL -> { chatModel.processedCriticalError.newError(r.chatError.agentError, r.chatError.agentError.offerRestart) @@ -2274,6 +2289,8 @@ sealed class CC { class SetFilesFolder(val filesFolder: String): CC() class SetRemoteHostsFolder(val remoteHostsFolder: String): CC() class ApiSetEncryptLocalFiles(val enable: Boolean): CC() + class ApiSetPQEncryption(val enable: Boolean): CC() + class ApiSetContactPQ(val contactId: Long, val enable: Boolean): CC() class ApiExportArchive(val config: ArchiveConfig): CC() class ApiImportArchive(val config: ArchiveConfig): CC() class ApiDeleteStorage: CC() @@ -2403,6 +2420,8 @@ sealed class CC { is SetFilesFolder -> "/_files_folder $filesFolder" is SetRemoteHostsFolder -> "/remote_hosts_folder $remoteHostsFolder" is ApiSetEncryptLocalFiles -> "/_files_encrypt ${onOff(enable)}" + is ApiSetPQEncryption -> "/pq ${onOff(enable)}" + is ApiSetContactPQ -> "/_pq @$contactId ${onOff(enable)}" is ApiExportArchive -> "/_db export ${json.encodeToString(config)}" is ApiImportArchive -> "/_db import ${json.encodeToString(config)}" is ApiDeleteStorage -> "/_db delete" @@ -2537,6 +2556,8 @@ sealed class CC { is SetFilesFolder -> "setFilesFolder" is SetRemoteHostsFolder -> "setRemoteHostsFolder" is ApiSetEncryptLocalFiles -> "apiSetEncryptLocalFiles" + is ApiSetPQEncryption -> "apiSetPQEncryption" + is ApiSetContactPQ -> "apiSetContactPQ" is ApiExportArchive -> "apiExportArchive" is ApiImportArchive -> "apiImportArchive" is ApiDeleteStorage -> "apiDeleteStorage" @@ -4002,6 +4023,10 @@ sealed class CR { @Serializable @SerialName("remoteCtrlSessionCode") class RemoteCtrlSessionCode(val remoteCtrl_: RemoteCtrlInfo?, val sessionCode: String): CR() @Serializable @SerialName("remoteCtrlConnected") class RemoteCtrlConnected(val remoteCtrl: RemoteCtrlInfo): CR() @Serializable @SerialName("remoteCtrlStopped") class RemoteCtrlStopped(val rcsState: RemoteCtrlSessionState, val rcStopReason: RemoteCtrlStopReason): CR() + // pq + @Serializable @SerialName("contactPQAllowed") class ContactPQAllowed(val user: UserRef, val contact: Contact, val pqEncryption: Boolean): CR() + @Serializable @SerialName("contactPQEnabled") class ContactPQEnabled(val user: UserRef, val contact: Contact, val pqEnabled: Boolean): CR() + // misc @Serializable @SerialName("versionInfo") class VersionInfo(val versionInfo: CoreVersionInfo, val chatMigrations: List, val agentMigrations: List): CR() @Serializable @SerialName("cmdOk") class CmdOk(val user: UserRef?): CR() @Serializable @SerialName("chatCmdError") class ChatCmdError(val user_: UserRef?, val chatError: ChatError): CR() @@ -4151,6 +4176,8 @@ sealed class CR { is RemoteCtrlSessionCode -> "remoteCtrlSessionCode" is RemoteCtrlConnected -> "remoteCtrlConnected" is RemoteCtrlStopped -> "remoteCtrlStopped" + is ContactPQAllowed -> "contactPQAllowed" + is ContactPQEnabled -> "contactPQEnabled" is VersionInfo -> "versionInfo" is CmdOk -> "cmdOk" is ChatCmdError -> "chatCmdError" @@ -4315,6 +4342,8 @@ sealed class CR { "\nsessionCode: $sessionCode" is RemoteCtrlConnected -> json.encodeToString(remoteCtrl) is RemoteCtrlStopped -> noDetails() + is ContactPQAllowed -> withUser(user, "contact: ${contact.id}\npqEncryption: $pqEncryption") + is ContactPQEnabled -> withUser(user, "contact: ${contact.id}\npqEnabled: $pqEnabled") is VersionInfo -> "version ${json.encodeToString(versionInfo)}\n\n" + "chat migrations: ${json.encodeToString(chatMigrations.map { it.upName })}\n\n" + "agent migrations: ${json.encodeToString(agentMigrations.map { it.upName })}" diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt index 7a7c2d7f24..7e2ba462c9 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt @@ -92,6 +92,7 @@ suspend fun initChatController(useKey: String? = null, confirmMigrations: Migrat controller.apiSetRemoteHostsFolder(remoteHostsDir.absolutePath) } controller.apiSetEncryptLocalFiles(controller.appPrefs.privacyEncryptLocalFiles.get()) + controller.apiSetPQEncryption(controller.appPrefs.pqExperimentalEnabled.get()) // If we migrated successfully means previous re-encryption process on database level finished successfully too if (appPreferences.encryptionStartedAt.get() != null) appPreferences.encryptionStartedAt.set(null) val user = chatController.apiGetActiveUser(null) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt index f195c723f6..bbd5d93018 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt @@ -58,6 +58,7 @@ fun ChatInfoView( val currentUser = remember { chatModel.currentUser }.value val connStats = remember(contact.id, connectionStats) { mutableStateOf(connectionStats) } val developerTools = chatModel.controller.appPrefs.developerTools.get() + val pqExperimentalEnabled = chatModel.controller.appPrefs.pqExperimentalEnabled.get() if (chat != null && currentUser != null) { val contactNetworkStatus = remember(chatModel.networkStatuses.toMap(), contact) { mutableStateOf(chatModel.contactNetworkStatus(contact)) @@ -80,6 +81,7 @@ fun ChatInfoView( localAlias, connectionCode, developerTools, + pqExperimentalEnabled, onLocalAliasChanged = { setContactAlias(chat, it, chatModel) }, @@ -138,6 +140,17 @@ fun ChatInfoView( } }) }, + allowContactPQ = { + showAllowContactPQAlert(allowContactPQ = { + withBGApi { + val ct = chatModel.controller.apiSetContactPQ(chatRh, contact.contactId, true) + if (ct != null) { + chatModel.updateContact(chatRh, contact) + } + close.invoke() + } + }) + }, verifyClicked = { ModalManager.end.showModalCloseable { close -> remember { derivedStateOf { (chatModel.getContactChat(contact.contactId)?.chatInfo as? ChatInfo.Direct)?.contact } }.value?.let { ct -> @@ -288,6 +301,7 @@ fun ChatInfoLayout( localAlias: String, connectionCode: String?, developerTools: Boolean, + pqExperimentalEnabled: Boolean, onLocalAliasChanged: (String) -> Unit, openPreferences: () -> Unit, deleteContact: () -> Unit, @@ -296,6 +310,7 @@ fun ChatInfoLayout( abortSwitchContactAddress: () -> Unit, syncContactConnection: () -> Unit, syncContactConnectionForce: () -> Unit, + allowContactPQ: () -> Unit, verifyClicked: () -> Unit, ) { val cStats = connStats.value @@ -345,6 +360,18 @@ fun ChatInfoLayout( SectionDividerSpaced() } + val conn = contact.activeConn + if (pqExperimentalEnabled && conn != null) { + SectionView("Quantum resistant E2E encryption") { + InfoRow("E2E encryption", if (conn.connPQEnabled) "Quantum resistant" else "Standard") + if (!conn.pqEncryption) { + AllowContactPQButton(allowContactPQ) + SectionTextFooter("After allowing quantum resistant e2e encryption, it will be enabled after several messages if your contact also allows it.") + } + SectionDividerSpaced() + } + } + if (contact.contactLink != null) { SectionView(stringResource(MR.strings.address_section_title).uppercase()) { SimpleXLinkQRCode(contact.contactLink) @@ -601,6 +628,17 @@ fun SynchronizeConnectionButtonForce(syncConnectionForce: () -> Unit) { ) } +@Composable +fun AllowContactPQButton(allowContactPQ: () -> Unit) { + SettingsActionItem( + painterResource(MR.images.ic_warning), + "Allow PQ encryption", + click = allowContactPQ, + textColor = WarningOrange, + iconColor = WarningOrange + ) +} + @Composable fun VerifyCodeButton(contactVerified: Boolean, onClick: () -> Unit) { SettingsActionItem( @@ -704,6 +742,16 @@ fun showSyncConnectionForceAlert(syncConnectionForce: () -> Unit) { ) } +fun showAllowContactPQAlert(allowContactPQ: () -> Unit) { + AlertManager.shared.showAlertDialog( + title = "Allow quantum resistant encryption?", + text = "This is an experimental feature, it is not recommended to enable it for important chats.", + confirmText = "Allow", + onConfirm = allowContactPQ, + destructive = true, + ) +} + @Preview @Composable fun PreviewChatInfoLayout() { @@ -721,6 +769,7 @@ fun PreviewChatInfoLayout() { localAlias = "", connectionCode = "123", developerTools = false, + pqExperimentalEnabled = false, connStats = remember { mutableStateOf(null) }, contactNetworkStatus = NetworkStatus.Connected(), onLocalAliasChanged = {}, @@ -732,6 +781,7 @@ fun PreviewChatInfoLayout() { abortSwitchContactAddress = {}, syncContactConnection = {}, syncContactConnectionForce = {}, + allowContactPQ = {}, verifyClicked = {}, ) } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt index ccb9683240..cce4307d1f 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt @@ -452,6 +452,11 @@ fun ChatItemView( is CIContent.SndModerated -> DeletedItem() is CIContent.RcvModerated -> DeletedItem() is CIContent.RcvBlocked -> DeletedItem() + // TODO proper items + is CIContent.SndDirectE2EEInfo -> CIEventView(buildAnnotatedString { append(cItem.content.text) }) + is CIContent.RcvDirectE2EEInfo -> CIEventView(buildAnnotatedString { append(cItem.content.text) }) + is CIContent.SndGroupE2EEInfo -> CIEventView(buildAnnotatedString { append(cItem.content.text) }) + is CIContent.RcvGroupE2EEInfo -> CIEventView(buildAnnotatedString { append(cItem.content.text) }) is CIContent.InvalidJSON -> CIInvalidJSONView(c.json) } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt index cc268e9a9d..421d4feec3 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt @@ -58,6 +58,14 @@ fun DeveloperView( SettingsPreferenceItem(painterResource(MR.images.ic_report), stringResource(MR.strings.show_internal_errors), appPreferences.showInternalErrors) SettingsPreferenceItem(painterResource(MR.images.ic_avg_pace), stringResource(MR.strings.show_slow_api_calls), appPreferences.showSlowApiCalls) } + + SectionSpacer() + SectionView("Experimental".uppercase()) { + SettingsPreferenceItem(painterResource(MR.images.ic_vpn_key_filled), "Post-quantum E2EE", m.controller.appPrefs.pqExperimentalEnabled, onChange = { enable -> + withBGApi { m.controller.apiSetPQEncryption(enable) } + }) + SectionTextFooter("In this version applies only to new contacts.") + } } SectionBottomSpacer() } diff --git a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml index 7288d88431..49552a592d 100644 --- a/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml +++ b/apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml @@ -54,6 +54,9 @@ Decryption error Encryption re-negotiation error + This conversation is protected by end-to-end encryption with perfect forward secrecy, repudiation and break-in recovery. + This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery. + Private notes @@ -1239,6 +1242,8 @@ agreeing encryption for %s… encryption agreed for %s security code changed + quantum resistant e2e encryption + standard end-to-end encryption observer diff --git a/cabal.project b/cabal.project index ede8f8be2b..3916c9fb6d 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 246a0d10c22ebe02af2eb34773b77cce10247459 + tag: 78eb4f764fd52385a8687d2605a0e6edc1808431 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 394cf11260..c7678d1201 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."246a0d10c22ebe02af2eb34773b77cce10247459" = "0kx5swx1g9jimg7ks008nqzvkyx5x9irjkjwvgwrd3km5g0wnzf4"; + "https://github.com/simplex-chat/simplexmq.git"."78eb4f764fd52385a8687d2605a0e6edc1808431" = "09nmrk65nbn6mp8mwwk09d5zx9cgm38i6xgmndk6jzlhnfl5fiy6"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 865d3d718c..63f66ca561 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -137,6 +137,7 @@ library Simplex.Chat.Migrations.M20240214_redirect_file_id Simplex.Chat.Migrations.M20240222_app_settings Simplex.Chat.Migrations.M20240226_users_restrict + Simplex.Chat.Migrations.M20240228_pq Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 21be1b1f86..56914d2d9d 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -22,6 +22,7 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Unlift import Control.Monad.Reader +import Crypto.Random (ChaChaDRG) import qualified Data.Aeson as J import Data.Attoparsec.ByteString.Char8 (Parser) import qualified Data.Attoparsec.ByteString.Char8 as A @@ -97,9 +98,12 @@ import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Client (defaultNetworkConfig) +import Simplex.Messaging.Compression (withCompressCtx) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKNoPQ, pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) +import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (base64P) @@ -243,6 +247,7 @@ newChatController encryptLocalFiles <- newTVarIO False tempDirectory <- newTVarIO Nothing contactMergeEnabled <- newTVarIO True + pqExperimentalEnabled <- newTVarIO PQSupportOff pure ChatController { firstTime, @@ -278,7 +283,8 @@ newChatController encryptLocalFiles, tempDirectory, logFilePath = logFile, - contactMergeEnabled + contactMergeEnabled, + pqExperimentalEnabled } where configServers :: DefaultAgentServers @@ -365,7 +371,7 @@ subscribeUsers onlyNeeded users = do subscribe vr us subscribe vr us' where - subscribe :: VersionRange -> [User] -> m () + subscribe :: (PQSupport -> VersionRangeChat) -> [User] -> m () subscribe vr = mapM_ $ runExceptT . subscribeUserConnections vr onlyNeeded Agent.subscribeConnections startFilesToReceive :: forall m. ChatMonad' m => [User] -> m () @@ -443,10 +449,11 @@ parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace -- | Chat API commands interpreted in context of a local zone processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse -processChatCommand cmd = chatVersionRange >>= (`processChatCommand'` cmd) +processChatCommand cmd = + chatVersionRange >>= (`processChatCommand'` cmd) {-# INLINE processChatCommand #-} -processChatCommand' :: forall m. ChatMonad m => VersionRange -> ChatCommand -> m ChatResponse +processChatCommand' :: forall m. ChatMonad m => (PQSupport -> VersionRangeChat) -> ChatCommand -> m ChatResponse processChatCommand' vr = \case ShowActiveUser -> withUser' $ pure . CRActiveUser CreateActiveUser NewUser {profile, sameServers, pastTimestamp} -> do @@ -586,9 +593,21 @@ processChatCommand' vr = \case chatWriteVar remoteHostsFolder $ Just rf ok_ APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_ - SetContactMergeEnabled onOff -> do - asks contactMergeEnabled >>= atomically . (`writeTVar` onOff) - ok_ + SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_ + APISetPQEncryption onOff -> chatWriteVar pqExperimentalEnabled onOff >> ok_ + APISetContactPQ ctId pqEnc -> withUser $ \user -> do + ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user ctId + case activeConn of + Just conn@Connection {connId, pqSupport, pqEncryption} + | pqEncryption == pqEnc -> pure $ CRContactPQAllowed user ct pqEnc + | otherwise -> do + let pqSup = PQSupport $ pqEnc == PQEncOn || pqSupport == PQSupportOn + conn' = conn {pqSupport = pqSup, pqEncryption = pqEnc} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact + withStore' $ \db -> updateConnSupportPQ db connId pqSup pqEnc + pure $ CRContactPQAllowed user ct' pqEnc + Nothing -> throwChatError $ CEContactNotActive ct + SetContactPQ cName pqEnc -> withContactName cName (`APISetContactPQ` pqEnc) APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_ ExportArchive -> do ts <- liftIO getCurrentTime @@ -624,7 +643,7 @@ processChatCommand' vr = \case APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of -- TODO optimize queries calculating ChatStats, currently they're disabled CTDirect -> do - directChat <- withStore (\db -> getDirectChat db user cId pagination search) + directChat <- withStore (\db -> getDirectChat db vr user cId pagination search) pure $ CRApiChat user (AChat SCTDirect directChat) CTGroup -> do groupChat <- withStore (\db -> getGroupChat db vr user cId pagination search) @@ -650,7 +669,7 @@ processChatCommand' vr = \case pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses} APISendMessage (ChatRef cType chatId) live itemTTL (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user -> withChatLock "sendMessage" $ case cType of CTDirect -> do - ct@Contact {contactId, contactUsed} <- withStore $ \db -> getContact db user chatId + ct@Contact {contactId, contactUsed} <- withStore $ \db -> getContact db vr user chatId assertDirectAllowed user MDSnd ct XMsgNew_ unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct if isVoice mc && not (featureAllowed SCFVoice forUser ct) @@ -659,7 +678,7 @@ processChatCommand' vr = \case (fInv_, ciFile_) <- L.unzip <$> setupSndFileTransfer ct timed_ <- sndContactCITimed live ct itemTTL (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ - (msg, _) <- sendDirectContactMessage ct (XMsgNew msgContainer) + (msg, _) <- sendDirectContactMessage user ct (XMsgNew msgContainer) ci <- saveSndChatItem' user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live forM_ (timed_ >>= timedDeleteAt') $ startProximateTimedItemThread user (ChatRef CTDirect contactId, chatItemId' ci) @@ -748,7 +767,7 @@ processChatCommand' vr = \case pure . CRNewChatItem user $ AChatItem SCTLocal SMDSnd (LocalChat nf) ci APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of CTDirect -> do - ct@Contact {contactId} <- withStore $ \db -> getContact db user chatId + ct@Contact {contactId} <- withStore $ \db -> getContact db vr user chatId assertDirectAllowed user MDSnd ct XMsgUpdate_ cci <- withStore $ \db -> getDirectCIWithReactions db user ct itemId case cci of @@ -758,7 +777,7 @@ processChatCommand' vr = \case let changed = mc /= oldMC if changed || fromMaybe False itemLive then do - (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XMsgUpdate itemSharedMId mc (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive)) ci' <- withStore' $ \db -> do currentTs <- liftIO getCurrentTime when changed $ @@ -806,12 +825,12 @@ processChatCommand' vr = \case CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of CTDirect -> do - (ct, CChatItem msgDir ci@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 vr 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) + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XMsgDel itemSharedMId Nothing) if featureAllowed SCFFullDelete forUser ct then deleteDirectCI user ct ci True False else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime @@ -843,7 +862,7 @@ processChatCommand' vr = \case (_, _) -> throwChatError CEInvalidChatItemDelete APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> withChatLock "chatItemReaction" $ case cType of CTDirect -> - withStore (\db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId) >>= \case + withStore (\db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId) >>= \case (ct, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do unless (featureAllowed SCFReactions forUser ct) $ throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)) @@ -851,7 +870,7 @@ processChatCommand' vr = \case throwChatError (CECommandError "reaction not allowed - chat item has no content") rs <- withStore' $ \db -> getDirectReactions db ct itemSharedMId True checkReactionAllowed rs - (SndMessage {msgId}, _) <- sendDirectContactMessage ct $ XMsgReact itemSharedMId Nothing reaction add + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct $ XMsgReact itemSharedMId Nothing reaction add createdAt <- liftIO getCurrentTime reactions <- withStore' $ \db -> do setDirectReaction db ct itemSharedMId True reaction add msgId createdAt @@ -920,7 +939,7 @@ processChatCommand' vr = \case APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of CTDirect -> do withStore $ \db -> do - ct <- getContact db user chatId + ct <- getContact db vr user chatId liftIO $ updateContactUnreadChat db user ct unreadChat ok user CTGroup -> do @@ -936,14 +955,14 @@ processChatCommand' vr = \case _ -> pure $ chatCmdError (Just user) "not supported" APIDeleteChat (ChatRef cType chatId) notify -> withUser $ \user@User {userId} -> case cType of CTDirect -> do - ct <- withStore $ \db -> getContact db user chatId + ct <- withStore $ \db -> getContact db vr user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct withChatLock "deleteChat direct" . procCmd $ do cancelFilesInProgress user filesInfo deleteFilesLocally filesInfo let doSendDel = contactReady ct && contactActive ct && notify - when doSendDel $ void (sendDirectContactMessage ct XDirectDel) `catchChatError` const (pure ()) - contactConnIds <- map aConnId <$> withStore' (\db -> getContactConnections db userId ct) + when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ()) + contactConnIds <- map aConnId <$> withStore' (\db -> getContactConnections db vr userId ct) deleteAgentConnectionsAsync' user contactConnIds doSendDel -- functions below are called in separate transactions to prevent crashes on android -- (possibly, race condition on integrity check?) @@ -984,7 +1003,7 @@ processChatCommand' vr = \case where deleteUnusedContact :: DB.Connection -> ContactId -> IO (Either ChatError (Maybe StoreError, [ConnId])) deleteUnusedContact db contactId = runExceptT . withExceptT ChatErrorStore $ do - ct <- getContact db user contactId + ct <- getContact db vr user contactId ifM ((directOrUsed ct ||) . isJust <$> liftIO (checkContactHasGroups db user ct)) (pure (Nothing, [])) @@ -992,14 +1011,14 @@ processChatCommand' vr = \case where getConnections :: Contact -> ExceptT StoreError IO (Maybe StoreError, [ConnId]) getConnections ct = do - conns <- liftIO $ getContactConnections db userId ct + conns <- liftIO $ getContactConnections db vr userId ct e_ <- (setContactDeleted db user ct $> Nothing) `catchStoreError` (pure . Just) pure (e_, map aConnId conns) CTLocal -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" APIClearChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of CTDirect -> do - ct <- withStore $ \db -> getContact db user chatId + ct <- withStore $ \db -> getContact db vr user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct cancelFilesInProgress user filesInfo deleteFilesLocally filesInfo @@ -1011,7 +1030,7 @@ processChatCommand' vr = \case cancelFilesInProgress user filesInfo deleteFilesLocally filesInfo withStore' $ \db -> deleteGroupCIs db user gInfo - membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo + membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db vr user gInfo forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo) CTLocal -> do @@ -1041,7 +1060,7 @@ processChatCommand' vr = \case pure $ CRContactRequestRejected user cReq APISendCallInvitation contactId callType -> withUser $ \user -> do -- party initiating call - ct <- withStore $ \db -> getContact db user contactId + ct <- withStore $ \db -> getContact db vr user contactId assertDirectAllowed user MDSnd ct XCallInv_ if featureAllowed SCFCalls forUser ct then do @@ -1052,7 +1071,7 @@ processChatCommand' vr = \case dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair} callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair} - (msg, _) <- sendDirectContactMessage ct (XCallInv callId invitation) + (msg, _) <- sendDirectContactMessage user ct (XCallInv callId invitation) ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0) let call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci} call_ <- atomically $ TM.lookupInsert contactId call' calls @@ -1079,7 +1098,7 @@ processChatCommand' vr = \case offer = CallOffer {callType, rtcSession, callDhPubKey} callState' = CallOfferSent {localCallType = callType, peerCallType, localCallSession = rtcSession, sharedKey} aciContent = ACIContent SMDRcv $ CIRcvCall CISCallAccepted 0 - (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallOffer callId offer) + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallOffer callId offer) withStore' $ \db -> updateDirectChatItemsRead db user contactId $ Just (chatItemId, chatItemId) updateDirectChatItemView user ct chatItemId aciContent False $ Just msgId pure $ Just call {callState = callState'} @@ -1090,28 +1109,28 @@ processChatCommand' vr = \case CallOfferReceived {localCallType, peerCallType, peerCallSession, sharedKey} -> do let callState' = CallNegotiated {localCallType, peerCallType, localCallSession = rtcSession, peerCallSession, sharedKey} aciContent = ACIContent SMDSnd $ CISndCall CISCallNegotiated 0 - (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallAnswer callId CallAnswer {rtcSession}) + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallAnswer callId CallAnswer {rtcSession}) updateDirectChatItemView user ct chatItemId aciContent False $ Just msgId pure $ Just call {callState = callState'} _ -> throwChatError . CECallState $ callStateTag callState APISendCallExtraInfo contactId rtcExtraInfo -> -- any call party - withCurrentCall contactId $ \_ ct call@Call {callId, callState} -> case callState of + withCurrentCall contactId $ \user ct call@Call {callId, callState} -> case callState of CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} -> do -- TODO update the list of ice servers in localCallSession - void . sendDirectContactMessage ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} + void . sendDirectContactMessage user ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} let callState' = CallOfferSent {localCallType, peerCallType, localCallSession, sharedKey} pure $ Just call {callState = callState'} CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} -> do -- TODO update the list of ice servers in localCallSession - void . sendDirectContactMessage ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} + void . sendDirectContactMessage user ct $ XCallExtra callId CallExtraInfo {rtcExtraInfo} let callState' = CallNegotiated {localCallType, peerCallType, localCallSession, peerCallSession, sharedKey} pure $ Just call {callState = callState'} _ -> throwChatError . CECallState $ callStateTag callState APIEndCall contactId -> -- any call party withCurrentCall contactId $ \user ct call@Call {callId} -> do - (SndMessage {msgId}, _) <- sendDirectContactMessage ct (XCallEnd callId) + (SndMessage {msgId}, _) <- sendDirectContactMessage user ct (XCallEnd callId) updateCallItemStatus user ct call WCSDisconnected $ Just msgId pure Nothing APIGetCallInvitations -> withUser $ \_ -> do @@ -1125,7 +1144,7 @@ processChatCommand' vr = \case _ -> Nothing rcvCallInvitation (contactId, callTs, peerCallType, sharedKey) = runExceptT . withStore $ \db -> do user <- getUserByContactId db contactId - contact <- getContact db user contactId + contact <- getContact db vr user contactId pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callTs} APIGetNetworkStatuses -> withUser $ \_ -> CRNetworkStatuses Nothing . map (uncurry ConnNetworkStatus) . M.toList <$> chatReadVar connNetworkStatuses @@ -1134,11 +1153,11 @@ processChatCommand' vr = \case updateCallItemStatus user ct call receivedStatus Nothing $> Just call APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile) APISetContactPrefs contactId prefs' -> withUser $ \user -> do - ct <- withStore $ \db -> getContact db user contactId + ct <- withStore $ \db -> getContact db vr user contactId updateContactPrefs user ct prefs' APISetContactAlias contactId localAlias -> withUser $ \user@User {userId} -> do ct' <- withStore $ \db -> do - ct <- getContact db user contactId + ct <- getContact db vr user contactId liftIO $ updateContactAlias db userId ct localAlias pure $ CRContactAliasUpdated user ct' APISetConnectionAlias connId localAlias -> withUser $ \user@User {userId} -> do @@ -1213,7 +1232,7 @@ processChatCommand' vr = \case APISetChatSettings (ChatRef cType chatId) chatSettings -> withUser $ \user -> case cType of CTDirect -> do ct <- withStore $ \db -> do - ct <- getContact db user chatId + ct <- getContact db vr user chatId liftIO $ updateContactSettings db user chatId chatSettings pure ct forM_ (contactConnId ct) $ \connId -> @@ -1231,13 +1250,13 @@ processChatCommand' vr = \case APISetMemberSettings gId gMemberId settings -> withUser $ \user -> do m <- withStore $ \db -> do liftIO $ updateGroupMemberSettings db user gId gMemberId settings - getGroupMember db user gId gMemberId + getGroupMember db vr user gId gMemberId let ntfOn = showMessages $ memberSettings m toggleNtf user m ntfOn ok user APIContactInfo contactId -> withUser $ \user@User {userId} -> do -- [incognito] print user's incognito profile for this contact - ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user contactId incognitoProfile <- case activeConn of Nothing -> pure Nothing Just Connection {customUserProfileId} -> @@ -1248,55 +1267,55 @@ processChatCommand' vr = \case (g, s) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> liftIO (getGroupSummary db user gId) pure $ CRGroupInfo user g s APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m) pure $ CRGroupMemberInfo user g m connectionStats APISwitchContact contactId -> withUser $ \user -> do - ct <- withStore $ \db -> getContact db user contactId + ct <- withStore $ \db -> getContact db vr user contactId case contactConnId ct of Just connId -> do connectionStats <- withAgent $ \a -> switchConnectionAsync a "" connId pure $ CRContactSwitchStarted user ct connectionStats Nothing -> throwChatError $ CEContactNotActive ct APISwitchGroupMember gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId case memberConnId m of Just connId -> do connectionStats <- withAgent (\a -> switchConnectionAsync a "" connId) pure $ CRGroupMemberSwitchStarted user g m connectionStats _ -> throwChatError CEGroupMemberNotActive APIAbortSwitchContact contactId -> withUser $ \user -> do - ct <- withStore $ \db -> getContact db user contactId + ct <- withStore $ \db -> getContact db vr user contactId case contactConnId ct of Just connId -> do connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId pure $ CRContactSwitchAborted user ct connectionStats Nothing -> throwChatError $ CEContactNotActive ct APIAbortSwitchGroupMember gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId case memberConnId m of Just connId -> do connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId pure $ CRGroupMemberSwitchAborted user g m connectionStats _ -> throwChatError CEGroupMemberNotActive APISyncContactRatchet contactId force -> withUser $ \user -> withChatLock "syncContactRatchet" $ do - ct <- withStore $ \db -> getContact db user contactId - case contactConnId ct of - Just connId -> do - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId force + ct <- withStore $ \db -> getContact db vr user contactId + case contactConn ct of + Just conn@Connection {pqSupport} -> do + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (aConnId conn) pqSupport force createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing pure $ CRContactRatchetSyncStarted user ct cStats Nothing -> throwChatError $ CEContactNotActive ct APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> withChatLock "syncGroupMemberRatchet" $ do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId case memberConnId m of Just connId -> do - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId force + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId PQSupportOff force createInternalChatItem user (CDGroupSnd g) (CISndConnEvent . SCERatchetSync rss . Just $ groupMemberRef m) Nothing pure $ CRGroupMemberRatchetSyncStarted user g m cStats _ -> throwChatError CEGroupMemberNotActive APIGetContactCode contactId -> withUser $ \user -> do - ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user contactId case activeConn of Just conn@Connection {connId} -> do code <- getConnectionCode $ aConnId conn @@ -1310,7 +1329,7 @@ processChatCommand' vr = \case pure $ CRContactCode user ct' code Nothing -> throwChatError $ CEContactNotActive ct APIGetGroupMemberCode gId gMemberId -> withUser $ \user -> do - (g, m@GroupMember {activeConn}) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId + (g, m@GroupMember {activeConn}) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId case activeConn of Just conn@Connection {connId} -> do code <- getConnectionCode $ aConnId conn @@ -1324,24 +1343,24 @@ processChatCommand' vr = \case pure $ CRGroupMemberCode user g m' code _ -> throwChatError CEGroupMemberNotActive APIVerifyContact contactId code -> withUser $ \user -> do - ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user contactId case activeConn of Just conn -> verifyConnectionCode user conn code Nothing -> throwChatError $ CEContactNotActive ct APIVerifyGroupMember gId gMemberId code -> withUser $ \user -> do - GroupMember {activeConn} <- withStore $ \db -> getGroupMember db user gId gMemberId + GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user gId gMemberId case activeConn of Just conn -> verifyConnectionCode user conn code _ -> throwChatError CEGroupMemberNotActive APIEnableContact contactId -> withUser $ \user -> do - ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user contactId case activeConn of Just conn -> do withStore' $ \db -> setConnectionAuthErrCounter db user conn 0 ok user Nothing -> throwChatError $ CEContactNotActive ct APIEnableGroupMember gId gMemberId -> withUser $ \user -> do - GroupMember {activeConn} <- withStore $ \db -> getGroupMember db user gId gMemberId + GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user gId gMemberId case activeConn of Just conn -> do withStore' $ \db -> setConnectionAuthErrCounter db user conn 0 @@ -1352,7 +1371,7 @@ processChatCommand' vr = \case SetShowMemberMessages gName mName showMessages -> withUser $ \user -> do (gId, mId) <- getGroupAndMemberId user gName mName gInfo <- withStore $ \db -> getGroupInfo db vr user gId - m <- withStore $ \db -> getGroupMember db user gId mId + m <- withStore $ \db -> getGroupMember db vr user gId mId let GroupInfo {membership = GroupMember {memberRole = membershipRole}} = gInfo when (membershipRole >= GRAdmin) $ throwChatError $ CECantBlockMemberForSelf gInfo m showMessages let settings = (memberSettings m) {showMessages} @@ -1380,8 +1399,10 @@ processChatCommand' vr = \case -- [incognito] generate profile for connection incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing subMode <- chatReadVar subscriptionMode - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode - conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile subMode + pqSup <- chatReadVar pqExperimentalEnabled + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing (IKNoPQ pqSup) subMode + -- TODO PQ pass minVersion from the current range + conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile subMode initialChatVersion pqSup pure $ CRInvitation user cReq conn AddContact incognito -> withUser $ \User {userId} -> processChatCommand $ APIAddContact userId incognito @@ -1408,10 +1429,16 @@ processChatCommand' vr = \case -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing False - dm <- directMessage $ XInfo profileToSend - connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode - conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode - pure $ CRSentConfirmation user conn + pqSup <- chatReadVar pqExperimentalEnabled + withAgent' (\a -> connRequestPQSupport a pqSup cReq) >>= \case + Nothing -> throwChatError CEInvalidConnReq + -- TODO PQ the error above should be CEIncompatibleConnReqVersion, also the same API should be called in Plan + Just (agentV, pqSup') -> do + let chatV = agentToChatVersion agentV + dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend + connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup' subMode + conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode chatV pqSup' + pure $ CRSentConfirmation user conn APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do @@ -1423,7 +1450,7 @@ processChatCommand' vr = \case _ -> processChatCommand $ APIConnect userId incognito aCReqUri Connect _ Nothing -> throwChatError CEInvalidConnReq APIConnectContactViaAddress userId incognito contactId -> withUserId userId $ \user -> do - ct@Contact {activeConn, profile = LocalProfile {contactLink}} <- withStore $ \db -> getContact db user contactId + ct@Contact {activeConn, profile = LocalProfile {contactLink}} <- withStore $ \db -> getContact db vr user contactId when (isJust activeConn) $ throwChatError (CECommandError "contact already has connection") case contactLink of Just cReq -> connectContactViaAddress user incognito ct cReq @@ -1439,18 +1466,19 @@ processChatCommand' vr = \case DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect APIListContacts userId -> withUserId userId $ \user -> - CRContactsList user <$> withStore' (`getUserContacts` user) + CRContactsList user <$> withStore' (\db -> getUserContacts db vr user) ListContacts -> withUser $ \User {userId} -> processChatCommand $ APIListContacts userId APICreateMyAddress userId -> withUserId userId $ \user -> withChatLock "createMyAddress" . procCmd $ do subMode <- chatReadVar subscriptionMode - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing subMode + -- TODO v5.7 pass IPPQOn + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing IKPQOff subMode withStore $ \db -> createUserContactLink db user connId cReq subMode pure $ CRUserContactLinkCreated user cReq CreateMyAddress -> withUser $ \User {userId} -> processChatCommand $ APICreateMyAddress userId APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do - conns <- withStore (`getUserAddressConnections` user) + conns <- withStore $ \db -> getUserAddressConnections db vr user withChatLock "deleteMyAddress" $ do deleteAgentConnectionsAsync user $ map aConnId conns withStore' (`deleteUserAddress` user) @@ -1516,7 +1544,7 @@ processChatCommand' vr = \case _ -> throwChatError $ CECommandError "not supported" SendMemberContactMessage gName mName msg -> withUser $ \user -> do (gId, mId) <- getGroupAndMemberId user gName mName - m <- withStore $ \db -> getGroupMember db user gId mId + m <- withStore $ \db -> getGroupMember db vr user gId mId let mc = MCText msg case memberContactId m of Nothing -> do @@ -1535,7 +1563,7 @@ processChatCommand' vr = \case let mc = MCText msg processChatCommand . APISendMessage chatRef True Nothing $ ComposedMessage Nothing Nothing mc SendMessageBroadcast msg -> withUser $ \user -> do - contacts <- withStore' (`getUserContacts` user) + contacts <- withStore' $ \db -> getUserContacts db vr user let cts = filter (\ct -> contactReady ct && contactActive ct && directOrUsed ct) contacts ChatConfig {logLevel} <- asks config withChatLock "sendMessageBroadcast" . procCmd $ do @@ -1547,7 +1575,7 @@ processChatCommand' vr = \case sendAndCount user ll (s, f) ct = (sendToContact user ct $> (s + 1, f)) `catchChatError` \e -> when (ll <= CLLInfo) (toView $ CRChatError (Just user) e) $> (s, f + 1) sendToContact user ct = do - (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) + (sndMsg, _) <- sendDirectContactMessage user ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) void $ saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do contactId <- withStore $ \db -> getContactIdByName db user cName @@ -1581,12 +1609,13 @@ processChatCommand' vr = \case -- [incognito] generate incognito profile for group membership incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing groupInfo <- withStore $ \db -> createNewGroup db vr gVar user gProfile incognitoProfile + createInternalChatItem user (CDGroupSnd groupInfo) (CISndGroupE2EEInfo $ E2EInfo {pqEnabled = PQEncOff}) Nothing pure $ CRGroupCreated user groupInfo NewGroup incognito gProfile -> withUser $ \User {userId} -> processChatCommand $ APINewGroup userId incognito gProfile APIAddMember groupId contactId memRole -> withUser $ \user -> withChatLock "addMember" $ do -- TODO for large groups: no need to load all members to determine if contact is a member - (group, contact) <- withStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db user contactId + (group, contact) <- withStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db vr user contactId assertDirectAllowed user MDSnd contact XGrpInv_ let Group gInfo members = group Contact {localDisplayName = cName} = contact @@ -1600,7 +1629,7 @@ processChatCommand' vr = \case Nothing -> do gVar <- asks random subMode <- chatReadVar subscriptionMode - (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode + (agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode member <- withStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode sendInvitation member cReq pure $ CRSentGroupInvitation user gInfo contact member @@ -1617,17 +1646,18 @@ processChatCommand' vr = \case withChatLock "joinGroup" . procCmd $ do (invitation, ct) <- withStore $ \db -> do inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db vr user groupId - (inv,) <$> getContactViaMember db user fromMember + (inv,) <$> getContactViaMember db vr user fromMember let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} = invitation GroupMember {memberId = membershipMemId} = membership Contact {activeConn} = ct case activeConn of Just Connection {peerChatVRange} -> do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt membershipMemId - agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode + dm <- encodeConnInfo $ XGrpAcpt membershipMemId + agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm PQSupportOff subMode + let chatV = vr PQSupportOff `peerConnChatVersion` peerChatVRange withStore' $ \db -> do - createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode + createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode updateGroupMemberStatus db userId fromMember GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` \_ -> pure () @@ -1649,7 +1679,7 @@ processChatCommand' vr = \case withStore' $ \db -> updateGroupMemberRole db user m memRole case mStatus of GSMemInvited -> do - withStore (\db -> (,) <$> mapM (getContact db user) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case + withStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case (Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName _ -> do @@ -1675,7 +1705,7 @@ processChatCommand' vr = \case toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) bm' <- withStore $ \db -> do liftIO $ updateGroupMemberBlocked db user groupId memberId mrs - getGroupMember db user groupId memberId + getGroupMember db vr user groupId memberId toggleNtf user bm' (not blocked) pure CRMemberBlockedForAllUser {user, groupInfo = gInfo, member = bm', blocked} where @@ -1741,7 +1771,7 @@ processChatCommand' vr = \case APIListGroups userId contactId_ search_ -> withUserId userId $ \user -> CRGroupsList user <$> withStore' (\db -> getUserGroupsWithSummary db vr user contactId_ search_) ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do - ct_ <- forM cName_ $ \cName -> withStore $ \db -> getContactByName db user cName + ct_ <- forM cName_ $ \cName -> withStore $ \db -> getContactByName db vr user cName processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_ APIUpdateGroupProfile groupId p' -> withUser $ \user -> do g <- withStore $ \db -> getGroup db vr user groupId @@ -1761,7 +1791,7 @@ processChatCommand' vr = \case groupLinkId <- GroupLinkId <$> drgRandomBytes 16 subMode <- chatReadVar subscriptionMode let crClientData = encodeJSON $ CRDataGroup groupLinkId - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) subMode + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) IKPQOff subMode withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole subMode pure $ CRGroupLinkCreated user gInfo cReq mRole APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withChatLock "groupLinkMemberRole " $ do @@ -1780,15 +1810,15 @@ processChatCommand' vr = \case (_, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo pure $ CRGroupLink user gInfo groupLink mRole APICreateMemberContact gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId assertUserGroupRole g GRAuthor unless (groupFeatureAllowed SGFDirectMessages g) $ throwChatError $ CECommandError "direct messages not allowed" case memberConn m of Just mConn@Connection {peerChatVRange} -> do - unless (isCompatibleRange (fromJVersionRange peerChatVRange) xGrpDirectInvVRange) $ throwChatError CEPeerChatVRangeIncompatible + unless (maxVersion peerChatVRange >= groupDirectInvVersion) $ throwChatError CEPeerChatVRangeIncompatible when (isJust $ memberContactId m) $ throwChatError $ CECommandError "member contact already exists" subMode <- chatReadVar subscriptionMode - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode -- [incognito] reuse membership incognito profile ct <- withStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode -- TODO not sure it is correct to set connections status here? @@ -1801,7 +1831,7 @@ processChatCommand' vr = \case case memberConn m of Just mConn -> do let msg = XGrpDirectInv cReq msgContent_ - (sndMsg, _) <- sendDirectMessage mConn msg $ GroupId groupId + (sndMsg, _, _) <- sendDirectMemberMessage mConn msg groupId withStore' $ \db -> setContactGrpInvSent db ct True let ct' = ct {contactGrpInvSent = True} forM_ msgContent_ $ \mc -> do @@ -1903,8 +1933,8 @@ processChatCommand' vr = \case withStore (\db -> liftIO $ lookupChatRefByFileId db user fileId) >>= \case Nothing -> pure () Just (ChatRef CTDirect contactId) -> do - (contact, sharedMsgId) <- withStore $ \db -> (,) <$> getContact db user contactId <*> getSharedMsgIdByFileId db userId fileId - void . sendDirectContactMessage contact $ XFileCancel sharedMsgId + (contact, sharedMsgId) <- withStore $ \db -> (,) <$> getContact db vr user contactId <*> getSharedMsgIdByFileId db userId fileId + void . sendDirectContactMessage user contact $ XFileCancel sharedMsgId Just (ChatRef CTGroup groupId) -> do (Group gInfo ms, sharedMsgId) <- withStore $ \db -> (,) <$> getGroup db vr user groupId <*> getSharedMsgIdByFileId db userId fileId void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId @@ -1960,7 +1990,7 @@ processChatCommand' vr = \case let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user} updateProfile user p SetContactFeature (ACF f) cName allowed_ -> withUser $ \user -> do - ct@Contact {userPreferences} <- withStore $ \db -> getContactByName db user cName + ct@Contact {userPreferences} <- withStore $ \db -> getContactByName db vr user cName let prefs' = setPreference f allowed_ $ Just userPreferences updateContactPrefs user ct prefs' SetGroupFeature (AGF f) gName enabled -> @@ -1972,7 +2002,7 @@ processChatCommand' vr = \case p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user} updateProfile user p SetContactTimedMessages cName timedMessagesEnabled_ -> withUser $ \user -> do - ct@Contact {userPreferences = userPreferences@Preferences {timedMessages}} <- withStore $ \db -> getContactByName db user cName + ct@Contact {userPreferences = userPreferences@Preferences {timedMessages}} <- withStore $ \db -> getContactByName db vr user cName let currentTTL = timedMessages >>= \TimedMessagesPreference {ttl} -> ttl pref_ = tmeToPref currentTTL <$> timedMessagesEnabled_ prefs' = setPreference' SCFTimedMessages pref_ $ Just userPreferences @@ -2117,7 +2147,7 @@ processChatCommand' vr = \case case groupLinkId of -- contact address Nothing -> - withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case + withStore' (\db -> getConnReqContactXContactId db vr user cReqHash) >>= \case (Just contact, _) -> pure $ CRContactAlreadyExists user contact (_, xContactId_) -> procCmd $ do let randomXContactId = XContactId <$> drgRandomBytes 16 @@ -2125,7 +2155,7 @@ processChatCommand' vr = \case connect' Nothing cReqHash xContactId False -- group link Just gLinkId -> - withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case + withStore' (\db -> getConnReqContactXContactId db vr user cReqHash) >>= \case (Just _contact, _) -> procCmd $ do -- allow repeat contact request newXContactId <- XContactId <$> drgRandomBytes 16 @@ -2136,26 +2166,35 @@ processChatCommand' vr = \case connect' (Just gLinkId) cReqHash xContactId True where connect' groupLinkId cReqHash xContactId inGroup = do - (connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId inGroup - conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode + pqSup <- if inGroup then pure PQSupportOff else chatReadVar pqExperimentalEnabled + (connId, incognitoProfile, subMode, chatV) <- requestContact user incognito cReq xContactId inGroup pqSup + conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup pure $ CRSentInvitation user conn incognitoProfile connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> m ChatResponse connectContactViaAddress user incognito ct cReq = withChatLock "connectViaContact" $ do newXContactId <- XContactId <$> drgRandomBytes 16 - (connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId False + pqSup <- chatReadVar pqExperimentalEnabled + (connId, incognitoProfile, subMode, chatV) <- requestContact user incognito cReq newXContactId False pqSup let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq - ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode + ct' <- withStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup pure $ CRSentInvitationToContact user ct' incognitoProfile - requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> m (ConnId, Maybe Profile, SubscriptionMode) - requestContact user incognito cReq xContactId inGroup = do + requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQSupport -> m (ConnId, Maybe Profile, SubscriptionMode, VersionChat) + requestContact user incognito cReq xContactId inGroup pqSup = do -- [incognito] generate profile to send incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup - dm <- directMessage (XContact profileToSend $ Just xContactId) - subMode <- chatReadVar subscriptionMode - connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode - pure (connId, incognitoProfile, subMode) + -- 0) toggle disabled - PQSupportOff + -- 1) toggle enabled, address supports PQ (connRequestPQSupport returns Just True) - PQSupportOn, enable support with compression + -- 2) toggle enabled, address doesn't support PQ - PQSupportOn but without compression, with version range indicating support + withAgent' (\a -> connRequestPQSupport a pqSup cReq) >>= \case + Nothing -> throwChatError CEInvalidConnReq + Just (agentV, _) -> do + let chatV = agentToChatVersion agentV + dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend $ Just xContactId) + subMode <- chatReadVar subscriptionMode + connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup subMode + pure (connId, incognitoProfile, subMode, chatV) contactMember :: Contact -> [GroupMember] -> Maybe GroupMember contactMember Contact {contactId} = find $ \GroupMember {memberContactId = cId, memberStatus = s} -> @@ -2175,18 +2214,21 @@ processChatCommand' vr = \case | otherwise = do when (n /= n') $ checkValidName n' -- read contacts before user update to correctly merge preferences - contacts <- withStore' (`getUserContacts` user) + contacts <- withStore' $ \db -> getUserContacts db vr user user' <- updateUser asks currentUser >>= atomically . (`writeTVar` Just user') withChatLock "updateProfile" . procCmd $ do - let changedCts = foldr (addChangedProfileContact user') [] contacts - idsEvts = map ctSndMsg changedCts - msgReqs_ <- zipWith ctMsgReq changedCts <$> createSndMessages idsEvts - (errs, cts) <- partitionEithers . zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ - unless (null errs) $ toView $ CRChatErrors (Just user) errs - let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts - createContactsSndFeatureItems user' changedCts' - let summary = + let changedCts_ = L.nonEmpty $ foldr (addChangedProfileContact user') [] contacts + summary <- case changedCts_ of + Nothing -> pure $ UserProfileUpdateSummary 0 0 [] + Just changedCts -> do + let idsEvts = L.map ctSndMsg changedCts + msgReqs_ <- L.zipWith ctMsgReq changedCts <$> createSndMessages idsEvts + (errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_ + unless (null errs) $ toView $ CRChatErrors (Just user) errs + let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts + createContactsSndFeatureItems user' changedCts' + pure UserProfileUpdateSummary { updateSuccesses = length cts, updateFailures = length errs, @@ -2205,11 +2247,12 @@ processChatCommand' vr = \case mergedProfile = userProfileToSend user Nothing (Just ct) False ct' = updateMergedPreferences user' ct mergedProfile' = userProfileToSend user' Nothing (Just ct') False - ctSndMsg :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json) - ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile') + ctSndMsg :: ChangedProfileContact -> (ConnOrGroupId, PQSupport, ChatMsgEvent 'Json) + ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId, pqSupport}} = (ConnectionId connId, pqSupport, XInfo mergedProfile') ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError MsgReq - ctMsgReq ChangedProfileContact {conn} = fmap $ \SndMessage {msgId, msgBody} -> - (conn, MsgFlags {notification = hasNotification XInfo_}, msgBody, msgId) + ctMsgReq ChangedProfileContact {conn} = + fmap $ \SndMessage {msgId, msgBody} -> + (conn, MsgFlags {notification = hasNotification XInfo_}, msgBody, msgId) updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' @@ -2222,7 +2265,7 @@ processChatCommand' vr = \case mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False when (mergedProfile' /= mergedProfile) $ withChatLock "updateProfile" $ do - void (sendDirectContactMessage ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user)) + void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user)) when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' runUpdateGroupProfile :: User -> Group -> GroupProfile -> m ChatResponse @@ -2264,7 +2307,7 @@ processChatCommand' vr = \case withCurrentCall ctId action = do (user, ct) <- withStore $ \db -> do user <- getUserByContactId db ctId - (user,) <$> getContact db user ctId + (user,) <$> getContact db vr user ctId calls <- asks currentCalls withChatLock "currentCall" $ atomically (TM.lookup ctId calls) >>= \case @@ -2300,10 +2343,19 @@ processChatCommand' vr = \case groupMemberId <- getGroupMemberIdByName db user groupId groupMemberName pure (groupId, groupMemberId) sendGrpInvitation :: User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> m () - sendGrpInvitation user ct@Contact {localDisplayName} GroupInfo {groupId, groupProfile, membership} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do + sendGrpInvitation user ct@Contact {localDisplayName} gInfo@GroupInfo {groupId, groupProfile, membership} GroupMember {groupMemberId, memberId, memberRole = memRole} cReq = do + currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo let GroupMember {memberRole = userRole, memberId = userMemberId} = membership - groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile Nothing - (msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv + groupInv = + GroupInvitation + { fromMember = MemberIdRole userMemberId userRole, + invitedMember = MemberIdRole memberId memRole, + connRequest = cReq, + groupProfile, + groupLinkId = Nothing, + groupSize = Just currentMemCount + } + (msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv 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) @@ -2372,7 +2424,7 @@ processChatCommand' vr = \case (chatId, chatSettings) <- case cType of CTDirect -> withStore $ \db -> do ctId <- getContactIdByName db user name - Contact {chatSettings} <- getContact db user ctId + Contact {chatSettings} <- getContact db vr user ctId pure (ctId, chatSettings) CTGroup -> withStore $ \db -> do @@ -2413,7 +2465,7 @@ processChatCommand' vr = \case Nothing -> withStore' (\db -> getContactConnEntityByConnReqHash db vr user cReqHashes) >>= \case Nothing -> - withStore' (\db -> getContactWithoutConnViaAddress db user cReqSchemas) >>= \case + withStore' (\db -> getContactWithoutConnViaAddress db vr user cReqSchemas) >>= \case Nothing -> pure $ CPContactAddress CAPOk Just ct -> pure $ CPContactAddress (CAPContactViaAddress ct) Just (RcvDirectMsgConnection _conn Nothing) -> pure $ CPContactAddress CAPConnectingConfirmReconnect @@ -2708,7 +2760,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI -- direct file protocol (Nothing, Just connReq) -> do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XFileAcpt fName + dm <- encodeConnInfo $ XFileAcpt fName connIds <- joinAgentConnectionAsync user True connReq dm subMode filePath <- getRcvFilePath fileId filePath_ fName True withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnJoined filePath subMode @@ -2728,13 +2780,13 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI chatRef <- withStoreCtx (Just "acceptFileReceive, getChatRefByFileId") $ \db -> getChatRefByFileId db user fileId case (chatRef, grpMemberId) of (ChatRef CTDirect contactId, Nothing) -> do - ct <- withStoreCtx (Just "acceptFileReceive, getContact") $ \db -> getContact db user contactId - acceptFile CFCreateConnFileInvDirect $ \msg -> void $ sendDirectContactMessage ct msg + ct <- withStoreCtx (Just "acceptFileReceive, getContact") $ \db -> getContact db vr user contactId + acceptFile CFCreateConnFileInvDirect $ \msg -> void $ sendDirectContactMessage user ct msg (ChatRef CTGroup groupId, Just memId) -> do - GroupMember {activeConn} <- withStoreCtx (Just "acceptFileReceive, getGroupMember") $ \db -> getGroupMember db user groupId memId + GroupMember {activeConn} <- withStoreCtx (Just "acceptFileReceive, getGroupMember") $ \db -> getGroupMember db vr user groupId memId case activeConn of Just conn -> do - acceptFile CFCreateConnFileInvGroup $ \msg -> void $ sendDirectMessage conn msg $ GroupId groupId + acceptFile CFCreateConnFileInvGroup $ \msg -> void $ sendDirectMemberMessage conn msg groupId _ -> throwChatError $ CEFileInternal "member connection not active" _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" where @@ -2831,20 +2883,26 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of getTmpHandle fPath = openFile fPath AppendMode `catchThrow` (ChatError . CEFileInternal . show) acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> m Contact -acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile contactUsed = do +acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId, pqSupport} incognitoProfile contactUsed = do subMode <- chatReadVar subscriptionMode + pqSup <- chatReadVar pqExperimentalEnabled + vr <- chatVersionRange let profileToSend = profileToSendOnAccept user incognitoProfile False - dm <- directMessage $ XInfo profileToSend - acId <- withAgent $ \a -> acceptContact a True invId dm subMode - withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode contactUsed + chatV = vr pqSup `peerConnChatVersion` cReqChatVRange + pqSup' = pqSup `CR.pqSupportAnd` pqSupport + dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend + acId <- withAgent $ \a -> acceptContact a True invId dm pqSup' subMode + withStore' $ \db -> createAcceptedContact db user acId chatV cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup' contactUsed -acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> m Contact -acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed = do +acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> PQSupport -> m Contact +acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed pqSup = do subMode <- chatReadVar subscriptionMode let profileToSend = profileToSendOnAccept user incognitoProfile False - (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode + vr <- chatVersionRange + chatV <- (\pq -> vr pq `peerConnChatVersion` cReqChatVRange) <$> chatReadVar pqExperimentalEnabled + (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode pqSup chatV withStore' $ \db -> do - ct@Contact {activeConn} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode contactUsed + ct@Contact {activeConn} <- createAcceptedContact db user acId chatV cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed forM_ activeConn $ \Connection {connId} -> setCommandConnId db user cmdId connId pure ct @@ -2852,19 +2910,30 @@ acceptGroupJoinRequestAsync :: ChatMonad m => User -> GroupInfo -> UserContactRe acceptGroupJoinRequestAsync user gInfo@GroupInfo {groupProfile, membership} - ucr@UserContactRequest {agentInvitationId = AgentInvId invId} + ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange} gLinkMemRole incognitoProfile = do gVar <- asks random (groupMemberId, memberId) <- withStore $ \db -> createAcceptedMember db gVar user gInfo ucr gLinkMemRole + currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo let Profile {displayName} = profileToSendOnAccept user incognitoProfile True GroupMember {memberRole = userRole, memberId = userMemberId} = membership - msg = XGrpLinkInv $ GroupLinkInvitation (MemberIdRole userMemberId userRole) displayName (MemberIdRole memberId gLinkMemRole) groupProfile + msg = + XGrpLinkInv $ + GroupLinkInvitation + { fromMember = MemberIdRole userMemberId userRole, + fromMemberName = displayName, + invitedMember = MemberIdRole memberId gLinkMemRole, + groupProfile, + groupSize = Just currentMemCount + } subMode <- chatReadVar subscriptionMode - connIds <- agentAcceptContactAsync user True invId msg subMode + vr <- chatVersionRange + chatV <- (\pq -> vr pq `peerConnChatVersion` cReqChatVRange) <$> chatReadVar pqExperimentalEnabled + connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV withStore $ \db -> do - liftIO $ createAcceptedMemberConnection db user connIds ucr groupMemberId subMode - getGroupMemberById db user groupMemberId + liftIO $ createAcceptedMemberConnection db user connIds chatV ucr groupMemberId subMode + getGroupMemberById db vr user groupMemberId profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Bool -> Profile profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing @@ -2875,12 +2944,14 @@ profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> deleteGroupLink' :: ChatMonad m => User -> GroupInfo -> m () deleteGroupLink' user gInfo = do - conn <- withStore $ \db -> getGroupLinkConnection db user gInfo + vr <- chatVersionRange + conn <- withStore $ \db -> getGroupLinkConnection db vr user gInfo deleteGroupLink_ user gInfo conn deleteGroupLinkIfExists :: ChatMonad m => User -> GroupInfo -> m () deleteGroupLinkIfExists user gInfo = do - conn_ <- eitherToMaybe <$> withStore' (\db -> runExceptT $ getGroupLinkConnection db user gInfo) + vr <- chatVersionRange + conn_ <- eitherToMaybe <$> withStore' (\db -> runExceptT $ getGroupLinkConnection db vr user gInfo) mapM_ (deleteGroupLink_ user gInfo) conn_ deleteGroupLink_ :: ChatMonad m => User -> GroupInfo -> Connection -> m () @@ -2909,7 +2980,7 @@ agentSubscriber = do type AgentBatchSubscribe m = AgentClient -> [ConnId] -> ExceptT AgentErrorType m (Map ConnId (Either AgentErrorType ())) -subscribeUserConnections :: forall m. ChatMonad m => VersionRange -> Bool -> AgentBatchSubscribe m -> User -> m () +subscribeUserConnections :: forall m. ChatMonad m => (PQSupport -> VersionRangeChat) -> Bool -> AgentBatchSubscribe m -> User -> m () subscribeUserConnections vr onlyNeeded agentBatchSubscribe user@User {userId} = do -- get user connections ce <- asks $ subscriptionEvents . config @@ -2965,12 +3036,12 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user@User {userId} = } getContactConns :: m ([ConnId], Map ConnId Contact) getContactConns = do - cts <- withStore_ ("subscribeUserConnections " <> show userId <> ", getUserContacts") getUserContacts + cts <- withStore_ ("subscribeUserConnections " <> show userId <> ", getUserContacts") (`getUserContacts` vr) let cts' = mapMaybe (\ct -> (,ct) <$> contactConnId ct) $ filter contactActive cts pure (map fst cts', M.fromList cts') getUserContactLinkConns :: m ([ConnId], Map ConnId UserContact) getUserContactLinkConns = do - (cs, ucs) <- unzip <$> withStore_ ("subscribeUserConnections " <> show userId <> ", getUserContactLinks") getUserContactLinks + (cs, ucs) <- unzip <$> withStore_ ("subscribeUserConnections " <> show userId <> ", getUserContactLinks") (`getUserContactLinks` vr) let connIds = map aConnId cs pure (connIds, M.fromList $ zip connIds ucs) getGroupMemberConns :: m ([Group], [ConnId], Map ConnId GroupMember) @@ -3110,7 +3181,8 @@ cleanupManager = do timedItems <- withStoreCtx' (Just "cleanupManager, getTimedItems") $ \db -> getTimedItems db user startTimedThreadCutoff forM_ timedItems $ \(itemRef, deleteAt) -> startTimedItemThread user itemRef deleteAt `catchChatError` const (pure ()) cleanupDeletedContacts user = do - contacts <- withStore' (`getDeletedContacts` user) + vr <- chatVersionRange + contacts <- withStore' $ \db -> getDeletedContacts db vr user forM_ contacts $ \ct -> withStore (\db -> deleteContactWithoutGroups db user ct) `catchChatError` (toView . CRChatError (Just user)) @@ -3153,7 +3225,7 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do vr <- chatVersionRange case cType of CTDirect -> do - (ct, CChatItem _ ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId + (ct, CChatItem _ ci) <- withStore $ \db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId deleteDirectCI user ct ci True True >>= toView CTGroup -> do (gInfo, CChatItem _ ci) <- withStore $ \db -> (,) <$> getGroupInfo db vr user chatId <*> getGroupChatItem db user chatId itemId @@ -3176,11 +3248,11 @@ expireChatItems user@User {userId} ttl sync = do -- this is to keep group messages created during last 12 hours even if they're expired according to item_ts createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs waitChatStartedAndActivated - contacts <- withStoreCtx' (Just "expireChatItems, getUserContacts") (`getUserContacts` user) + contacts <- withStoreCtx' (Just "expireChatItems, getUserContacts") $ \db -> getUserContacts db vr user loop contacts $ processContact expirationDate waitChatStartedAndActivated - groups <- withStoreCtx' (Just "expireChatItems, getUserGroupDetails") (\db -> getUserGroupDetails db vr user Nothing Nothing) - loop groups $ processGroup expirationDate createdAtCutoff + groups <- withStoreCtx' (Just "expireChatItems, getUserGroupDetails") $ \db -> getUserGroupDetails db vr user Nothing Nothing + loop groups $ processGroup vr expirationDate createdAtCutoff where loop :: [a] -> (a -> m ()) -> m () loop [] _ = pure () @@ -3202,14 +3274,14 @@ expireChatItems user@User {userId} ttl sync = do cancelFilesInProgress user filesInfo deleteFilesLocally filesInfo withStoreCtx' (Just "processContact, deleteContactExpiredCIs") $ \db -> deleteContactExpiredCIs db user ct expirationDate - processGroup :: UTCTime -> UTCTime -> GroupInfo -> m () - processGroup expirationDate createdAtCutoff gInfo = do + processGroup :: (PQSupport -> VersionRangeChat) -> UTCTime -> UTCTime -> GroupInfo -> m () + processGroup vr expirationDate createdAtCutoff gInfo = do waitChatStartedAndActivated filesInfo <- withStoreCtx' (Just "processGroup, getGroupExpiredFileInfo") $ \db -> getGroupExpiredFileInfo db user gInfo expirationDate createdAtCutoff cancelFilesInProgress user filesInfo deleteFilesLocally filesInfo withStoreCtx' (Just "processGroup, deleteGroupExpiredCIs") $ \db -> deleteGroupExpiredCIs db user gInfo expirationDate createdAtCutoff - membersToDelete <- withStoreCtx' (Just "processGroup, getGroupMembersForExpiration") $ \db -> getGroupMembersForExpiration db user gInfo + membersToDelete <- withStoreCtx' (Just "processGroup, getGroupMembersForExpiration") $ \db -> getGroupMembersForExpiration db vr user gInfo forM_ membersToDelete $ \m -> withStoreCtx' (Just "processGroup, deleteGroupMember") $ \db -> deleteGroupMember db user m processAgentMessage :: forall m. ChatMonad m => ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m () @@ -3278,7 +3350,8 @@ processAgentMsgSndFile _corrId aFileId msg = [] -> case xftpRedirectFor of Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CRSndFileRedirectStartXFTP user ft Just _ -> sendFileError "Prohibit chaining redirects" fileId vr ft - rfds' -> do -- we have 1 chunk - use it as URI whether it is redirect or not + rfds' -> do + -- we have 1 chunk - use it as URI whether it is redirect or not ft' <- maybe (pure ft) (\fId -> withStore $ \db -> getFileTransferMeta db user fId) xftpRedirectFor toView $ CRSndStandaloneFileComplete user ft' $ map (decodeLatin1 . strEncode . FD.fileDescriptionURI) rfds' Just (AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) -> @@ -3290,11 +3363,11 @@ processAgentMsgSndFile _corrId aFileId msg = case (rfds, sfts, d, cInfo) of (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) - msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct + msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage user ct withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId withAgent (`xftpDeleteSndFileInternal` aFileId) (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do - ms <- withStore' $ \db -> getGroupMembers db user g + ms <- withStore' $ \db -> getGroupMembers db vr user g let rfdsMemberFTs = zip rfds $ memberFTs ms extraRFDs = drop (length rfdsMemberFTs) rfds withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) @@ -3316,7 +3389,9 @@ processAgentMsgSndFile _corrId aFileId msg = useMember _ = Nothing sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m () sendToMember (rfd, (conn, sft)) = - void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId + void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> do + (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg' groupId + pure (sndMsg, msgDeliveryId) _ -> pure () _ -> pure () -- TODO error? SFERR e @@ -3341,7 +3416,7 @@ processAgentMsgSndFile _corrId aFileId msg = case L.nonEmpty fds of Just fds' -> loopSend fds' Nothing -> pure msgDeliveryId - sendFileError :: Text -> Int64 -> VersionRange -> FileTransferMeta -> m () + sendFileError :: Text -> Int64 -> (PQSupport -> VersionRangeChat) -> FileTransferMeta -> m () sendFileError err fileId vr ft = do logError $ "Sent file error: " <> err ci <- withStore $ \db -> do @@ -3407,7 +3482,7 @@ processAgentMsgRcvFile _corrId aFileId msg = agentXFTPDeleteRcvFile aFileId fileId toView $ CRRcvFileError user ci e ft -processAgentMessageConn :: forall m. ChatMonad m => VersionRange -> User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m () +processAgentMessageConn :: forall m. ChatMonad m => (PQSupport -> VersionRangeChat) -> User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m () processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do entity <- withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus case agentMessage of @@ -3438,21 +3513,38 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = agentMsgConnStatus :: ACommand 'Agent e -> Maybe ConnStatus agentMsgConnStatus = \case CONF {} -> Just ConnRequested - INFO _ -> Just ConnSndReady - CON -> Just ConnReady + INFO {} -> Just ConnSndReady + CON _ -> Just ConnReady _ -> Nothing + processCONFpqSupport :: Connection -> PQSupport -> m Connection + processCONFpqSupport conn@Connection {connId, pqSupport = pq} pq' + | pq == PQSupportOn && pq' == PQSupportOff = do + let pqEnc' = CR.pqSupportToEnc pq' + withStore' $ \db -> updateConnSupportPQ db connId pq' pqEnc' + pure (conn {pqSupport = pq', pqEncryption = pqEnc'} :: Connection) + | pq /= pq' = do + messageWarning "processCONFpqSupport: unexpected pqSupport change" + pure conn + | otherwise = pure conn + + processINFOpqSupport :: Connection -> PQSupport -> m () + processINFOpqSupport Connection {pqSupport = pq} pq' = + when (pq /= pq') $ messageWarning "processINFOpqSupport: unexpected pqSupport change" + processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> m () - processDirectMessage agentMsg connEntity conn@Connection {connId, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case + processDirectMessage agentMsg connEntity conn@Connection {connId, connChatVersion, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case Nothing -> case agentMsg of - CONF confId _ connInfo -> do + CONF confId pqSupport _ connInfo -> do + conn' <- processCONFpqSupport conn pqSupport -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing False - conn' <- saveConnInfo conn connInfo + conn'' <- saveConnInfo conn' connInfo -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId $ XInfo profileToSend - INFO connInfo -> do + allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend + INFO pqSupport connInfo -> do + processINFOpqSupport conn pqSupport _conn' <- saveConnInfo conn connInfo pure () MSG meta _msgFlags msgBody -> do @@ -3493,60 +3585,64 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendXGrpMemInv hostConnId (Just directConnReq) xGrpMemIntroCont CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" MSG msgMeta _msgFlags msgBody -> do - checkIntegrityCreateItem (CDDirectRcv ct) msgMeta - cmdId <- createAckCmd conn + let MsgMeta {pqEncryption} = msgMeta + (ct', conn') <- updateContactPQRcv user ct conn pqEncryption + checkIntegrityCreateItem (CDDirectRcv ct') msgMeta + cmdId <- createAckCmd conn' withAckMessage agentConnId cmdId msgMeta $ do - (conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn msgMeta cmdId msgBody - let ct' = ct {activeConn = Just conn'} :: Contact - assertDirectAllowed user MDRcv ct' $ toCMEventTag event - updateChatLock "directMessage" event + (conn'', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn' msgMeta cmdId msgBody + let ct'' = ct' {activeConn = Just conn''} :: Contact + assertDirectAllowed user MDRcv ct'' $ toCMEventTag event + updateChatLock "direct message" event case event of - XMsgNew mc -> newContentMessage ct' mc msg msgMeta - XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct' sharedMsgId fileDescr - XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct' sharedMsgId mContent msg msgMeta ttl live - XMsgDel sharedMsgId _ -> messageDelete ct' sharedMsgId msg msgMeta - XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct' sharedMsgId reaction add msg msgMeta + XMsgNew mc -> newContentMessage ct'' mc msg msgMeta + XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct'' sharedMsgId fileDescr + XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct'' sharedMsgId mContent msg msgMeta ttl live + XMsgDel sharedMsgId _ -> messageDelete ct'' sharedMsgId msg msgMeta + XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct'' sharedMsgId reaction add msg msgMeta -- TODO discontinue XFile - XFile fInv -> processFileInvitation' ct' fInv msg msgMeta - XFileCancel sharedMsgId -> xFileCancel ct' sharedMsgId - XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct' sharedMsgId fileConnReq_ fName - XInfo p -> xInfo ct' p - XDirectDel -> xDirectDel ct' msg msgMeta - XGrpInv gInv -> processGroupInvitation ct' gInv msg msgMeta - XInfoProbe probe -> xInfoProbe (COMContact ct') probe - XInfoProbeCheck probeHash -> xInfoProbeCheck (COMContact ct') probeHash - XInfoProbeOk probe -> xInfoProbeOk (COMContact ct') probe - XCallInv callId invitation -> xCallInv ct' callId invitation msg msgMeta - XCallOffer callId offer -> xCallOffer ct' callId offer msg - XCallAnswer callId answer -> xCallAnswer ct' callId answer msg - XCallExtra callId extraInfo -> xCallExtra ct' callId extraInfo msg - XCallEnd callId -> xCallEnd ct' callId msg - BFileChunk sharedMsgId chunk -> bFileChunk ct' sharedMsgId chunk msgMeta + XFile fInv -> processFileInvitation' ct'' fInv msg msgMeta + XFileCancel sharedMsgId -> xFileCancel ct'' sharedMsgId + XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct'' sharedMsgId fileConnReq_ fName + XInfo p -> xInfo ct'' p + XDirectDel -> xDirectDel ct'' msg msgMeta + XGrpInv gInv -> processGroupInvitation ct'' gInv msg msgMeta + XInfoProbe probe -> xInfoProbe (COMContact ct'') probe + XInfoProbeCheck probeHash -> xInfoProbeCheck (COMContact ct'') probeHash + XInfoProbeOk probe -> xInfoProbeOk (COMContact ct'') probe + XCallInv callId invitation -> xCallInv ct'' callId invitation msg msgMeta + XCallOffer callId offer -> xCallOffer ct'' callId offer msg + XCallAnswer callId answer -> xCallAnswer ct'' callId answer msg + XCallExtra callId extraInfo -> xCallExtra ct'' callId extraInfo msg + XCallEnd callId -> xCallEnd ct'' callId msg + BFileChunk sharedMsgId chunk -> bFileChunk ct'' sharedMsgId chunk msgMeta _ -> messageError $ "unsupported message: " <> T.pack (show event) - let Contact {chatSettings = ChatSettings {sendRcpts}} = ct' + let Contact {chatSettings = ChatSettings {sendRcpts}} = ct'' pure $ fromMaybe (sendRcptsContacts user) sendRcpts && hasDeliveryReceipt (toCMEventTag event) RCVD msgMeta msgRcpt -> withAckMessage' agentConnId conn msgMeta $ directMsgReceived ct conn msgMeta msgRcpt - CONF confId _ connInfo -> do - ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo - conn' <- updatePeerChatVRange conn chatVRange + CONF confId pqSupport _ connInfo -> do + conn' <- processCONFpqSupport conn pqSupport + ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn' connInfo + conn'' <- updatePeerChatVRange conn' chatVRange case chatMsgEvent of -- confirming direct connection with a member XGrpMemInfo _memId _memProfile -> do -- TODO check member ID -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn' confId XOk + allowAgentConnectionAsync user conn'' confId XOk XInfo profile -> do ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct) -- [incognito] send incognito profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId let p = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False - allowAgentConnectionAsync user conn' confId $ XInfo p + allowAgentConnectionAsync user conn'' confId $ XInfo p void $ withStore' $ \db -> resetMemberContactFields db ct' _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" - INFO connInfo -> do + INFO pqSupport connInfo -> do + processINFOpqSupport conn pqSupport ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo _conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -3558,33 +3654,38 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = void $ processContactProfileUpdate ct profile False XOk -> pure () _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" - CON -> + CON pqEnc -> withStore' (\db -> getViaGroupMember db vr user ct) >>= \case Nothing -> do + when (pqEnc == PQEncOn) $ withStore' $ \db -> updateConnPQEnabledCON db connId pqEnc + let conn' = conn {pqSndEnabled = Just pqEnc, pqRcvEnabled = Just pqEnc} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact -- [incognito] print incognito profile used for this contact incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - setContactNetworkStatus ct NSConnected - toView $ CRContactConnected user ct (fmap fromLocalProfile incognitoProfile) - when (directOrUsed ct) $ createFeatureEnabledItems ct - when (contactConnInitiated conn) $ do - let Connection {groupLinkId} = conn + setContactNetworkStatus ct' NSConnected + toView $ CRContactConnected user ct' (fmap fromLocalProfile incognitoProfile) + when (directOrUsed ct') $ do + createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ E2EInfo pqEnc) Nothing + createFeatureEnabledItems ct' + when (contactConnInitiated conn') $ do + let Connection {groupLinkId} = conn' doProbeContacts = isJust groupLinkId - probeMatchingContactsAndMembers ct (contactConnIncognito ct) doProbeContacts - withStore' $ \db -> resetContactConnInitiated db user conn + probeMatchingContactsAndMembers ct' (contactConnIncognito ct') doProbeContacts + withStore' $ \db -> resetContactConnInitiated db user conn' forM_ viaUserContactLink $ \userContactLinkId -> do ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl forM_ autoAccept $ \(AutoAccept {autoReply = mc_}) -> forM_ mc_ $ \mc -> do - (msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) - ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) - toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) + (msg, _) <- sendDirectContactMessage user ct' (XMsgNew $ MCSimple (extMsgContent mc Nothing)) + ci <- saveSndChatItem user (CDDirectSnd ct') msg (CISndMsgContent mc) + toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct') ci) forM_ groupId_ $ \groupId -> do groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId subMode <- chatReadVar subscriptionMode groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode gVar <- asks random - withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct gLinkMemRole groupConnIds (fromJVersionRange peerChatVRange) subMode + withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode Just (gInfo, m@GroupMember {activeConn}) -> when (maybe False ((== ConnReady) . connStatus) activeConn) $ do notifyMemberConnected gInfo m $ Just ct @@ -3651,7 +3752,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of -- [async agent commands] XGrpMemIntro continuation on receiving INV CFCreateConnGrpMemInv - | isCompatibleRange (fromJVersionRange $ peerChatVRange conn) groupNoDirectVRange -> sendWithoutDirectCReq + | maxVersion (peerChatVRange conn) >= groupDirectInvVersion -> sendWithoutDirectCReq | otherwise -> sendWithDirectCReq where sendWithoutDirectCReq = do @@ -3669,7 +3770,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendXGrpMemInv hostConnId (Just directConnReq) XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} -- [async agent commands] group link auto-accept continuation on receiving INV CFCreateConnGrpInv -> do - ct <- withStore $ \db -> getContactViaMember db user m + ct <- withStore $ \db -> getContactViaMember db vr user m withStore' $ \db -> setNewContactMemberConnRequest db user m cReq groupLinkId <- withStore' $ \db -> getGroupLinkId db user gInfo sendGrpInvitation ct m groupLinkId @@ -3677,14 +3778,23 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where sendGrpInvitation :: Contact -> GroupMember -> Maybe GroupLinkId -> m () sendGrpInvitation ct GroupMember {memberId, memberRole = memRole} groupLinkId = do + currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo let GroupMember {memberRole = userRole, memberId = userMemberId} = membership - groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile groupLinkId - (_msg, _) <- sendDirectContactMessage ct $ XGrpInv groupInv + groupInv = + GroupInvitation + { fromMember = MemberIdRole userMemberId userRole, + invitedMember = MemberIdRole memberId memRole, + connRequest = cReq, + groupProfile, + groupLinkId = groupLinkId, + groupSize = Just currentMemCount + } + (_msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv -- we could link chat item with sent group invitation message (_msg) createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing _ -> throwChatError $ CECommandError "unexpected cmdFunction" CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type" - CONF confId _ connInfo -> do + CONF confId _pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo conn' <- updatePeerChatVRange conn chatVRange case memberCategory m of @@ -3708,7 +3818,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = allowAgentConnectionAsync user conn' confId $ XGrpMemInfo membershipMemId membershipProfile | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" _ -> messageError "CONF from member must have x.grp.mem.info" - INFO connInfo -> do + INFO _pqSupport connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo _conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -3721,7 +3831,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XOk -> pure () _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok" pure () - CON -> do + CON _pqEnc -> do withStore' $ \db -> do updateGroupMemberStatus db userId m GSMemConnected unless (memberActive membership) $ @@ -3732,20 +3842,19 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case memberCategory m of GCHostMember -> do toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected} + createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupE2EEInfo $ E2EInfo {pqEnabled = PQEncOff}) Nothing createGroupFeatureItems gInfo m let GroupInfo {groupProfile = GroupProfile {description}} = gInfo memberConnectedChatItem gInfo m unless expectHistory $ forM_ description $ groupDescriptionChatItem gInfo m where - expectHistory = - groupFeatureAllowed SGFHistory gInfo - && isCompatibleRange (memberChatVRange' m) groupHistoryIncludeWelcomeVRange + expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion GCInviteeMember -> do memberConnectedChatItem gInfo m toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} let Connection {viaUserContactLink} = conn when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem - members <- withStore' $ \db -> getGroupMembers db user gInfo + members <- withStore' $ \db -> getGroupMembers db vr user gInfo void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m sendIntroductions members when (groupFeatureAllowed SGFHistory gInfo) sendHistory @@ -3753,11 +3862,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendXGrpLinkMem = do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo profileToSend = profileToSendOnAccept user profileMode True - void $ sendDirectMessage conn (XGrpLinkMem profileToSend) (GroupId groupId) + void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId sendIntroductions members = do - intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m + intros <- withStore' $ \db -> createIntroductions db (maxVersion $ vr PQSupportOff) members m shuffledIntros <- liftIO $ shuffleIntros intros - if isCompatibleRange (memberChatVRange' m) batchSendVRange + if m `supportsVersion` batchSendVersion then do let events = map (memberIntro . reMember) shuffledIntros forM_ (L.nonEmpty events) $ \events' -> @@ -3779,10 +3888,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image processIntro intro@GroupMemberIntro {introId} = do - void $ sendDirectMessage conn (memberIntro $ reMember intro) (GroupId groupId) + void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId withStore' $ \db -> updateIntroStatus db introId GMIntroSent sendHistory = - when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do + when (m `supportsVersion` batchSendVersion) $ do (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo 100) (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items let errors = map ChatErrorStore errs <> errs' @@ -3792,7 +3901,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendGroupMemberMessages user conn events'' groupId descrEvent_ :: Maybe (ChatMsgEvent 'Json) descrEvent_ - | isCompatibleRange (memberChatVRange' m) groupHistoryIncludeWelcomeVRange = do + | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do let GroupInfo {groupProfile = GroupProfile {description}} = gInfo fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description | otherwise = Nothing @@ -3859,7 +3968,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = pure msgForwardEvents _ -> do let memCategory = memberCategory m - withStore' (\db -> getViaGroupContact db user m) >>= \case + withStore' (\db -> getViaGroupContact db vr user m) >>= \case Nothing -> do notifyMemberConnected gInfo m Nothing let connectedIncognito = memberIncognito membership @@ -3876,14 +3985,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendXGrpMemCon = \case GCPreMember -> forM_ (invitedByGroupMemberId membership) $ \hostId -> do - host <- withStore $ \db -> getGroupMember db user groupId hostId + host <- withStore $ \db -> getGroupMember db vr user groupId hostId forM_ (memberConn host) $ \hostConn -> - void $ sendDirectMessage hostConn (XGrpMemCon memberId) (GroupId groupId) + void $ sendDirectMemberMessage hostConn (XGrpMemCon memberId) groupId GCPostMember -> forM_ (invitedByGroupMemberId m) $ \invitingMemberId -> do - im <- withStore $ \db -> getGroupMember db user groupId invitingMemberId + im <- withStore $ \db -> getGroupMember db vr user groupId invitingMemberId forM_ (memberConn im) $ \imConn -> - void $ sendDirectMessage imConn (XGrpMemCon memberId) (GroupId groupId) + void $ sendDirectMemberMessage imConn (XGrpMemCon memberId) groupId _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected" MSG msgMeta _msgFlags msgBody -> do checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta @@ -3954,10 +4063,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- members introduced to this invited member introducedMembers <- if memberCategory m == GCInviteeMember - then withStore' $ \db -> getForwardIntroducedMembers db user m highlyAvailable + then withStore' $ \db -> getForwardIntroducedMembers db vr user m highlyAvailable else pure [] -- invited members to which this member was introduced - invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db user m highlyAvailable + invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db vr user m highlyAvailable let GroupMember {memberId} = m ms = forwardedToGroupMembers (introducedMembers <> invitedMembers) chatMsg' msg = XGrpMsgForward memberId chatMsg' brokerTs @@ -4055,7 +4164,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case agentMsg of -- SMP CONF for SndFileConnection happens for direct file protocol -- when recipient of the file "joins" connection created by the sender - CONF confId _ connInfo -> do + CONF confId _pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of @@ -4067,7 +4176,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = allowAgentConnectionAsync user conn' confId XOk | otherwise -> messageError "x.file.acpt: fileName is different from expected" _ -> messageError "CONF from file connection must have x.file.acpt" - CON -> do + CON _ -> do ci <- withStore $ \db -> do liftIO $ updateSndFileStatus db ft FSConnected updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 @@ -4106,17 +4215,17 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = fileInvConnReq@(CRInvitationUri _ _) -> case cmdFunction of -- [async agent commands] direct XFileAcptInv continuation on receiving INV CFCreateConnFileInvDirect -> do - ct <- withStore $ \db -> getContactByFileId db user fileId + ct <- withStore $ \db -> getContactByFileId db vr user fileId sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId - void $ sendDirectContactMessage ct (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) + void $ sendDirectContactMessage user ct (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) -- [async agent commands] group XFileAcptInv continuation on receiving INV CFCreateConnFileInvGroup -> case grpMemberId of Just gMemberId -> do - GroupMember {groupId, activeConn} <- withStore $ \db -> getGroupMemberById db user gMemberId + GroupMember {groupId, activeConn} <- withStore $ \db -> getGroupMemberById db vr user gMemberId case activeConn of Just gMemberConn -> do sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId - void $ sendDirectMessage gMemberConn (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) $ GroupId groupId + void $ sendDirectMemberMessage gMemberConn (XFileAcptInv sharedMsgId (Just fileInvConnReq) fileName) groupId _ -> throwChatError $ CECommandError "no GroupMember activeConn" _ -> throwChatError $ CECommandError "no grpMemberId" _ -> throwChatError $ CECommandError "unexpected cmdFunction" @@ -4124,13 +4233,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- SMP CONF for RcvFileConnection happens for group file protocol -- when sender of the file "joins" connection created by the recipient -- (sender doesn't create connections for all group members) - CONF confId _ connInfo -> do + CONF confId _pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo conn' <- updatePeerChatVRange conn chatVRange case chatMsgEvent of XOk -> allowAgentConnectionAsync user conn' confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability _ -> pure () - CON -> startReceivingFile user fileId + CON _ -> startReceivingFile user fileId MSG meta _ msgBody -> do parseFileChunk msgBody >>= receiveFileChunk ft (Just conn) meta OK -> @@ -4185,11 +4294,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m () processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of - REQ invId _ connInfo -> do + REQ invId pqSupport _ connInfo -> do ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo case chatMsgEvent of - XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_ - XInfo p -> profileContactRequest invId chatVRange p Nothing + XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_ pqSupport + XInfo p -> profileContactRequest invId chatVRange p Nothing pqSupport -- TODO show/log error, other events in contact request _ -> pure () MERR _ err -> do @@ -4201,9 +4310,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- TODO add debugging output _ -> pure () where - profileContactRequest :: InvitationId -> VersionRange -> Profile -> Maybe XContactId -> m () - profileContactRequest invId chatVRange p xContactId_ = do - withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId chatVRange p xContactId_) >>= \case + profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> m () + profileContactRequest invId chatVRange p xContactId_ reqPQSup = do + withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact CORRequest cReq -> do ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId @@ -4213,18 +4322,21 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Nothing -> do -- [incognito] generate profile to send, create connection with incognito profile incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing - ct <- acceptContactRequestAsync user cReq incognitoProfile True + pqSup <- chatReadVar pqExperimentalEnabled + let pqSup' = pqSup `CR.pqSupportAnd` reqPQSup + ct <- acceptContactRequestAsync user cReq incognitoProfile True pqSup' toView $ CRAcceptingContactRequest user ct Just groupId -> do gInfo <- withStore $ \db -> getGroupInfo db vr user groupId let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - if isCompatibleRange chatVRange groupLinkNoContactVRange + if maxVersion chatVRange >= groupFastLinkJoinVersion then do mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CRAcceptingGroupJoinRequestMember user gInfo mem else do - ct <- acceptContactRequestAsync user cReq profileMode False + -- TODO v5.7 remove old API (or v6.0?) + ct <- acceptContactRequestAsync user cReq profileMode False PQSupportOff toView $ CRAcceptingGroupJoinRequest user gInfo ct _ -> toView $ CRReceivedContactRequest user cReq @@ -4337,14 +4449,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = sendProbe probe cs <- if doProbeContacts - then map COMContact <$> withStore' (\db -> getMatchingContacts db user ct) + then map COMContact <$> withStore' (\db -> getMatchingContacts db vr user ct) else pure [] - ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db user ct) + ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db vr user ct) sendProbeHashes (cs <> ms) probe probeId else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) where sendProbe :: Probe -> m () - sendProbe probe = void . sendDirectContactMessage ct $ XInfoProbe probe + sendProbe probe = void . sendDirectContactMessage user ct $ XInfoProbe probe probeMatchingMemberContact :: GroupMember -> IncognitoEnabled -> m () probeMatchingMemberContact GroupMember {activeConn = Nothing} _ = pure () @@ -4355,12 +4467,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = then do (probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId $ COMGroupMember m sendProbe probe - cs <- map COMContact <$> withStore' (\db -> getMatchingMemberContacts db user m) + cs <- map COMContact <$> withStore' (\db -> getMatchingMemberContacts db vr user m) sendProbeHashes cs probe probeId else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32) where sendProbe :: Probe -> m () - sendProbe probe = void $ sendDirectMessage conn (XInfoProbe probe) (GroupId groupId) + sendProbe probe = void $ sendDirectMemberMessage conn (XInfoProbe probe) groupId sendProbeHashes :: [ContactOrMember] -> Probe -> Int64 -> m () sendProbeHashes cgms probe probeId = @@ -4369,12 +4481,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = probeHash = ProbeHash $ C.sha256Hash (unProbe probe) sendProbeHash :: ContactOrMember -> m () sendProbeHash cgm@(COMContact c) = do - void . sendDirectContactMessage c $ XInfoProbeCheck probeHash + void . sendDirectContactMessage user c $ XInfoProbeCheck probeHash withStore' $ \db -> createSentProbeHash db userId probeId cgm sendProbeHash (COMGroupMember GroupMember {activeConn = Nothing}) = pure () sendProbeHash cgm@(COMGroupMember m@GroupMember {groupId, activeConn = Just conn}) = when (memberCurrent m) $ do - void $ sendDirectMessage conn (XInfoProbeCheck probeHash) (GroupId groupId) + void $ sendDirectMemberMessage conn (XInfoProbeCheck probeHash) groupId withStore' $ \db -> createSentProbeHash db userId probeId cgm messageWarning :: Text -> m () @@ -4561,7 +4673,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles | otherwise = - withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case + withStore' (\db -> getCIModeration db vr user gInfo memberId sharedMsgId_) >>= \case Just ciModeration -> do applyModeration ciModeration withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_ @@ -4731,9 +4843,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- receiving via a separate connection Just fileConnReq -> do subMode <- chatReadVar subscriptionMode - dm <- directMessage XOk + dm <- encodeConnInfo XOk connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode - withStore' $ \db -> createSndDirectFTConnection db user fileId connIds subMode + withStore' $ \db -> createSndDirectFTConnection db vr user fileId connIds subMode -- receiving inline _ -> do event <- withStore $ \db -> do @@ -4743,7 +4855,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toView event ifM (allowSendInline fileSize fileInline) - (sendDirectFileInline ct ft sharedMsgId) + (sendDirectFileInline user ct ft sharedMsgId) (messageError "x.file.acpt.inv: fileSize is bigger than allowed to send inline") else messageError "x.file.acpt.inv: fileName is different from expected" @@ -4828,9 +4940,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = subMode <- chatReadVar subscriptionMode -- receiving via a separate connection -- [async agent commands] no continuation needed, but command should be asynchronous for stability - dm <- directMessage XOk + dm <- encodeConnInfo XOk connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode - withStore' $ \db -> createSndGroupFileTransferConnection db user fileId connIds m subMode + withStore' $ \db -> createSndGroupFileTransferConnection db vr user fileId connIds m subMode (_, Just conn) -> do -- receiving inline event <- withStore $ \db -> do @@ -4853,7 +4965,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processGroupInvitation ct inv msg msgMeta = do let Contact {localDisplayName = c, activeConn} = ct GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole), connRequest, groupLinkId} = inv - forM_ activeConn $ \Connection {connId, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'} -> do + forM_ activeConn $ \Connection {connId, connChatVersion, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'} -> do when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile @@ -4862,11 +4974,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = if sameGroupLinkId groupLinkId groupLinkId' then do subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt membershipMemId + dm <- encodeConnInfo $ XGrpAcpt membershipMemId connIds <- joinAgentConnectionAsync user True connRequest dm subMode withStore' $ \db -> do setViaGroupLinkHash db groupId connId - createMemberConnectionAsync db user hostId connIds (fromJVersionRange peerChatVRange) subMode + createMemberConnectionAsync db user hostId connIds connChatVersion peerChatVRange subMode updateGroupMemberStatusById db userId hostId GSMemAccepted updateGroupMemberStatus db userId membership GSMemAccepted toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) @@ -4897,7 +5009,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = if directOrUsed c then do ct' <- withStore' $ \db -> updateContactStatus db user c CSDeleted - contactConns <- withStore' $ \db -> getContactConnections db userId ct' + contactConns <- withStore' $ \db -> getContactConnections db vr userId ct' deleteAgentConnectionsAsync user $ map aConnId contactConns forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted} @@ -4906,7 +5018,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct'') ci) toView $ CRContactDeletedByContact user ct'' else do - contactConns <- withStore' $ \db -> getContactConnections db userId c + contactConns <- withStore' $ \db -> getContactConnections db vr userId c deleteAgentConnectionsAsync user $ map aConnId contactConns withStore $ \db -> deleteContact db user c where @@ -4977,7 +5089,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toView $ CRGroupMemberUpdated user gInfo m m' pure m' Just mContactId -> do - mCt <- withStore $ \db -> getContact db user mContactId + mCt <- withStore $ \db -> getContact db vr user mContactId if canUpdateProfile mCt then do (m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p' @@ -5018,7 +5130,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = contactMerge <- readTVarIO =<< asks contactMergeEnabled -- [incognito] unless connected incognito when (contactMerge && not (contactOrMemberIncognito cgm2)) $ do - cgm1s <- withStore' $ \db -> matchReceivedProbe db user cgm2 probe + cgm1s <- withStore' $ \db -> matchReceivedProbe db vr user cgm2 probe let cgm1s' = filter (not . contactOrMemberIncognito) cgm1s probeMatches cgm1s' cgm2 where @@ -5034,7 +5146,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = contactMerge <- readTVarIO =<< asks contactMergeEnabled -- [incognito] unless connected incognito when (contactMerge && not (contactOrMemberIncognito cgm1)) $ do - cgm2Probe_ <- withStore' $ \db -> matchReceivedProbeHash db user cgm1 probeHash + cgm2Probe_ <- withStore' $ \db -> matchReceivedProbeHash db vr user cgm1 probeHash forM_ cgm2Probe_ $ \(cgm2, probe) -> unless (contactOrMemberIncognito cgm2) . void $ probeMatch cgm1 cgm2 probe @@ -5046,12 +5158,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case cgm2 of COMContact c2@Contact {contactId = cId2, profile = p2} | cId1 /= cId2 && profilesMatch p1 p2 -> do - void . sendDirectContactMessage c1 $ XInfoProbeOk probe + void . sendDirectContactMessage user c1 $ XInfoProbeOk probe COMContact <$$> mergeContacts c1 c2 | otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId} | isNothing memberContactId && profilesMatch p1 p2 -> do - void . sendDirectContactMessage c1 $ XInfoProbeOk probe + void . sendDirectContactMessage user c1 $ XInfoProbeOk probe COMContact <$$> associateMemberAndContact c1 m2 | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing @@ -5059,14 +5171,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case cgm2 of COMContact c2@Contact {profile = p2} | memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do - void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId) + void $ sendDirectMemberMessage conn (XInfoProbeOk probe) groupId COMContact <$$> associateMemberAndContact c2 m1 | otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing xInfoProbeOk :: ContactOrMember -> Probe -> m () xInfoProbeOk cgm1 probe = do - cgm2 <- withStore' $ \db -> matchSentProbe db user cgm1 probe + cgm2 <- withStore' $ \db -> matchSentProbe db vr user cgm1 probe case cgm1 of COMContact c1@Contact {contactId = cId1} -> case cgm2 of @@ -5202,7 +5314,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = _ -> pure Nothing where merge c1' c2' = do - c2'' <- withStore $ \db -> mergeContactRecords db user c1' c2' + c2'' <- withStore $ \db -> mergeContactRecords db vr user c1' c2' toView $ CRContactsMerged user c1' c2' c2'' when (directOrUsed c2'') $ showSecurityCodeChanged c2'' pure $ Just c2'' @@ -5247,7 +5359,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = associateContactWithMember :: GroupMember -> Contact -> m Contact associateContactWithMember m1@GroupMember {groupId} c2 = do - c2' <- withStore $ \db -> associateContactWithMemberRecord db user m1 c2 + c2' <- withStore $ \db -> associateContactWithMemberRecord db vr user m1 c2 g <- withStore $ \db -> getGroupInfo db vr user groupId toView $ CRContactAndMemberAssociated user c2 g m1 c2' pure c2' @@ -5273,9 +5385,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _) msg brokerTs = do checkHostRole m memRole unless (sameMemberId memId $ membership gInfo) $ - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Right unknownMember@GroupMember {memberStatus = GSMemUnknown} -> do - updatedMember <- withStore $ \db -> updateUnknownMemberAnnounced db user m unknownMember memInfo + updatedMember <- withStore $ \db -> updateUnknownMemberAnnounced db vr user m unknownMember memInfo toView $ CRUnknownMemberAnnounced user gInfo m unknownMember updatedMember memberAnnouncedToView updatedMember Right _ -> messageError "x.grp.mem.new error: member already exists" @@ -5293,7 +5405,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do case memberCategory m of GCHostMember -> - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Right _ -> messageError "x.grp.mem.intro ignored: member already exists" Left _ -> do when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c) @@ -5302,27 +5414,29 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = groupConnIds <- createConn subMode directConnIds <- case memChatVRange of Nothing -> Just <$> createConn subMode - Just mcvr - | isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> pure Nothing + Just (ChatVersionRange mcvr) + | maxVersion mcvr >= groupDirectInvVersion -> pure Nothing | otherwise -> Just <$> createConn subMode let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo - void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo memRestrictions groupConnIds directConnIds customUserProfileId subMode + vr' = vr PQSupportOff + chatV = maybe (minVersion vr') (\peerVR -> vr' `peerConnChatVersion` fromChatVRange peerVR) memChatVRange + void $ withStore $ \db -> createIntroReMember db user gInfo m chatV memInfo memRestrictions groupConnIds directConnIds customUserProfileId subMode _ -> messageError "x.grp.mem.intro can be only sent by host member" where createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> m () sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do - hostConn <- withStore $ \db -> getConnectionById db user hostConnId + hostConn <- withStore $ \db -> getConnectionById db vr user hostConnId let msg = XGrpMemInv memberId IntroInvitation {groupConnReq, directConnReq} - void $ sendDirectMessage hostConn msg (GroupId groupId) + void $ sendDirectMemberMessage hostConn msg groupId withStore' $ \db -> updateGroupMemberStatusById db userId groupMemberId GSMemIntroInvited xGrpMemInv :: GroupInfo -> GroupMember -> MemberId -> IntroInvitation -> m () xGrpMemInv gInfo@GroupInfo {groupId} m memId introInv = do case memberCategory m of GCInviteeMember -> - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Left _ -> messageError "x.grp.mem.inv error: referenced member does not exist" Right reMember -> do GroupMemberIntro {introId} <- withStore $ \db -> saveIntroInvitation db reMember m introInv @@ -5336,7 +5450,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let GroupMember {memberId = membershipMemId} = membership checkHostRole m memRole toMember <- - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case -- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent -- the situation when member does not exist is an error -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that. @@ -5347,13 +5461,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = subMode <- chatReadVar subscriptionMode -- [incognito] send membership incognito profile, create direct connection as incognito let membershipProfile = redactedMemberProfile $ fromLocalProfile $ memberProfile membership - dm <- directMessage $ XGrpMemInfo membershipMemId membershipProfile + dm <- encodeConnInfo $ XGrpMemInfo membershipMemId membershipProfile -- [async agent commands] no continuation needed, but commands should be asynchronous for stability 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 memChatVRange - withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode + chatV = vr PQSupportOff `peerConnChatVersion` mcvr + withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> m () xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg brokerTs @@ -5361,7 +5476,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let gInfo' = gInfo {membership = membership {memberRole = memRole}} in changeMemberRole gInfo' membership $ RGEUserRole memRole | otherwise = - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole Left _ -> messageError "x.grp.mem.role with unknown member ID" where @@ -5390,7 +5505,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- member shouldn't receive this message about themselves messageError "x.grp.mem.restrict: admin blocks you" | otherwise = - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Right bm@GroupMember {groupMemberId = bmId, memberRole, memberProfile = bmp} | senderRole < GRAdmin || senderRole < memberRole -> messageError "x.grp.mem.restrict with insufficient member permissions" | otherwise -> do @@ -5409,12 +5524,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = setMemberBlocked bmId = withStore $ \db -> do liftIO $ updateGroupMemberBlocked db user groupId bmId restriction - getGroupMember db user groupId bmId + getGroupMember db vr user groupId bmId blocked = mrsBlocked restriction xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> m () xGrpMemCon gInfo sendingMember memId = do - refMember <- withStore $ \db -> getGroupMemberByMemberId db user gInfo memId + refMember <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo memId case (memberCategory sendingMember, memberCategory refMember) of (GCInviteeMember, GCInviteeMember) -> withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case @@ -5458,13 +5573,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = then checkRole membership $ do deleteGroupLinkIfExists user gInfo -- member records are not deleted to keep history - members <- withStore' $ \db -> getGroupMembers db user gInfo + members <- withStore' $ \db -> getGroupMembers db vr user gInfo deleteMembersConnections user members withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved deleteMemberItem RGEUserDeleted toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m else - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Left _ -> messageError "x.grp.mem.del with unknown member ID" Right member@GroupMember {groupMemberId, memberProfile} -> checkRole member $ do @@ -5496,7 +5611,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpDel gInfo@GroupInfo {membership} m@GroupMember {memberRole} msg brokerTs = do when (memberRole /= GROwner) $ throwChatError $ CEGroupUserRole gInfo GROwner ms <- withStore' $ \db -> do - members <- getGroupMembers db user gInfo + members <- getGroupMembers db vr user gInfo updateGroupMemberStatus db userId membership GSMemGroupDeleted pure members -- member records are not deleted to keep history @@ -5525,7 +5640,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case memberContactId of Nothing -> createNewContact subMode Just mContactId -> do - mCt <- withStore $ \db -> getContact db user mContactId + mCt <- withStore $ \db -> getContact db vr user mContactId let Contact {activeConn, contactGrpInvSent} = mCt forM_ activeConn $ \Connection {connId} -> if contactGrpInvSent @@ -5551,7 +5666,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = joinConn subMode = do -- [incognito] send membership incognito profile let p = userProfileToSend user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing False - dm <- directMessage $ XInfo p + dm <- encodeConnInfo $ XInfo p joinAgentConnectionAsync user True connReq dm subMode createItems mCt' m' = do createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing @@ -5568,7 +5683,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpMsgForward :: GroupInfo -> GroupMember -> MemberId -> ChatMessage 'Json -> UTCTime -> m () xGrpMsgForward gInfo@GroupInfo {groupId} m@GroupMember {memberRole, localDisplayName} memberId msg msgTs = do when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole localDisplayName) - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db user gInfo memberId) >>= \case + withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case Right author -> processForwardedMsg author msg Left (SEGroupMemberNotFoundByMemberId _) -> do unknownAuthor <- createUnknownMember gInfo memberId @@ -5670,45 +5785,85 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toView $ CRChatItemStatusUpdated user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) chatItem) _ -> pure () +createContactPQSndItem :: ChatMonad m => User -> Contact -> Connection -> PQEncryption -> m (Contact, Connection) +createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' = + flip catchChatError (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of + (Just b, b') | b' /= b -> createPQItem $ CISndConnEvent (SCEPqEnabled pqSndEnabled') + (Nothing, PQEncOn) -> createPQItem $ CISndDirectE2EEInfo (E2EInfo pqSndEnabled') + _ -> pure (ct, conn) + where + createPQItem ciContent = do + let conn' = conn {pqSndEnabled = Just pqSndEnabled'} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact + when (contactPQEnabled ct /= contactPQEnabled ct') $ do + createInternalChatItem user (CDDirectSnd ct') ciContent Nothing + toView $ CRContactPQEnabled user ct' pqSndEnabled' + pure (ct', conn') + +updateContactPQRcv :: ChatMonad m => User -> Contact -> Connection -> PQEncryption -> m (Contact, Connection) +updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled' = + flip catchChatError (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of + (Just b, b') | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPqEnabled pqRcvEnabled') + (Nothing, PQEncOn) -> updatePQ $ CIRcvDirectE2EEInfo (E2EInfo pqRcvEnabled') + _ -> pure (ct, conn) + where + updatePQ ciContent = do + withStore' $ \db -> updateConnPQRcvEnabled db connId pqRcvEnabled' + let conn' = conn {pqRcvEnabled = Just pqRcvEnabled'} :: Connection + ct' = ct {activeConn = Just conn'} :: Contact + when (contactPQEnabled ct /= contactPQEnabled ct') $ do + createInternalChatItem user (CDDirectRcv ct') ciContent Nothing + toView $ CRContactPQEnabled user ct' pqRcvEnabled' + pure (ct', conn') + metaBrokerTs :: MsgMeta -> UTCTime metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs sameMemberId :: MemberId -> GroupMember -> Bool sameMemberId memId GroupMember {memberId} = memId == memberId -updatePeerChatVRange :: ChatMonad m => Connection -> VersionRange -> m Connection -updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange = do - let jMsgChatVRange = JVersionRange msgChatVRange - if jMsgChatVRange /= peerChatVRange +-- TODO v5.7 for contacts only version upgrade should trigger enabling PQ support/encryption +updatePeerChatVRange :: ChatMonad m => Connection -> VersionRangeChat -> m Connection +updatePeerChatVRange conn@Connection {connId, connChatVersion = v, peerChatVRange, pqSupport} msgVRange = do + v' <- upgradedConnVersion pqSupport v msgVRange + if msgVRange /= peerChatVRange || v' /= v then do - withStore' $ \db -> setPeerChatVRange db connId msgChatVRange - pure conn {peerChatVRange = jMsgChatVRange} + withStore' $ \db -> setPeerChatVRange db connId v' msgVRange + pure conn {connChatVersion = v', peerChatVRange = msgVRange} else pure conn -updateMemberChatVRange :: ChatMonad m => GroupMember -> Connection -> VersionRange -> m (GroupMember, Connection) -updateMemberChatVRange mem@GroupMember {groupMemberId} conn@Connection {connId, peerChatVRange} msgChatVRange = do - let jMsgChatVRange = JVersionRange msgChatVRange - if jMsgChatVRange /= peerChatVRange +updateMemberChatVRange :: ChatMonad m => GroupMember -> Connection -> VersionRangeChat -> m (GroupMember, Connection) +updateMemberChatVRange mem@GroupMember {groupMemberId} conn@Connection {connId, connChatVersion = v, peerChatVRange} msgVRange = do + v' <- upgradedConnVersion PQSupportOff v msgVRange + if msgVRange /= peerChatVRange || v' /= v then do withStore' $ \db -> do - setPeerChatVRange db connId msgChatVRange - setMemberChatVRange db groupMemberId msgChatVRange - let conn' = conn {peerChatVRange = jMsgChatVRange} - pure (mem {memberChatVRange = jMsgChatVRange, activeConn = Just conn'}, conn') + setPeerChatVRange db connId v' msgVRange + setMemberChatVRange db groupMemberId msgVRange + let conn' = conn {connChatVersion = v', peerChatVRange = msgVRange} + pure (mem {memberChatVRange = msgVRange, activeConn = Just conn'}, conn') else pure (mem, conn) +upgradedConnVersion :: ChatMonad' m => PQSupport -> VersionChat -> VersionRangeChat -> m VersionChat +upgradedConnVersion pqSup v peerVR = do + vr <- chatVersionRange + -- don't allow reducing agreed connection version + pure $ maybe v (\(Compatible v') -> max v v') $ vr pqSup `compatibleVersion` peerVR + parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p) parseFileDescription = liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8) -sendDirectFileInline :: ChatMonad m => Contact -> FileTransferMeta -> SharedMsgId -> m () -sendDirectFileInline ct ft sharedMsgId = do - msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage ct +sendDirectFileInline :: ChatMonad m => User -> Contact -> FileTransferMeta -> SharedMsgId -> m () +sendDirectFileInline user ct ft sharedMsgId = do + msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage user ct withStore $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId sendMemberFileInline :: ChatMonad m => GroupMember -> Connection -> FileTransferMeta -> SharedMsgId -> m () sendMemberFileInline m@GroupMember {groupId} conn ft sharedMsgId = do - msgDeliveryId <- sendFileInline_ ft sharedMsgId $ \msg -> sendDirectMessage conn msg $ GroupId groupId + msgDeliveryId <- sendFileInline_ ft sharedMsgId $ \msg -> do + (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg groupId + pure (sndMsg, msgDeliveryId) withStore' $ \db -> updateSndGroupFTDelivery db m conn ft msgDeliveryId sendFileInline_ :: ChatMonad m => FileTransferMeta -> SharedMsgId -> (ChatMsgEvent 'Binary -> m (SndMessage, Int64)) -> m Int64 @@ -5750,7 +5905,7 @@ sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentCo sendFileChunkNo :: ChatMonad m => SndFileTransfer -> Integer -> m () sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do chunkBytes <- readFileChunk ft chunkNo - msgId <- withAgent $ \a -> sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes} + (msgId, _) <- withAgent $ \a -> sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes} withStore' $ \db -> updateSndFileChunkMsg db ft chunkNo msgId readFileChunk :: ChatMonad m => SndFileTransfer -> Integer -> m ByteString @@ -5845,6 +6000,7 @@ cancelSndFile user FileTransferMeta {fileId, xftpSndFile} fts sendCancel = do agentXFTPDeleteSndFileRemote user xsf fileId `catchChatError` (toView . CRChatError (Just user)) pure [] +-- TODO v6.0 remove cancelSndFileTransfer :: ChatMonad m => User -> SndFileTransfer -> Bool -> m (Maybe ConnId) cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, agentConnId = AgentConnId acId, fileStatus, fileInline} sendCancel = if fileStatus == FSCancelled || fileStatus == FSComplete @@ -5857,9 +6013,10 @@ cancelSndFileTransfer user@User {userId} ft@SndFileTransfer {fileId, connId, age deleteSndFileChunks db ft when sendCancel $ case fileInline of Just _ -> do - (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db user connId - void . sendDirectMessage conn (BFileChunk sharedMsgId FileChunkCancel) $ ConnectionId connId - _ -> withAgent $ \a -> void . sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel + vr <- chatVersionRange + (sharedMsgId, conn) <- withStore $ \db -> (,) <$> getSharedMsgIdByFileId db userId fileId <*> getConnectionById db vr user connId + void $ sendDirectMessage_ conn PQSupportOff (BFileChunk sharedMsgId FileChunkCancel) (ConnectionId connId) + _ -> withAgent $ \a -> void . sendMessage a acId PQEncOff SMP.noMsgFlags $ smpEncode FileChunkCancel pure fileConnId fileConnId = if isNothing fileInline then Just acId else Nothing @@ -5896,10 +6053,13 @@ deleteOrUpdateMemberRecord user@User {userId} member = Just _ -> updateGroupMemberStatus db userId member GSMemRemoved Nothing -> deleteGroupMember db user member -sendDirectContactMessage :: (MsgEncodingI e, ChatMonad m) => Contact -> ChatMsgEvent e -> m (SndMessage, Int64) -sendDirectContactMessage ct chatMsgEvent = do - conn@Connection {connId} <- liftEither $ contactSendConn_ ct - sendDirectMessage conn chatMsgEvent (ConnectionId connId) +sendDirectContactMessage :: (MsgEncodingI e, ChatMonad m) => User -> Contact -> ChatMsgEvent e -> m (SndMessage, Int64) +sendDirectContactMessage user ct chatMsgEvent = do + conn@Connection {connId, pqSupport} <- liftEither $ contactSendConn_ ct + r <- sendDirectMessage_ conn pqSupport chatMsgEvent (ConnectionId connId) + let (sndMessage, msgDeliveryId, pqEnc') = r + void $ createContactPQSndItem user ct conn pqEnc' + pure (sndMessage, msgDeliveryId) contactSendConn_ :: Contact -> Either ChatError Connection contactSendConn_ ct@Contact {activeConn} = case activeConn of @@ -5912,84 +6072,147 @@ contactSendConn_ ct@Contact {activeConn} = case activeConn of where err = Left . ChatError -sendDirectMessage :: (MsgEncodingI e, ChatMonad m) => Connection -> ChatMsgEvent e -> ConnOrGroupId -> m (SndMessage, Int64) -sendDirectMessage conn chatMsgEvent connOrGroupId = do +-- unlike sendGroupMemberMessage, this function will not store message as pending +-- TODO v5.8 we could remove pending messages once all clients support forwarding +sendDirectMemberMessage :: (MsgEncodingI e, ChatMonad m) => Connection -> ChatMsgEvent e -> GroupId -> m (SndMessage, Int64, PQEncryption) +sendDirectMemberMessage conn chatMsgEvent groupId = sendDirectMessage_ conn PQSupportOff chatMsgEvent (GroupId groupId) + +sendDirectMessage_ :: (MsgEncodingI e, ChatMonad m) => Connection -> PQSupport -> ChatMsgEvent e -> ConnOrGroupId -> m (SndMessage, Int64, PQEncryption) +sendDirectMessage_ conn pqSup chatMsgEvent connOrGroupId = do when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) - msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId - (msg,) <$> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId + msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId pqSup + -- TODO move compressed body to SndMessage and compress in createSndMessage + (msgDeliveryId, pqEnc') <- deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId + pure (msg, msgDeliveryId, pqEnc') -createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> m SndMessage -createSndMessage chatMsgEvent connOrGroupId = - liftEither . runIdentity =<< createSndMessages (Identity (connOrGroupId, chatMsgEvent)) +createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> PQSupport -> m SndMessage +createSndMessage chatMsgEvent connOrGroupId pqSup = + liftEither . runIdentity =<< createSndMessages (Identity (connOrGroupId, pqSup, chatMsgEvent)) -createSndMessages :: forall e m t. (MsgEncodingI e, ChatMonad' m, Traversable t) => t (ConnOrGroupId, ChatMsgEvent e) -> m (t (Either ChatError SndMessage)) +createSndMessages :: forall e m t. (MsgEncodingI e, ChatMonad' m, Traversable t) => t (ConnOrGroupId, PQSupport, ChatMsgEvent e) -> m (t (Either ChatError SndMessage)) createSndMessages idsEvents = do - gVar <- asks random + g <- asks random vr <- chatVersionRange - withStoreBatch $ \db -> fmap (uncurry (createMsg db gVar vr)) idsEvents + withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents where - createMsg db gVar chatVRange connOrGroupId evnt = runExceptT $ do - withExceptT ChatErrorStore $ createNewSndMessage db gVar connOrGroupId evnt (encodeMessage chatVRange evnt) - encodeMessage chatVRange evnt sharedMsgId = - encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent = evnt} + createMsg :: DB.Connection -> TVar ChaChaDRG -> (PQSupport -> VersionRangeChat) -> (ConnOrGroupId, PQSupport, ChatMsgEvent e) -> IO (Either ChatError SndMessage) + createMsg db g vr (connOrGroupId, pqSup, evnt) = runExceptT $ do + withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId evnt encodeMessage + where + encodeMessage sharedMsgId = + encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr pqSup, msgId = Just sharedMsgId, chatMsgEvent = evnt} sendGroupMemberMessages :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> m () -sendGroupMemberMessages user conn@Connection {connId} events groupId = do +sendGroupMemberMessages user conn events groupId = do when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn) - let idsEvts = L.map (GroupId groupId,) events + let idsEvts = L.map (GroupId groupId,PQSupportOff,) events (errs, msgs) <- partitionEithers . L.toList <$> createSndMessages idsEvts unless (null errs) $ toView $ CRChatErrors (Just user) errs - unless (null msgs) $ do - let (errs', msgBatches) = partitionEithers $ batchMessages maxChatMsgSize msgs + forM_ (L.nonEmpty msgs) $ \msgs' -> do + -- TODO v5.7 based on version (?) + -- let shouldCompress = False + -- batched <- if shouldCompress then batchSndMessagesBinary msgs' else pure $ batchSndMessagesJSON msgs' + let batched = batchSndMessagesJSON msgs' + let (errs', msgBatches) = partitionEithers batched -- shouldn't happen, as large messages would have caused createNewSndMessage to throw SELargeMsg unless (null errs') $ toView $ CRChatErrors (Just user) errs' forM_ msgBatches $ \batch -> - processBatch batch `catchChatError` (toView . CRChatError (Just user)) - where - processBatch :: MsgBatch -> m () - processBatch (MsgBatch batchBody sndMsgs) = do - agentMsgId <- withAgent $ \a -> sendMessage a (aConnId conn) MsgFlags {notification = True} batchBody - let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId} - void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs + processSndMessageBatch conn batch `catchChatError` (toView . CRChatError (Just user)) -directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString -directMessage chatMsgEvent = do - chatVRange <- chatVersionRange - let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} - case r of - ECMEncoded encodedBody -> pure encodedBody - ECMLarge -> throwChatError $ CEException "large message" +processSndMessageBatch :: ChatMonad m => Connection -> MsgBatch -> m () +processSndMessageBatch conn@Connection {connId} (MsgBatch batchBody sndMsgs) = do + (agentMsgId, _pqEnc) <- withAgent $ \a -> sendMessage a (aConnId conn) PQEncOff MsgFlags {notification = True} batchBody + let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId} + void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs -deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64 +-- TODO v5.7 update batching for groups +batchSndMessagesJSON :: NonEmpty SndMessage -> [Either ChatError MsgBatch] +batchSndMessagesJSON = batchMessages maxEncodedMsgLength . L.toList + +-- batchSndMessagesBinary :: forall m. ChatMonad m => NonEmpty SndMessage -> m [Either ChatError MsgBatch] +-- batchSndMessagesBinary msgs = do +-- compressed <- liftIO $ withCompressCtx maxChatMsgSize $ \cctx -> mapM (compressForBatch cctx) msgs +-- pure . map toMsgBatch . SMP.batchTransmissions_ (maxEncodedMsgLength) $ L.zip compressed msgs +-- where +-- compressForBatch cctx SndMessage {msgBody} = bimap (const TELargeMsg) smpEncode <$> compress cctx msgBody +-- toMsgBatch :: SMP.TransportBatch SndMessage -> Either ChatError MsgBatch +-- toMsgBatch = \case +-- SMP.TBTransmissions combined _n sms -> Right $ MsgBatch (markCompressedBatch combined) sms +-- SMP.TBError tbe SndMessage {msgId} -> Left . ChatError $ CEInternalError (show tbe <> " " <> show msgId) +-- SMP.TBTransmission {} -> Left . ChatError $ CEInternalError "batchTransmissions_ didn't produce a batch" + +encodeConnInfo :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString +encodeConnInfo chatMsgEvent = do + vr <- chatVersionRange + encodeConnInfoPQ PQSupportOff (maxVersion $ vr PQSupportOff) chatMsgEvent + +encodeConnInfoPQ :: (MsgEncodingI e, ChatMonad m) => PQSupport -> VersionChat -> ChatMsgEvent e -> m ByteString +encodeConnInfoPQ pqSup v chatMsgEvent = do + vr <- chatVersionRange + let info = ChatMessage {chatVRange = vr pqSup, msgId = Nothing, chatMsgEvent} + case encodeChatMessage maxEncodedInfoLength info of + ECMEncoded connInfo -> case pqSup of + PQSupportOn | v >= pqEncryptionCompressionVersion && B.length connInfo > maxCompressedInfoLength -> do + connInfo' <- liftIO compressedBatchMsgBody + when (B.length connInfo' > maxCompressedInfoLength) $ throwChatError $ CEException "large compressed info" + pure connInfo' + _ -> pure connInfo + where + compressedBatchMsgBody = withCompressCtx (toEnum $ B.length connInfo) (`compressedBatchMsgBody_` connInfo) + ECMLarge -> throwChatError $ CEException "large info" + +deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m (Int64, PQEncryption) deliverMessage conn cmEventTag msgBody msgId = do let msgFlags = MsgFlags {notification = hasNotification cmEventTag} deliverMessage' conn msgFlags msgBody msgId -deliverMessage' :: ChatMonad m => Connection -> MsgFlags -> MsgBody -> MessageId -> m Int64 +deliverMessage' :: ChatMonad m => Connection -> MsgFlags -> MsgBody -> MessageId -> m (Int64, PQEncryption) deliverMessage' conn msgFlags msgBody msgId = - deliverMessages [(conn, msgFlags, msgBody, msgId)] >>= \case - [r] -> liftEither r + deliverMessages ((conn, msgFlags, msgBody, msgId) :| []) >>= \case + r :| [] -> liftEither r rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs) type MsgReq = (Connection, MsgFlags, MsgBody, MessageId) -deliverMessages :: ChatMonad' m => [MsgReq] -> m [Either ChatError Int64] -deliverMessages = deliverMessagesB . map Right +deliverMessages :: ChatMonad' m => NonEmpty MsgReq -> m (NonEmpty (Either ChatError (Int64, PQEncryption))) +deliverMessages msgs = deliverMessagesB $ L.map Right msgs -deliverMessagesB :: ChatMonad' m => [Either ChatError MsgReq] -> m [Either ChatError Int64] +deliverMessagesB :: forall m. ChatMonad' m => NonEmpty (Either ChatError MsgReq) -> m (NonEmpty (Either ChatError (Int64, PQEncryption))) deliverMessagesB msgReqs = do - sent <- zipWith prepareBatch msgReqs <$> withAgent' (`sendMessagesB` map toAgent msgReqs) - withStoreBatch $ \db -> map (bindRight $ createDelivery db) sent + msgReqs' <- compressBodies + sent <- L.zipWith prepareBatch msgReqs' <$> withAgent' (`sendMessagesB` L.map toAgent msgReqs') + void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent) + withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent where + compressBodies = liftIO $ withCompressCtx (toEnum maxEncodedMsgLength) $ \cxt -> + forME msgReqs $ \mr@(conn@Connection {pqSupport, connChatVersion = v}, msgFlags, msgBody, msgId) -> + runExceptT $ case pqSupport of + -- we only compress messages when: + -- 1) PQ support is enabled + -- 2) version is compatible with compression + -- 3) message is longer than max compressed size (as this function is not used for batched messages anyway) + PQSupportOn | v >= pqEncryptionCompressionVersion && B.length msgBody > maxCompressedMsgLength -> do + msgBody' <- liftIO $ compressedBatchMsgBody_ cxt msgBody + when (B.length msgBody' > maxCompressedMsgLength) $ throwError $ ChatError $ CEException "large compressed message" + pure (conn, msgFlags, msgBody', msgId) + _ -> pure mr toAgent = \case - Right (conn, msgFlags, msgBody, _msgId) -> Right (aConnId conn, msgFlags, msgBody) + Right (conn@Connection {pqEncryption}, msgFlags, msgBody, _msgId) -> Right (aConnId conn, pqEncryption, msgFlags, msgBody) Left _ce -> Left (AP.INTERNAL "ChatError, skip") -- as long as it is Left, the agent batchers should just step over it prepareBatch (Right req) (Right ar) = Right (req, ar) prepareBatch (Left ce) _ = Left ce -- restore original ChatError prepareBatch _ (Left ae) = Left $ ChatErrorAgent ae Nothing - createDelivery :: DB.Connection -> (MsgReq, AgentMsgId) -> IO (Either ChatError Int64) - createDelivery db ((Connection {connId}, _, _, msgId), agentMsgId) = - Right <$> createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId}) msgId + createDelivery :: DB.Connection -> (MsgReq, (AgentMsgId, PQEncryption)) -> IO (Either ChatError (Int64, PQEncryption)) + createDelivery db ((Connection {connId}, _, _, msgId), (agentMsgId, pqEnc')) = + Right . (,pqEnc') <$> createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId}) msgId + updatePQSndEnabled :: DB.Connection -> (MsgReq, (AgentMsgId, PQEncryption)) -> IO () + updatePQSndEnabled db ((Connection {connId, pqSndEnabled}, _, _, _), (_, pqSndEnabled')) = + case (pqSndEnabled, pqSndEnabled') of + (Just b, b') | b' /= b -> updatePQ + (Nothing, PQEncOn) -> updatePQ + _ -> pure () + where + updatePQ = updateConnPQSndEnabled db connId pqSndEnabled' sendGroupMessage :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember]) sendGroupMessage user gInfo members chatMsgEvent = do @@ -6007,7 +6230,7 @@ sendGroupMessage user gInfo members chatMsgEvent = do (Nothing, Just _) -> True _ -> False sendProfileUpdate = do - let members' = filter (\m -> isCompatibleRange (memberChatVRange' m) memberProfileUpdateVRange) members + let members' = filter (`supportsVersion` memberProfileUpdateVersion) members profileUpdateEvent = XInfo $ redactedMemberProfile $ fromLocalProfile p void $ sendGroupMessage' user gInfo members' profileUpdateEvent currentTs <- liftIO getCurrentTime @@ -6015,12 +6238,13 @@ sendGroupMessage user gInfo members chatMsgEvent = do sendGroupMessage' :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember]) sendGroupMessage' user GroupInfo {groupId} members chatMsgEvent = do - msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId) + msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId) PQSupportOff recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) let msgFlags = MsgFlags {notification = hasNotification $ toCMEventTag chatMsgEvent} (toSend, pending) = foldr addMember ([], []) recipientMembers + -- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here msgReqs = map (\(_, conn) -> (conn, msgFlags, msgBody, msgId)) toSend - delivered <- deliverMessages msgReqs + delivered <- maybe (pure []) (fmap L.toList . deliverMessages) $ L.nonEmpty msgReqs let errors = lefts delivered unless (null errors) $ toView $ CRChatErrors (Just user) errors stored <- withStoreBatch' $ \db -> map (\m -> createPendingGroupMessage db (groupMemberId' m) msgId Nothing) pending @@ -6055,16 +6279,12 @@ memberSendAction chatMsgEvent members m@GroupMember {invitedByGroupMemberId} = c | isXGrpMsgForward chatMsgEvent = Nothing | otherwise = Just MSAPending where - forwardSupported = - let mcvr = memberChatVRange' m - in isCompatibleRange mcvr groupForwardVRange && invitingMemberSupportsForward + forwardSupported = m `supportsVersion` groupForwardVersion && invitingMemberSupportsForward invitingMemberSupportsForward = case invitedByGroupMemberId of Just invMemberId -> -- can be optimized for large groups by replacing [GroupMember] with Map GroupMemberId GroupMember case find (\m' -> groupMemberId' m' == invMemberId) members of - Just invitingMember -> do - let mcvr = memberChatVRange' invitingMember - isCompatibleRange mcvr groupForwardVRange + Just invitingMember -> invitingMember `supportsVersion` groupForwardVersion Nothing -> False Nothing -> False isXGrpMsgForward ev = case ev of @@ -6073,7 +6293,7 @@ memberSendAction chatMsgEvent members m@GroupMember {invitedByGroupMemberId} = c sendGroupMemberMessage :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> GroupMember -> ChatMsgEvent e -> Int64 -> Maybe Int64 -> m () -> m () sendGroupMemberMessage user m@GroupMember {groupMemberId} chatMsgEvent groupId introId_ postDeliver = do - msg <- createSndMessage chatMsgEvent (GroupId groupId) + msg <- createSndMessage chatMsgEvent (GroupId groupId) PQSupportOff messageMember msg `catchChatError` (\e -> toView (CRChatError (Just user) e)) where messageMember :: SndMessage -> m () @@ -6121,9 +6341,10 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta withStore (\db -> createNewMessageAndRcvMsgDelivery db (GroupId groupId) newMsg sharedMsgId_ rcvMsgDelivery $ Just amGroupMemId) `catchChatError` \e -> case e of ChatErrorStore (SEDuplicateGroupMessage _ _ _ (Just forwardedByGroupMemberId)) -> do - fm <- withStore $ \db -> getGroupMember db user groupId forwardedByGroupMemberId + vr <- chatVersionRange + fm <- withStore $ \db -> getGroupMember db vr user groupId forwardedByGroupMemberId forM_ (memberConn fm) $ \fmConn -> - void $ sendDirectMessage fmConn (XGrpMemCon amMemId) (GroupId groupId) + void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemId) groupId throwError e _ -> throwError e pure (am', conn', msg) @@ -6136,10 +6357,11 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId) `catchChatError` \e -> case e of ChatErrorStore (SEDuplicateGroupMessage _ _ (Just authorGroupMemberId) Nothing) -> do - am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db user groupId authorGroupMemberId + vr <- chatVersionRange + am@GroupMember {memberId = amMemberId} <- withStore $ \db -> getGroupMember db vr user groupId authorGroupMemberId if sameMemberId refMemberId am then forM_ (memberConn forwardingMember) $ \fmConn -> - void $ sendDirectMessage fmConn (XGrpMemCon amMemberId) (GroupId groupId) + void $ sendDirectMemberMessage fmConn (XGrpMemCon amMemberId) groupId else toView $ CRMessageError user "error" "saveGroupFwdRcvMsg: referenced author member id doesn't match message member id" throwError e _ -> throwError e @@ -6235,27 +6457,27 @@ cancelCIFile user file_ = createAgentConnectionAsync :: forall m c. (ChatMonad m, ConnectionModeI c) => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> m (CommandId, ConnId) createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction - connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode subMode + connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode IKPQOff subMode pure (cmdId, connId) joinAgentConnectionAsync :: ChatMonad m => User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> m (CommandId, ConnId) joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn - connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo subMode + connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo PQSupportOff subMode pure (cmdId, connId) allowAgentConnectionAsync :: (MsgEncodingI e, ChatMonad m) => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> m () -allowAgentConnectionAsync user conn@Connection {connId} confId msg = do +allowAgentConnectionAsync user conn@Connection {connId, pqSupport, connChatVersion} confId msg = do cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn - dm <- directMessage msg + dm <- encodeConnInfoPQ pqSupport connChatVersion msg withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm withStore' $ \db -> updateConnectionStatus db conn ConnAccepted -agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> m (CommandId, ConnId) -agentAcceptContactAsync user enableNtfs invId msg subMode = do +agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> PQSupport -> VersionChat -> m (CommandId, ConnId) +agentAcceptContactAsync user enableNtfs invId msg subMode pqSup chatV = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact - dm <- directMessage msg - connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm subMode + dm <- encodeConnInfoPQ pqSup chatV msg + connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm pqSup subMode pure (cmdId, connId) deleteAgentConnectionAsync :: ChatMonad m => User -> ConnId -> m () @@ -6489,10 +6711,11 @@ waitChatStartedAndActivated = do activated <- readTVar chatActivated unless (isJust started && activated) retry -chatVersionRange :: ChatMonad' m => m VersionRange +chatVersionRange :: ChatMonad' m => m (PQSupport -> VersionRangeChat) chatVersionRange = do ChatConfig {chatVRange} <- asks config pure chatVRange +{-# INLINE chatVersionRange #-} chatCommandP :: Parser ChatCommand chatCommandP = @@ -6536,6 +6759,9 @@ chatCommandP = "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath), "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP), "/contact_merge " *> (SetContactMergeEnabled <$> onOffP), + "/_pq @" *> (APISetContactPQ <$> A.decimal <* A.space <*> (PQEncryption <$> onOffP)), + "/pq @" *> (SetContactPQ <$> displayName <* A.space <*> (PQEncryption <$> onOffP)), + "/pq " *> (APISetPQEncryption . PQSupport <$> onOffP), "/_db export " *> (APIExportArchive <$> jsonP), "/db export" $> ExportArchive, "/_db import " *> (APIImportArchive <$> jsonP), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 9c85d90b43..b2d82a0243 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -72,6 +72,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import qualified Simplex.Messaging.Crypto.File as CF +import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..)) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus) import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON) @@ -80,7 +81,6 @@ import Simplex.Messaging.TMap (TMap) import Simplex.Messaging.Transport (TLS, simplexMQVersion) import Simplex.Messaging.Transport.Client (TransportHost) import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>)) -import Simplex.Messaging.Version import Simplex.RemoteControl.Client import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitation) import Simplex.RemoteControl.Types @@ -122,7 +122,7 @@ coreVersionInfo simplexmqCommit = data ChatConfig = ChatConfig { agentConfig :: AgentConfig, - chatVRange :: VersionRange, + chatVRange :: PQSupport -> VersionRangeChat, confirmMigrations :: MigrationConfirmation, defaultServers :: DefaultAgentServers, tbqSize :: Natural, @@ -206,7 +206,8 @@ data ChatController = ChatController encryptLocalFiles :: TVar Bool, tempDirectory :: TVar (Maybe FilePath), logFilePath :: Maybe FilePath, - contactMergeEnabled :: TVar Bool + contactMergeEnabled :: TVar Bool, + pqExperimentalEnabled :: TVar PQSupport -- TODO v5.7 remove } data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSRemote | HSSettings | HSDatabase @@ -243,6 +244,9 @@ data ChatCommand | SetRemoteHostsFolder FilePath | APISetEncryptLocalFiles Bool | SetContactMergeEnabled Bool + | APISetPQEncryption PQSupport + | APISetContactPQ ContactId PQEncryption + | SetContactPQ ContactName PQEncryption | APIExportArchive ArchiveConfig | ExportArchive | APIImportArchive ArchiveConfig @@ -699,6 +703,8 @@ data ChatResponse | CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text} | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo} | CRRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason} + | CRContactPQAllowed {user :: User, contact :: Contact, pqEncryption :: PQEncryption} + | CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption} | CRSQLResult {rows :: [Text]} | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]} | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks} diff --git a/src/Simplex/Chat/Help.hs b/src/Simplex/Chat/Help.hs index ac93e05533..adb77b9557 100644 --- a/src/Simplex/Chat/Help.hs +++ b/src/Simplex/Chat/Help.hs @@ -185,6 +185,8 @@ contactsHelpInfo = indent <> highlight "/verify @ " <> " - clear security code verification", indent <> highlight "/info @ " <> " - info about contact connection", indent <> highlight "/switch @ " <> " - switch receiving messages to another SMP relay", + indent <> highlight "/pq @ on/off " <> " - [BETA] toggle quantum resistant / standard e2e encryption for a contact", + indent <> " " <> " (both have to enable for quantum resistance)", "", green "Contact chat preferences:", indent <> highlight "/set voice @ yes/no/always " <> " - allow/prohibit voice messages with the contact", @@ -320,6 +322,7 @@ settingsInfo = map styleMarkdown [ green "Chat settings:", + indent <> highlight "/pq on/off " <> " - [BETA] toggle quantum resistant / standard e2e encryption for the new contacts", indent <> highlight "/network " <> " - show / set network access options", indent <> highlight "/smp " <> " - show / set configured SMP servers", indent <> highlight "/xftp " <> " - show / set configured XFTP servers", diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index a79eb0d952..0e95570b85 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -6,6 +6,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} @@ -29,6 +30,7 @@ import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Util import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..)) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOn, pattern PQEncOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON) import Simplex.Messaging.Util (safeDecodeUtf8, tshow, (<$?>)) @@ -139,13 +141,21 @@ data CIContent (d :: MsgDirection) where CISndModerated :: CIContent 'MDSnd CIRcvModerated :: CIContent 'MDRcv CIRcvBlocked :: CIContent 'MDRcv + CISndDirectE2EEInfo :: E2EInfo -> CIContent 'MDSnd + CIRcvDirectE2EEInfo :: E2EInfo -> CIContent 'MDRcv + CISndGroupE2EEInfo :: E2EInfo -> CIContent 'MDSnd -- when new group is created + CIRcvGroupE2EEInfo :: E2EInfo -> CIContent 'MDRcv -- when enabled with some member CIInvalidJSON :: Text -> CIContent d -- this is also used for logical database errors, e.g. SEBadChatItem + -- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API -- ! ^ Nested sum types also have to use different encodings for database and API -- ! ^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent deriving instance Show (CIContent d) +data E2EInfo = E2EInfo {pqEnabled :: PQEncryption} + deriving (Eq, Show) + ciMsgContent :: CIContent d -> Maybe MsgContent ciMsgContent = \case CISndMsgContent mc -> Just mc @@ -195,6 +205,8 @@ ciRequiresAttention content = case msgDirection @d of CIRcvGroupFeatureRejected _ -> True CIRcvModerated -> True CIRcvBlocked -> False + CIRcvDirectE2EEInfo _ -> False + CIRcvGroupE2EEInfo _ -> False CIInvalidJSON _ -> False newtype DBMsgErrorType = DBME MsgErrorType @@ -250,8 +262,28 @@ ciContentToText = \case CISndModerated -> ciModeratedText CIRcvModerated -> ciModeratedText CIRcvBlocked -> "blocked" + CISndDirectE2EEInfo e2eeInfo -> directE2EInfoToText e2eeInfo + CIRcvDirectE2EEInfo e2eeInfo -> directE2EInfoToText e2eeInfo + CISndGroupE2EEInfo e2eeInfo -> groupE2EInfoToText e2eeInfo + CIRcvGroupE2EEInfo e2eeInfo -> groupE2EInfoToText e2eeInfo CIInvalidJSON _ -> "invalid content JSON" +directE2EInfoToText :: E2EInfo -> Text +directE2EInfoToText E2EInfo {pqEnabled} = case pqEnabled of + PQEncOn -> e2eInfoPQText + PQEncOff -> e2eInfoNoPQText + +groupE2EInfoToText :: E2EInfo -> Text +groupE2EInfoToText _e2eeInfo = e2eInfoNoPQText + +e2eInfoNoPQText :: Text +e2eInfoNoPQText = + "This conversation is protected by end-to-end encryption with perfect forward secrecy, repudiation and break-in recovery." + +e2eInfoPQText :: Text +e2eInfoPQText = + "This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery." + ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role = "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role) @@ -295,6 +327,9 @@ rcvConnEventToText = \case SPCompleted -> "changed address for you" RCERatchetSync syncStatus -> ratchetSyncStatusToText syncStatus RCEVerificationCodeReset -> "security code changed" + RCEPqEnabled pqEnc -> case pqEnc of + PQEncOn -> "quantum resistant e2e encryption" + PQEncOff -> "standard end-to-end encryption" ratchetSyncStatusToText :: RatchetSyncState -> Text ratchetSyncStatusToText = \case @@ -312,6 +347,9 @@ sndConnEventToText = \case SPSecured -> "secured new address" <> forMember m <> "..." SPCompleted -> "you changed address" <> forMember m SCERatchetSync syncStatus m -> ratchetSyncStatusToText syncStatus <> forMember m + SCEPqEnabled pqEnc -> case pqEnc of + PQEncOn -> "quantum resistant e2e encryption" + PQEncOff -> "standard end-to-end encryption" where forMember member_ = maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_ @@ -382,6 +420,10 @@ data JSONCIContent | JCISndModerated | JCIRcvModerated | JCIRcvBlocked + | JCISndDirectE2EEInfo {e2eeInfo :: E2EInfo} + | JCIRcvDirectE2EEInfo {e2eeInfo :: E2EInfo} + | JCISndGroupE2EEInfo {e2eeInfo :: E2EInfo} + | JCIRcvGroupE2EEInfo {e2eeInfo :: E2EInfo} | JCIInvalidJSON {direction :: MsgDirection, json :: Text} jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent @@ -412,6 +454,10 @@ jsonCIContent = \case CISndModerated -> JCISndModerated CIRcvModerated -> JCIRcvModerated CIRcvBlocked -> JCIRcvBlocked + CISndDirectE2EEInfo e2eeInfo -> JCISndDirectE2EEInfo e2eeInfo + CIRcvDirectE2EEInfo e2eeInfo -> JCIRcvDirectE2EEInfo e2eeInfo + CISndGroupE2EEInfo e2eeInfo -> JCISndGroupE2EEInfo e2eeInfo + CIRcvGroupE2EEInfo e2eeInfo -> JCIRcvGroupE2EEInfo e2eeInfo CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json aciContentJSON :: JSONCIContent -> ACIContent @@ -442,6 +488,10 @@ aciContentJSON = \case JCISndModerated -> ACIContent SMDSnd CISndModerated JCIRcvModerated -> ACIContent SMDRcv CIRcvModerated JCIRcvBlocked -> ACIContent SMDRcv CIRcvBlocked + JCISndDirectE2EEInfo {e2eeInfo} -> ACIContent SMDSnd $ CISndDirectE2EEInfo e2eeInfo + JCIRcvDirectE2EEInfo {e2eeInfo} -> ACIContent SMDRcv $ CIRcvDirectE2EEInfo e2eeInfo + JCISndGroupE2EEInfo {e2eeInfo} -> ACIContent SMDSnd $ CISndGroupE2EEInfo e2eeInfo + JCIRcvGroupE2EEInfo {e2eeInfo} -> ACIContent SMDRcv $ CIRcvGroupE2EEInfo e2eeInfo JCIInvalidJSON dir json -> case fromMsgDirection dir of AMsgDirection d -> ACIContent d $ CIInvalidJSON json @@ -473,6 +523,10 @@ data DBJSONCIContent | DBJCISndModerated | DBJCIRcvModerated | DBJCIRcvBlocked + | DBJCISndDirectE2EEInfo {e2eeInfo :: E2EInfo} + | DBJCIRcvDirectE2EEInfo {e2eeInfo :: E2EInfo} + | DBJCISndGroupE2EEInfo {e2eeInfo :: E2EInfo} + | DBJCIRcvGroupE2EEInfo {e2eeInfo :: E2EInfo} | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text} dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent @@ -503,6 +557,10 @@ dbJsonCIContent = \case CISndModerated -> DBJCISndModerated CIRcvModerated -> DBJCIRcvModerated CIRcvBlocked -> DBJCIRcvBlocked + CISndDirectE2EEInfo e2eeInfo -> DBJCISndDirectE2EEInfo e2eeInfo + CIRcvDirectE2EEInfo e2eeInfo -> DBJCIRcvDirectE2EEInfo e2eeInfo + CISndGroupE2EEInfo e2eeInfo -> DBJCISndGroupE2EEInfo e2eeInfo + CIRcvGroupE2EEInfo e2eeInfo -> DBJCIRcvGroupE2EEInfo e2eeInfo CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json aciContentDBJSON :: DBJSONCIContent -> ACIContent @@ -533,6 +591,10 @@ aciContentDBJSON = \case DBJCISndModerated -> ACIContent SMDSnd CISndModerated DBJCIRcvModerated -> ACIContent SMDRcv CIRcvModerated DBJCIRcvBlocked -> ACIContent SMDRcv CIRcvBlocked + DBJCISndDirectE2EEInfo e2eeInfo -> ACIContent SMDSnd $ CISndDirectE2EEInfo e2eeInfo + DBJCIRcvDirectE2EEInfo e2eeInfo -> ACIContent SMDRcv $ CIRcvDirectE2EEInfo e2eeInfo + DBJCISndGroupE2EEInfo e2eeInfo -> ACIContent SMDSnd $ CISndGroupE2EEInfo e2eeInfo + DBJCIRcvGroupE2EEInfo e2eeInfo -> ACIContent SMDRcv $ CIRcvGroupE2EEInfo e2eeInfo DBJCIInvalidJSON dir json -> case fromMsgDirection dir of AMsgDirection d -> ACIContent d $ CIInvalidJSON json @@ -558,6 +620,8 @@ ciCallInfoText status duration = case status of CISCallEnded -> "ended " <> durationText duration CISCallError -> "error" +$(JQ.deriveJSON defaultJSON ''E2EInfo) + $(JQ.deriveJSON (enumJSON $ dropPrefix "MDE") ''MsgDecryptError) $(JQ.deriveJSON (enumJSON $ dropPrefix "CIGIS") ''CIGroupInvitationStatus) @@ -626,4 +690,8 @@ toCIContentTag ciContent = case ciContent of CISndModerated -> "sndModerated" CIRcvModerated -> "rcvModerated" CIRcvBlocked -> "rcvBlocked" + CISndDirectE2EEInfo _ -> "sndDirectE2EEInfo" + CIRcvDirectE2EEInfo _ -> "rcvDirectE2EEInfo" + CISndGroupE2EEInfo _ -> "sndGroupE2EEInfo" + CIRcvGroupE2EEInfo _ -> "rcvGroupE2EEInfo" CIInvalidJSON _ -> "invalidJSON" diff --git a/src/Simplex/Chat/Messages/CIContent/Events.hs b/src/Simplex/Chat/Messages/CIContent/Events.hs index 05417a2e14..7ce5f73cde 100644 --- a/src/Simplex/Chat/Messages/CIContent/Events.hs +++ b/src/Simplex/Chat/Messages/CIContent/Events.hs @@ -9,6 +9,7 @@ import qualified Data.Aeson.TH as J import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (RatchetSyncState (..), SwitchPhase (..)) import Simplex.Messaging.Parsers (dropPrefix, singleFieldJSON, sumTypeJSON) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption) data RcvGroupEvent = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting @@ -42,11 +43,13 @@ data RcvConnEvent = RCESwitchQueue {phase :: SwitchPhase} | RCERatchetSync {syncStatus :: RatchetSyncState} | RCEVerificationCodeReset + | RCEPqEnabled {enabled :: PQEncryption} deriving (Show) data SndConnEvent = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef} | SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef} + | SCEPqEnabled {enabled :: PQEncryption} deriving (Show) data RcvDirectEvent diff --git a/src/Simplex/Chat/Migrations/M20240228_pq.hs b/src/Simplex/Chat/Migrations/M20240228_pq.hs new file mode 100644 index 0000000000..c496d33b4b --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20240228_pq.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20240228_pq where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20240228_pq :: Query +m20240228_pq = + [sql| +ALTER TABLE connections ADD COLUMN conn_chat_version INTEGER; +ALTER TABLE connections ADD COLUMN pq_support INTEGER NOT NULL DEFAULT 0; +ALTER TABLE connections ADD COLUMN pq_encryption INTEGER NOT NULL DEFAULT 0; +ALTER TABLE connections ADD COLUMN pq_snd_enabled INTEGER; +ALTER TABLE connections ADD COLUMN pq_rcv_enabled INTEGER; + +ALTER TABLE contact_requests ADD COLUMN pq_support INTEGER NOT NULL DEFAULT 0; +|] + +down_m20240228_pq :: Query +down_m20240228_pq = + [sql| +ALTER TABLE contact_requests DROP COLUMN pq_support; + +ALTER TABLE connections DROP COLUMN conn_chat_version; +ALTER TABLE connections DROP COLUMN pq_support; +ALTER TABLE connections DROP COLUMN pq_encryption; +ALTER TABLE connections DROP COLUMN pq_snd_enabled; +ALTER TABLE connections DROP COLUMN pq_rcv_enabled; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 98b9cfcc12..19c6ba24d0 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -277,6 +277,11 @@ CREATE TABLE connections( peer_chat_max_version INTEGER NOT NULL DEFAULT 1, to_subscribe INTEGER DEFAULT 0 NOT NULL, contact_conn_initiated INTEGER NOT NULL DEFAULT 0, + conn_chat_version INTEGER, + pq_support INTEGER NOT NULL DEFAULT 0, + pq_encryption INTEGER NOT NULL DEFAULT 0, + pq_snd_enabled INTEGER, + pq_rcv_enabled INTEGER, FOREIGN KEY(snd_file_id, connection_id) REFERENCES snd_files(file_id, connection_id) ON DELETE CASCADE @@ -312,6 +317,7 @@ CREATE TABLE contact_requests( xcontact_id BLOB, peer_chat_min_version INTEGER NOT NULL DEFAULT 1, peer_chat_max_version INTEGER NOT NULL DEFAULT 1, + pq_support INTEGER NOT NULL DEFAULT 0, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON UPDATE CASCADE diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index c4423bfe6a..85ef027335 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -7,6 +7,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -30,6 +31,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.ByteString.Internal (c2w, w2c) import qualified Data.ByteString.Lazy.Char8 as LB +import qualified Data.List.NonEmpty as L import Data.Maybe (fromMaybe) import Data.String import Data.Text (Text) @@ -44,49 +46,71 @@ import Database.SQLite.Simple.ToField (ToField (..)) import Simplex.Chat.Call import Simplex.Chat.Types import Simplex.Chat.Types.Util +import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion) +import Simplex.Messaging.Compression (CompressCtx, compress, decompressBatch) +import Simplex.Messaging.Crypto.Ratchet (PQSupport (..), pattern PQSupportOn, pattern PQSupportOff) import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON) +import Simplex.Messaging.Protocol (MsgBody) import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) import Simplex.Messaging.Version hiding (version) +-- Chat version history: +-- 1 - support chat versions in connections (9/1/2023) +-- 2 - create contacts for group members only via x.grp.direct.inv (9/16/2023) +-- 3 - faster joining via group links without creating contact (10/30/2023) +-- 4 - group message forwarding (11/18/2023) +-- 5 - batch sending messages (12/23/2023) +-- 6 - send group welcome message after history (12/29/2023) +-- 7 - update member profiles (1/15/2024) + -- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig. -- This indirection is needed for backward/forward compatibility testing. -- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code. -currentChatVersion :: Version -currentChatVersion = 7 +currentChatVersion :: VersionChat +currentChatVersion = VersionChat 7 -- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above) -supportedChatVRange :: VersionRange -supportedChatVRange = mkVersionRange 1 currentChatVersion +-- TODO remove parameterization in 5.7 +supportedChatVRange :: PQSupport -> VersionRangeChat +supportedChatVRange pq = mkVersionRange initialChatVersion $ case pq of + PQSupportOn -> pqEncryptionCompressionVersion + PQSupportOff -> currentChatVersion +{-# INLINE supportedChatVRange #-} --- version range that supports skipping establishing direct connections in a group -groupNoDirectVRange :: VersionRange -groupNoDirectVRange = mkVersionRange 2 currentChatVersion - --- version range that supports establishing direct connection via x.grp.direct.inv with a group member -xGrpDirectInvVRange :: VersionRange -xGrpDirectInvVRange = mkVersionRange 2 currentChatVersion +-- version range that supports skipping establishing direct connections in a group and establishing direct connection via x.grp.direct.inv +groupDirectInvVersion :: VersionChat +groupDirectInvVersion = VersionChat 2 -- version range that supports joining group via group link without creating direct contact -groupLinkNoContactVRange :: VersionRange -groupLinkNoContactVRange = mkVersionRange 3 currentChatVersion +groupFastLinkJoinVersion :: VersionChat +groupFastLinkJoinVersion = VersionChat 3 -- version range that supports group forwarding -groupForwardVRange :: VersionRange -groupForwardVRange = mkVersionRange 4 currentChatVersion +groupForwardVersion :: VersionChat +groupForwardVersion = VersionChat 4 -- version range that supports batch sending in groups -batchSendVRange :: VersionRange -batchSendVRange = mkVersionRange 5 currentChatVersion +batchSendVersion :: VersionChat +batchSendVersion = VersionChat 5 -- version range that supports sending group welcome message in group history -groupHistoryIncludeWelcomeVRange :: VersionRange -groupHistoryIncludeWelcomeVRange = mkVersionRange 6 currentChatVersion +groupHistoryIncludeWelcomeVersion :: VersionChat +groupHistoryIncludeWelcomeVersion = VersionChat 6 -- version range that supports sending member profile updates to groups -memberProfileUpdateVRange :: VersionRange -memberProfileUpdateVRange = mkVersionRange 7 currentChatVersion +memberProfileUpdateVersion :: VersionChat +memberProfileUpdateVersion = VersionChat 7 + +-- version range that supports compressing messages and PQ e2e encryption +pqEncryptionCompressionVersion :: VersionChat +pqEncryptionCompressionVersion = VersionChat 8 + +agentToChatVersion :: VersionSMPA -> VersionChat +agentToChatVersion v + | v < pqdrSMPAgentVersion = initialChatVersion + | otherwise = pqEncryptionCompressionVersion data ConnectionEntity = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} @@ -217,7 +241,7 @@ instance ToJSON LinkContent where $(JQ.deriveJSON defaultJSON ''LinkPreview) data ChatMessage e = ChatMessage - { chatVRange :: VersionRange, + { chatVRange :: VersionRangeChat, msgId :: Maybe SharedMsgId, chatMsgEvent :: ChatMsgEvent e } @@ -507,17 +531,29 @@ $(JQ.deriveJSON defaultJSON ''QuotedMsg) -- this limit reserves space for metadata in forwarded messages -- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610 -maxChatMsgSize :: Int -maxChatMsgSize = 15610 +maxEncodedMsgLength :: Int +maxEncodedMsgLength = 15610 + +-- maxEncodedMsgLength - 2222, see e2eEncUserMsgLength in agent +maxCompressedMsgLength :: Int +maxCompressedMsgLength = 13388 + +-- maxEncodedMsgLength - delta between MSG and INFO + 100 (returned for forward overhead) +-- delta between MSG and INFO = e2eEncUserMsgLength (no PQ) - e2eEncConnInfoLength (no PQ) = 1008 +maxEncodedInfoLength :: Int +maxEncodedInfoLength = 14702 + +maxCompressedInfoLength :: Int +maxCompressedInfoLength = 10976 -- maxEncodedInfoLength - 3726, see e2eEncConnInfoLength in agent data EncodedChatMessage = ECMEncoded ByteString | ECMLarge -encodeChatMessage :: MsgEncodingI e => ChatMessage e -> EncodedChatMessage -encodeChatMessage msg = do +encodeChatMessage :: MsgEncodingI e => Int -> ChatMessage e -> EncodedChatMessage +encodeChatMessage maxSize msg = do case chatToAppMessage msg of AMJson m -> do let body = LB.toStrict $ J.encode m - if B.length body > maxChatMsgSize + if B.length body > maxSize then ECMLarge else ECMEncoded body AMBinary m -> ECMEncoded $ strEncode m @@ -529,10 +565,23 @@ parseChatMessages s = case B.head s of '[' -> case J.eitherDecodeStrict' s of Right v -> map parseItem v Left e -> [Left e] + 'X' -> decodeCompressed (B.drop 1 s) _ -> [ACMsg SBinary <$> (appBinaryToCM =<< strDecode s)] where parseItem :: J.Value -> Either String AChatMessage parseItem v = ACMsg SJson <$> JT.parseEither parseJSON v + decodeCompressed :: ByteString -> [Either String AChatMessage] + decodeCompressed s' = case smpDecode s' of + Left e -> [Left e] + -- TODO v5.7 don't reserve multiple large buffers when decoding batches + Right compressed -> concatMap (either (pure . Left) parseChatMessages) . L.toList $ decompressBatch maxEncodedMsgLength compressed + +compressedBatchMsgBody_ :: CompressCtx -> MsgBody -> IO ByteString +compressedBatchMsgBody_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$> compress ctx msgBody + +markCompressedBatch :: ByteString -> ByteString +markCompressedBatch = B.cons 'X' +{-# INLINE markCompressedBatch #-} parseMsgContainer :: J.Object -> JT.Parser MsgContainer parseMsgContainer v = diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index fdc3703219..f8e9fa3401 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -34,10 +34,10 @@ import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol (ConnId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import Simplex.Messaging.Crypto.Ratchet (PQSupport) import Simplex.Messaging.Util (eitherToMaybe) -import Simplex.Messaging.Version (VersionRange) -getConnectionEntity :: DB.Connection -> VersionRange -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity +getConnectionEntity :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do c@Connection {connType, entityId} <- getConnection_ case entityId of @@ -55,13 +55,14 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do where getConnection_ :: ExceptT StoreError IO Connection getConnection_ = ExceptT $ do - firstRow toConnection (SEConnectionNotFound agentConnId) $ + firstRow (toConnection vr) (SEConnectionNotFound agentConnId) $ DB.query db [sql| SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id, - conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter, - peer_chat_min_version, peer_chat_max_version + conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, + created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, + conn_chat_version, peer_chat_min_version, peer_chat_max_version FROM connections WHERE user_id = ? AND agent_conn_id = ? |] @@ -157,7 +158,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId} userContact_ _ = Left SEUserContactLinkNotFound -getConnectionEntityByConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity) +getConnectionEntityByConnReq :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity) getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do connId_ <- maybeFirstRow fromOnly $ @@ -168,7 +169,7 @@ getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) -- multiple connections can have same via_contact_uri_hash if request was repeated; -- this function searches for latest connection with contact so that "known contact" plan would be chosen; -- deleted connections are filtered out to allow re-connecting via same contact address -getContactConnEntityByConnReqHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity) +getContactConnEntityByConnReqHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity) getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do connId_ <- maybeFirstRow fromOnly $ @@ -188,7 +189,7 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2 (userId, cReqHash1, cReqHash2, ConnDeleted) maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_ -getConnectionsToSubscribe :: DB.Connection -> VersionRange -> IO ([ConnId], [ConnectionEntity]) +getConnectionsToSubscribe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> IO ([ConnId], [ConnectionEntity]) getConnectionsToSubscribe db vr = do aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1" entities <- forM aConnIds $ \acId -> do diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index b844317593..47174a59a6 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -89,6 +89,7 @@ import Simplex.Chat.Types.Preferences import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import Simplex.Messaging.Crypto.Ratchet (PQSupport) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Version @@ -124,14 +125,14 @@ deletePendingContactConnection db userId connId = |] (userId, connId, ConnContact) -createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> ExceptT StoreError IO Contact -createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode = do - PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode +createAddressContactConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO Contact +createAddressContactConnection db vr user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode chatV pqSup = do + PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode chatV pqSup liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId) - getContact db user contactId + getContact db vr user contactId -createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> IO PendingContactConnection -createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode = do +createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection +createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup = do createdAt <- getCurrentTime customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile let pccConnStatus = ConnJoined @@ -140,16 +141,20 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou [sql| INSERT INTO connections ( user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated, - via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at, to_subscribe - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) + via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, + created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ((userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId, createdAt, createdAt, subMode == SMOnlyCreate)) + ( (userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId) + :. (customUserProfileId, isJust groupLinkId, groupLinkId) + :. (createdAt, createdAt, subMode == SMOnlyCreate, chatV, pqSup, pqSup) + ) pccConnId <- insertedRowId db pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt} -getConnReqContactXContactId :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId) -getConnReqContactXContactId db user@User {userId} cReqHash = do - getContactByConnReqHash db user cReqHash >>= \case +getConnReqContactXContactId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId) +getConnReqContactXContactId db vr user@User {userId} cReqHash = do + getContactByConnReqHash db vr user cReqHash >>= \case c@(Just _) -> pure (c, Nothing) Nothing -> (Nothing,) <$> getXContactId where @@ -161,9 +166,9 @@ 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) $ +getContactByConnReqHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ConnReqUriHash -> IO (Maybe Contact) +getContactByConnReqHash db vr user@User {userId} cReqHash = + maybeFirstRow (toContact vr user) $ DB.query db [sql| @@ -173,8 +178,8 @@ getContactByConnReqHash db user@User {userId} cReqHash = 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 + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, 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 @@ -184,8 +189,8 @@ getContactByConnReqHash db user@User {userId} cReqHash = |] (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 +createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection +createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode chatV pqSup = do createdAt <- getCurrentTime customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile let contactConnInitiated = pccConnStatus == ConnNew @@ -193,9 +198,13 @@ createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile db [sql| INSERT INTO connections - (user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?,?,?) + (user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id, + created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) |] - (userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId, createdAt, createdAt, subMode == SMOnlyCreate) + ( (userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId) + :. (createdAt, createdAt, subMode == SMOnlyCreate, chatV, pqSup, pqSup) + ) pccConnId <- insertedRowId db pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt} @@ -269,13 +278,13 @@ setContactDeleted db user@User {userId} ct@Contact {contactId} = do currentTs <- getCurrentTime DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId) -getDeletedContacts :: DB.Connection -> User -> IO [Contact] -getDeletedContacts db user@User {userId} = do +getDeletedContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [Contact] +getDeletedContacts db vr user@User {userId} = do contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 1" (Only userId) - rights <$> mapM (runExceptT . getDeletedContact db user) contactIds + rights <$> mapM (runExceptT . getDeletedContact db vr user) contactIds -getDeletedContact :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Contact -getDeletedContact db user contactId = getContact_ db user contactId True +getDeletedContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO Contact +getDeletedContact db vr user contactId = getContact_ db vr user contactId True deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO () deleteContactProfile_ db userId contactId = @@ -511,19 +520,19 @@ updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt (newName, updatedAt, userId, contactId) safeDeleteLDN db user displayName -getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact -getContactByName db user localDisplayName = do +getContactByName :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactName -> ExceptT StoreError IO Contact +getContactByName db vr user localDisplayName = do cId <- getContactIdByName db user localDisplayName - getContact db user cId + getContact db vr user cId -getUserContacts :: DB.Connection -> User -> IO [Contact] -getUserContacts db user@User {userId} = do +getUserContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [Contact] +getUserContacts db vr user@User {userId} = do contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId) - contacts <- rights <$> mapM (runExceptT . getContact db user) contactIds + contacts <- rights <$> mapM (runExceptT . getContact db vr user) contactIds pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts -createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> VersionRange -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest -createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ = +createOrUpdateContactRequest :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ContactOrRequest +createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ pqSup = liftIO (maybeM getContact' xContactId_) >>= \case Just contact -> pure $ CORContact contact Nothing -> CORRequest <$> createOrUpdate_ @@ -552,14 +561,17 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers db [sql| INSERT INTO contact_requests - (user_contact_link_id, agent_invitation_id, peer_chat_min_version, peer_chat_max_version, contact_profile_id, local_display_name, user_id, created_at, updated_at, xcontact_id) - VALUES (?,?,?,?,?,?,?,?,?,?) + (user_contact_link_id, agent_invitation_id, peer_chat_min_version, peer_chat_max_version, contact_profile_id, local_display_name, user_id, + created_at, updated_at, xcontact_id, pq_support) + VALUES (?,?,?,?,?,?,?,?,?,?,?) |] - (userContactLinkId, invId, minV, maxV, profileId, ldn, userId, currentTs, currentTs, xContactId_) + ( (userContactLinkId, invId, minV, maxV, profileId, ldn, userId) + :. (currentTs, currentTs, xContactId_, pqSup) + ) insertedRowId db getContact' :: XContactId -> IO (Maybe Contact) getContact' xContactId = - maybeFirstRow (toContact user) $ + maybeFirstRow (toContact vr user) $ DB.query db [sql| @@ -569,8 +581,8 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers 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 + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, 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 LEFT JOIN connections c ON c.contact_id = ct.contact_id @@ -587,7 +599,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers [sql| SELECT cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, - c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at, + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences, cr.created_at, cr.updated_at, cr.peer_chat_min_version, cr.peer_chat_max_version FROM contact_requests cr JOIN connections c USING (user_contact_link_id) @@ -608,20 +620,20 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers db [sql| UPDATE contact_requests - SET agent_invitation_id = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ? + SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ? WHERE user_id = ? AND contact_request_id = ? |] - (invId, minV, maxV, currentTs, userId, cReqId) + (invId, pqSup, minV, maxV, currentTs, userId, cReqId) else withLocalDisplayName db userId displayName $ \ldn -> Right <$> do DB.execute db [sql| UPDATE contact_requests - SET agent_invitation_id = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ? + SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_request_id = ? |] - (invId, minV, maxV, ldn, currentTs, userId, cReqId) + (invId, pqSup, minV, maxV, ldn, currentTs, userId, cReqId) safeDeleteLDN db user oldLdn where updateProfile currentTs = @@ -656,7 +668,7 @@ getContactRequest db User {userId} contactRequestId = [sql| SELECT cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, - c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at, + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences, cr.created_at, cr.updated_at, cr.peer_chat_min_version, cr.peer_chat_max_version FROM contact_requests cr JOIN connections c USING (user_contact_link_id) @@ -697,8 +709,8 @@ deleteContactRequest db User {userId} contactRequestId = do (userId, userId, contactRequestId, userId) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId) -createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> Bool -> IO Contact -createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode contactUsed = do +createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO Contact +createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId connChatVersion cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed = do DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) createdAt <- getCurrentTime customUserProfileId <- forM incognitoProfile $ \case @@ -710,7 +722,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} "INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)" (userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId, contactUsed) contactId <- insertedRowId db - conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode + conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId connChatVersion cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} @@ -719,12 +731,12 @@ getContactIdByName db User {userId} cName = ExceptT . firstRow fromOnly (SEContactNotFoundByName cName) $ DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ? AND deleted = 0" (userId, cName) -getContact :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Contact -getContact db user contactId = getContact_ db user contactId False +getContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO Contact +getContact db vr user contactId = getContact_ db vr user contactId False -getContact_ :: DB.Connection -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact -getContact_ db user@User {userId} contactId deleted = - ExceptT . firstRow (toContact user) (SEContactNotFound contactId) $ +getContact_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact +getContact_ db vr user@User {userId} contactId deleted = + ExceptT . firstRow (toContact vr user) (SEContactNotFound contactId) $ DB.query db [sql| @@ -734,8 +746,8 @@ getContact_ db user@User {userId} contactId deleted = 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 + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, 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 LEFT JOIN connections c ON c.contact_id = ct.contact_id @@ -778,8 +790,8 @@ getPendingContactConnections db User {userId} = do |] [":user_id" := userId, ":conn_type" := ConnContact] -getContactConnections :: DB.Connection -> UserId -> Contact -> IO [Connection] -getContactConnections db userId Contact {contactId} = +getContactConnections :: DB.Connection -> (PQSupport -> VersionRangeChat) -> UserId -> Contact -> IO [Connection] +getContactConnections db vr userId Contact {contactId} = connections =<< liftIO getConnections_ where getConnections_ = @@ -787,25 +799,27 @@ getContactConnections db userId Contact {contactId} = db [sql| SELECT 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 + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version FROM connections c JOIN contacts ct ON ct.contact_id = c.contact_id WHERE c.user_id = ? AND ct.user_id = ? AND ct.contact_id = ? |] (userId, userId, contactId) connections [] = pure [] - connections rows = pure $ map toConnection rows + connections rows = pure $ map (toConnection vr) rows -getConnectionById :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Connection -getConnectionById db User {userId} connId = ExceptT $ do - firstRow toConnection (SEConnectionNotFoundById connId) $ +getConnectionById :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO Connection +getConnectionById db vr User {userId} connId = ExceptT $ do + firstRow (toConnection vr) (SEConnectionNotFoundById connId) $ DB.query db [sql| SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id, - conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter, - peer_chat_min_version, peer_chat_max_version + conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, + created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, + conn_chat_version, peer_chat_min_version, peer_chat_max_version FROM connections WHERE user_id = ? AND connection_id = ? |] diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 8d54c6860d..e77681bb9b 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -114,8 +114,9 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF +import Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Protocol (SubscriptionMode (..)) -import Simplex.Messaging.Version (VersionRange) +import Simplex.Messaging.Version import System.FilePath (takeFileName) getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer] @@ -173,10 +174,10 @@ getPendingSndChunks db fileId connId = |] (fileId, connId) -createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO () -createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) subMode = do +createSndDirectFTConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO () +createSndDirectFTConnection db vr user@User {userId} fileId (cmdId, acId) subMode = do currentTs <- getCurrentTime - Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode + Connection {connId} <- createSndFileConnection_ db vr userId fileId acId subMode setCommandConnId db user cmdId connId DB.execute db @@ -193,10 +194,10 @@ createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation fileId <- insertedRowId db pure FileTransferMeta {fileId, xftpSndFile = Nothing, xftpRedirectFor = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False} -createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> SubscriptionMode -> IO () -createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} subMode = do +createSndGroupFileTransferConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> SubscriptionMode -> IO () +createSndGroupFileTransferConnection db vr user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} subMode = do currentTs <- getCurrentTime - Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode + Connection {connId} <- createSndFileConnection_ db vr userId fileId acId subMode setCommandConnId db user cmdId connId DB.execute db @@ -428,10 +429,11 @@ lookupChatRefByFileId db User {userId} fileId = |] (userId, fileId) -createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection -createSndFileConnection_ db userId fileId agentConnId subMode = do +-- TODO v6.0 remove +createSndFileConnection_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection +createSndFileConnection_ db vr userId fileId agentConnId subMode = do currentTs <- getCurrentTime - createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode + createConnection_ db userId ConnSndFile (Just fileId) agentConnId (minVersion $ vr PQSupportOff) chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO () updateSndFileStatus db SndFileTransfer {fileId, connId} status = do @@ -693,7 +695,7 @@ getRcvFileTransfer_ db userId fileId = do _ -> pure Nothing cancelled = fromMaybe False cancelled_ -acceptRcvFileTransfer :: DB.Connection -> VersionRange -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem +acceptRcvFileTransfer :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do currentTs <- getCurrentTime acceptRcvFT_ db user fileId filePath Nothing currentTs @@ -705,16 +707,16 @@ acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus f setCommandConnId db user cmdId connId runExceptT $ getChatItemByFileId db vr user fileId -getContactByFileId :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO Contact -getContactByFileId db user@User {userId} fileId = do +getContactByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> ExceptT StoreError IO Contact +getContactByFileId db vr user@User {userId} fileId = do cId <- getContactIdByFileId - getContact db user cId + getContact db vr user cId where getContactIdByFileId = ExceptT . firstRow fromOnly (SEContactNotFoundByFileId fileId) $ DB.query db "SELECT contact_id FROM files WHERE user_id = ? AND file_id = ?" (userId, fileId) -acceptRcvInlineFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem +acceptRcvInlineFT :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem acceptRcvInlineFT db vr user fileId filePath = do liftIO $ acceptRcvFT_ db user fileId filePath (Just IFMOffer) =<< getCurrentTime getChatItemByFileId db vr user fileId @@ -723,7 +725,7 @@ startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Mayb startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline = acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime -xftpAcceptRcvFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem +xftpAcceptRcvFT :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem xftpAcceptRcvFT db vr user fileId filePath = do liftIO $ acceptRcvFT_ db user fileId filePath Nothing =<< getCurrentTime getChatItemByFileId db vr user fileId @@ -998,7 +1000,7 @@ getLocalCryptoFile db userId fileId sent = pure $ CryptoFile filePath fileCryptoArgs _ -> throwError $ SEFileNotFound fileId -updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem +updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem updateDirectCIFileStatus db vr user fileId fileStatus = do aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db vr user fileId case (cType, testEquality d $ msgDirection @d) of diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index d82cc7570f..254b8dab59 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -132,7 +133,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime) import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) import Simplex.Chat.Messages -import Simplex.Chat.Protocol (groupForwardVRange) +import Simplex.Chat.Protocol (groupForwardVersion) import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Shared import Simplex.Chat.Types @@ -141,6 +142,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Ratchet (PQSupport, pattern PQEncOff, pattern PQSupportOff) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>)) import Simplex.Messaging.Version @@ -148,13 +150,13 @@ import UnliftIO.STM type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. GroupMemberRow -type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) +type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences)) -type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, 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 VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences)) -toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo +toGroupInfo :: (PQSupport -> VersionRangeChat) -> Int64 -> GroupInfoRow -> GroupInfo toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) = - let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange vr} + let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr PQSupportOff} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} @@ -167,7 +169,7 @@ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, blockedByAdmin = maybe False mrsBlocked memberRestriction_ invitedBy = toInvitedBy userContactId invitedById activeConn = Nothing - memberChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer + memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer in GroupMember {..} toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember @@ -184,17 +186,18 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} "INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" (userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs) userContactLinkId <- insertedRowId db - void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode + void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff -getGroupLinkConnection :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO Connection -getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} = - ExceptT . firstRow toConnection (SEGroupLinkNotFound groupInfo) $ +getGroupLinkConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> ExceptT StoreError IO Connection +getGroupLinkConnection db vr User {userId} groupInfo@GroupInfo {groupId} = + ExceptT . firstRow (toConnection vr) (SEGroupLinkNotFound groupInfo) $ DB.query db [sql| SELECT 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 + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version FROM connections c JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id WHERE c.user_id = ? AND uc.user_id = ? AND uc.group_id = ? @@ -258,7 +261,7 @@ setGroupLinkMemberRole :: DB.Connection -> User -> Int64 -> GroupMemberRole -> I setGroupLinkMemberRole db User {userId} userContactLinkId memberRole = DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId) -getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRange -> ExceptT StoreError IO (GroupInfo, GroupMember) +getGroupAndMember :: DB.Connection -> User -> Int64 -> (PQSupport -> VersionRangeChat) -> ExceptT StoreError IO (GroupInfo, GroupMember) getGroupAndMember db User {userId, userContactId} groupMemberId vr = ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $ DB.query @@ -278,8 +281,9 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, 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, - c.peer_chat_min_version, c.peer_chat_max_version + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) JOIN groups g ON g.group_id = m.group_id @@ -299,10 +303,10 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr = toGroupAndMember (groupInfoRow :. memberRow :. connRow) = let groupInfo = toGroupInfo vr userContactId groupInfoRow member = toGroupMember userContactId memberRow - in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow}) + in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow}) -- | creates completely new group with a single member - the current user -createNewGroup :: DB.Connection -> VersionRange -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo +createNewGroup :: DB.Connection -> (PQSupport -> VersionRangeChat) -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile fullGroupPreferences = mergeGroupPreferences groupPreferences @@ -344,7 +348,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc } -- | creates a new group record for the group the current user was invited to, or returns an existing one -createGroupInvitation :: DB.Connection -> VersionRange -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) +createGroupInvitation :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId, peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do liftIO getInvitationGroupId_ >>= \case @@ -389,7 +393,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ |] (profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) insertedRowId db - let JVersionRange hostVRange = peerChatVRange + let hostVRange = const $ adjustedMemberVRange vr peerChatVRange GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} @@ -410,13 +414,18 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ groupMemberId ) +adjustedMemberVRange :: (PQSupport -> VersionRangeChat) -> VersionRangeChat -> VersionRangeChat +adjustedMemberVRange getVR vr@(VersionRange minV maxV) = + let maxV' = min maxV (maxVersion $ getVR PQSupportOff) + in fromMaybe vr $ safeVersionRange minV (max minV maxV') + getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId getHostMemberId_ db User {userId} groupId = ExceptT . firstRow fromOnly (SEHostMemberIdNotFound groupId) $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_category = ?" (userId, groupId, GCHostMember) -createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> VersionRange -> ExceptT StoreError IO GroupMember -createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMemberId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt memberChatVRange@(VersionRange minV maxV) = do +createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> (PQSupport -> VersionRangeChat) -> ExceptT StoreError IO GroupMember +createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMemberId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt vr = do incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId (localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of (Just profile@LocalProfile {displayName}, Just profileId) -> @@ -440,9 +449,10 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe memberContactId = Just $ contactId' userOrContact, memberContactProfileId = localProfileId (profile' userOrContact), activeConn = Nothing, - memberChatVRange = JVersionRange memberChatVRange + memberChatVRange } where + memberChatVRange@(VersionRange minV maxV) = vr PQSupportOff insertMember_ :: IO ContactName insertMember_ = do let localDisplayName = localDisplayName' userOrContact @@ -478,7 +488,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe ) pure $ Right incognitoLdn -createGroupInvitedViaLink :: DB.Connection -> VersionRange -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) +createGroupInvitedViaLink :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) createGroupInvitedViaLink db vr @@ -492,7 +502,7 @@ createGroupInvitedViaLink -- using IBUnknown since host is created without contact void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs vr liftIO $ setViaGroupLinkHash db groupId connId - (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db user hostMemberId + (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user hostMemberId where insertGroup_ currentTs = ExceptT $ do let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile @@ -549,10 +559,10 @@ setGroupInvitationChatItemId db User {userId} groupId chatItemId = do -- TODO return the last connection that is ready, not any last connection -- requires updating connection status -getGroup :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO Group +getGroup :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO Group getGroup db vr user groupId = do gInfo <- getGroupInfo db vr user groupId - members <- liftIO $ getGroupMembers db user gInfo + members <- liftIO $ getGroupMembers db vr user gInfo pure $ Group gInfo members deleteGroupConnectionsAndFiles :: DB.Connection -> User -> GroupInfo -> [GroupMember] -> IO () @@ -604,12 +614,12 @@ deleteGroupProfile_ db userId groupId = |] (userId, groupId) -getUserGroups :: DB.Connection -> VersionRange -> User -> IO [Group] +getUserGroups :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [Group] getUserGroups db vr user@User {userId} = do groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId) rights <$> mapM (runExceptT . getGroup db vr user) groupIds -getUserGroupDetails :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo] +getUserGroupDetails :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo] getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = map (toGroupInfo vr userContactId) <$> DB.query @@ -632,7 +642,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = where search = fromMaybe "" search_ -getUserGroupsWithSummary :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)] +getUserGroupsWithSummary :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)] getUserGroupsWithSummary db vr user _contactId_ search_ = getUserGroupDetails db vr user _contactId_ search_ >>= mapM (\g@GroupInfo {groupId} -> (g,) <$> getGroupSummary db user groupId) @@ -673,7 +683,7 @@ checkContactHasGroups :: DB.Connection -> User -> Contact -> IO (Maybe GroupId) checkContactHasGroups db User {userId} Contact {contactId} = maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId) -getGroupInfoByName :: DB.Connection -> VersionRange -> User -> GroupName -> ExceptT StoreError IO GroupInfo +getGroupInfoByName :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupName -> ExceptT StoreError IO GroupInfo getGroupInfoByName db vr user gName = do gId <- getGroupIdByName db user gName getGroupInfo db vr user gId @@ -685,8 +695,9 @@ groupMemberQuery = m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, 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, - c.peer_chat_min_version, c.peer_chat_max_version + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN connections c ON c.connection_id = ( @@ -696,41 +707,41 @@ groupMemberQuery = ) |] -getGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember -getGroupMember db user@User {userId} groupId groupMemberId = - ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFound groupMemberId) $ +getGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember +getGroupMember db vr user@User {userId} groupId groupMemberId = + ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $ DB.query db (groupMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?") (userId, groupId, groupMemberId, userId) -getGroupMemberById :: DB.Connection -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember -getGroupMemberById db user@User {userId} groupMemberId = - ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFound groupMemberId) $ +getGroupMemberById :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember +getGroupMemberById db vr user@User {userId} groupMemberId = + ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $ DB.query db (groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?") (userId, groupMemberId, userId) -getGroupMemberByMemberId :: DB.Connection -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember -getGroupMemberByMemberId db user@User {userId} GroupInfo {groupId} memberId = - ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFoundByMemberId memberId) $ +getGroupMemberByMemberId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember +getGroupMemberByMemberId db vr user@User {userId} GroupInfo {groupId} memberId = + ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFoundByMemberId memberId) $ DB.query db (groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?") (userId, groupId, memberId) -getGroupMembers :: DB.Connection -> User -> GroupInfo -> IO [GroupMember] -getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do - map (toContactMember user) +getGroupMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> IO [GroupMember] +getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do + map (toContactMember vr user) <$> DB.query db (groupMemberQuery <> " WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)") (userId, groupId, userId, userContactId) -getGroupMembersForExpiration :: DB.Connection -> User -> GroupInfo -> IO [GroupMember] -getGroupMembersForExpiration db user@User {userId, userContactId} GroupInfo {groupId} = do - map (toContactMember user) +getGroupMembersForExpiration :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> IO [GroupMember] +getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {groupId} = do + map (toContactMember vr user) <$> DB.query db ( groupMemberQuery @@ -744,9 +755,9 @@ getGroupMembersForExpiration db user@User {userId, userContactId} GroupInfo {gro ) (userId, groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown) -toContactMember :: User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember -toContactMember User {userContactId} (memberRow :. connRow) = - (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow} +toContactMember :: (PQSupport -> VersionRangeChat) -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember +toContactMember vr User {userContactId} (memberRow :. connRow) = + (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection vr connRow} getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do @@ -762,14 +773,14 @@ getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do (groupId, userId) pure $ length $ filter memberCurrent' statuses -getGroupInvitation :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation +getGroupInvitation :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation getGroupInvitation db vr user groupId = getConnRec_ user >>= \case Just connRequest -> do groupInfo@GroupInfo {membership} <- getGroupInfo db vr user groupId when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined hostId <- getHostMemberId_ db user groupId - fromMember <- getGroupMember db user groupId hostId + fromMember <- getGroupMember db vr user groupId hostId pure ReceivedGroupInvitation {fromMember, connRequest, groupInfo} _ -> throwError SEGroupInvitationNotFound where @@ -780,14 +791,14 @@ getGroupInvitation db vr user groupId = createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName -createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile, activeConn = Just Connection {peerChatVRange}} memberRole agentConnId connRequest subMode = +createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile, activeConn = Just Connection {connChatVersion, peerChatVRange}} memberRole agentConnId connRequest subMode = createWithRandomId gVar $ \memId -> do createdAt <- liftIO getCurrentTime member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt - void $ createMemberConnection_ db userId groupMemberId agentConnId (fromJVersionRange peerChatVRange) Nothing 0 createdAt subMode + void $ createMemberConnection_ db userId groupMemberId agentConnId connChatVersion peerChatVRange Nothing 0 createdAt subMode pure member where - JVersionRange (VersionRange minV maxV) = peerChatVRange + VersionRange minV maxV = peerChatVRange invitedByGroupMemberId = groupMemberId' membership createMember_ memberId createdAt = do insertMember_ @@ -827,13 +838,13 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, :. (minV, maxV) ) -createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> ExceptT StoreError IO () -createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange subMode = +createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> ExceptT StoreError IO () +createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) chatV peerChatVRange subMode = createWithRandomId gVar $ \memId -> do createdAt <- liftIO getCurrentTime insertMember_ (MemberId memId) createdAt groupMemberId <- liftIO $ insertedRowId db - Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode + Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 createdAt subMode setCommandConnId db user cmdId connId where VersionRange minV maxV = peerChatVRange @@ -868,7 +879,7 @@ createAcceptedMember groupMemberId <- liftIO $ insertedRowId db pure (groupMemberId, MemberId memId) where - JVersionRange (VersionRange minV maxV) = cReqChatVRange + VersionRange minV maxV = cReqChatVRange insertMember_ memberId createdAt = DB.execute db @@ -884,20 +895,21 @@ createAcceptedMember :. (minV, maxV) ) -createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO () +createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> VersionChat -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO () createAcceptedMemberConnection db user@User {userId} (cmdId, agentConnId) + chatV UserContactRequest {cReqChatVRange, userContactLinkId} groupMemberId subMode = do createdAt <- liftIO getCurrentTime - Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode + Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId chatV cReqChatVRange Nothing (Just userContactLinkId) Nothing 0 createdAt subMode PQSupportOff setCommandConnId db user cmdId connId -getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact -getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do +getContactViaMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> ExceptT StoreError IO Contact +getContactViaMember db vr user@User {userId} GroupMember {groupMemberId} = do contactId <- ExceptT $ firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $ @@ -911,7 +923,7 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do LIMIT 1 |] (userId, groupMemberId) - getContact db user contactId + getContact db vr user contactId setNewContactMemberConnRequest :: DB.Connection -> User -> GroupMember -> ConnReqInvitation -> IO () setNewContactMemberConnRequest db User {userId} GroupMember {groupMemberId} connRequest = do @@ -923,15 +935,15 @@ getMemberInvitation db User {userId} groupMemberId = fmap join . maybeFirstRow fromOnly $ DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId) -createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionRange -> SubscriptionMode -> IO () -createMemberConnection db userId GroupMember {groupMemberId} agentConnId peerChatVRange subMode = do +createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO () +createMemberConnection db userId GroupMember {groupMemberId} agentConnId chatV peerChatVRange subMode = do currentTs <- getCurrentTime - void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode + void $ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode -createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> IO () -createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) peerChatVRange subMode = do +createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO () +createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) chatV peerChatVRange subMode = do currentTs <- getCurrentTime - Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode + Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode setCommandConnId db user cmdId connId updateGroupMemberStatus :: DB.Connection -> UserId -> GroupMember -> GroupMemberStatus -> IO () @@ -997,7 +1009,7 @@ createNewMember_ createdAt = do let invitedById = fromInvitedBy userContactId invitedBy activeConn = Nothing - mcvr@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange + memberChatVRange@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange DB.execute db [sql| @@ -1029,7 +1041,7 @@ createNewMember_ memberContactId, memberContactProfileId, activeConn, - memberChatVRange = JVersionRange mcvr + memberChatVRange } checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId) @@ -1062,7 +1074,7 @@ updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole updateGroupMemberRole db User {userId} GroupMember {groupMemberId} memRole = DB.execute db "UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (memRole, userId, groupMemberId) -createIntroductions :: DB.Connection -> Version -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro] +createIntroductions :: DB.Connection -> VersionChat -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro] createIntroductions db chatV members toMember = do let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members if null reMembers @@ -1157,10 +1169,10 @@ getIntroduction db reMember toMember = ExceptT $ do in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation} toIntro _ = Left SEIntroNotFound -getForwardIntroducedMembers :: DB.Connection -> User -> GroupMember -> Bool -> IO [GroupMember] -getForwardIntroducedMembers db user invitee highlyAvailable = do +getForwardIntroducedMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Bool -> IO [GroupMember] +getForwardIntroducedMembers db vr user invitee highlyAvailable = do memberIds <- map fromOnly <$> query - filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds + filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds where mId = groupMemberId' invitee query @@ -1169,7 +1181,7 @@ getForwardIntroducedMembers db user invitee highlyAvailable = do DB.query db (q <> " AND intro_chat_protocol_version >= ?") - (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange) + (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion) q = [sql| SELECT re_group_member_id @@ -1177,10 +1189,10 @@ getForwardIntroducedMembers db user invitee highlyAvailable = do WHERE to_group_member_id = ? AND intro_status NOT IN (?,?,?) |] -getForwardInvitedMembers :: DB.Connection -> User -> GroupMember -> Bool -> IO [GroupMember] -getForwardInvitedMembers db user forwardMember highlyAvailable = do +getForwardInvitedMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Bool -> IO [GroupMember] +getForwardInvitedMembers db vr user forwardMember highlyAvailable = do memberIds <- map fromOnly <$> query - filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds + filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds where mId = groupMemberId' forwardMember query @@ -1189,7 +1201,7 @@ getForwardInvitedMembers db user forwardMember highlyAvailable = do DB.query db (q <> " AND intro_chat_protocol_version >= ?") - (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange) + (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion) q = [sql| SELECT to_group_member_id @@ -1197,12 +1209,13 @@ getForwardInvitedMembers db user forwardMember highlyAvailable = do WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?) |] -createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember +createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> VersionChat -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} + chatV memInfo@(MemberInfo _ _ memChatVRange memberProfile) memRestrictions_ (groupCmdId, groupAgentConnId) @@ -1215,7 +1228,7 @@ createIntroReMember currentTs <- liftIO getCurrentTime newMember <- case directConnIds of Just (directCmdId, directAgentConnId) -> do - Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode + Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId chatV mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff liftIO $ setCommandConnId db user directCmdId directConnId (localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId) @@ -1225,18 +1238,18 @@ createIntroReMember pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId} liftIO $ do member <- createNewMember_ db user gInfo newMember currentTs - conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode + conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode liftIO $ setCommandConnId db user groupCmdId groupConnId pure (member :: GroupMember) {activeConn = Just conn} -createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO () -createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do +createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> VersionRangeChat -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO () +createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} chatV mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn currentTs <- getCurrentTime - Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode + Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId chatV mcvr viaContactId cLevel currentTs subMode setCommandConnId db user groupCmdId groupConnId forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do - Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode + Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId chatV mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff setCommandConnId db user directCmdId directConnId contactId <- createMemberContact_ directConnId currentTs updateMember_ contactId currentTs @@ -1266,10 +1279,11 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = |] [":contact_id" := contactId, ":updated_at" := ts, ":group_member_id" := groupMemberId] -createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRange -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection -createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing +createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection +createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange viaContact connLevel currentTs subMode = + createConnection_ db userId ConnMember (Just groupMemberId) agentConnId chatV peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode PQSupportOff -getViaGroupMember :: DB.Connection -> VersionRange -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember)) +getViaGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember)) getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = maybeFirstRow toGroupAndMember $ DB.query @@ -1289,8 +1303,9 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, 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, - c.peer_chat_min_version, c.peer_chat_max_version + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version FROM group_members m JOIN contacts ct ON ct.contact_id = m.contact_id JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) @@ -1311,10 +1326,10 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = toGroupAndMember (groupInfoRow :. memberRow :. connRow) = let groupInfo = toGroupInfo vr userContactId groupInfoRow member = toGroupMember userContactId memberRow - in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow}) + in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow}) -getViaGroupContact :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact) -getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do +getViaGroupContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> IO (Maybe Contact) +getViaGroupContact db vr user@User {userId} GroupMember {groupMemberId} = do contactId_ <- maybeFirstRow fromOnly $ DB.query @@ -1328,7 +1343,7 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do LIMIT 1 |] (userId, groupMemberId) - maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_ + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) contactId_ updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences} @@ -1364,7 +1379,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, (ldn, currentTs, userId, groupId) safeDeleteLDN db user localDisplayName -getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo +getGroupInfo :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO GroupInfo getGroupInfo db vr User {userId, userContactId} groupId = ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $ DB.query @@ -1387,7 +1402,7 @@ getGroupInfo db vr User {userId, userContactId} groupId = |] (groupId, userId, userContactId) -getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo) +getGroupInfoByUserContactLinkConnReq :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo) getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do groupId_ <- maybeFirstRow fromOnly $ @@ -1401,7 +1416,7 @@ getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReq (userId, cReqSchema1, cReqSchema2) maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_ -getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo) +getGroupInfoByGroupLinkHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo) getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do groupId_ <- maybeFirstRow fromOnly $ @@ -1428,7 +1443,7 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName = ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName) -getActiveMembersByName :: DB.Connection -> VersionRange -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)] +getActiveMembersByName :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)] getActiveMembersByName db vr user@User {userId} groupMemberName = do groupMemberIds :: [(GroupId, GroupMemberId)] <- liftIO $ @@ -1443,19 +1458,19 @@ getActiveMembersByName db vr user@User {userId} groupMemberName = do (userId, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember) possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do groupInfo <- getGroupInfo db vr user groupId - groupMember <- getGroupMember db user groupId groupMemberId + groupMember <- getGroupMember db vr user groupId groupMemberId pure (groupInfo, groupMember) pure $ sortOn (Down . ts . fst) possibleMembers where ts GroupInfo {chatTs, updatedAt} = fromMaybe updatedAt chatTs -getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact] -getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do +getMatchingContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO [Contact] +getMatchingContacts db vr user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do contactIds <- map fromOnly <$> case image of Just img -> DB.query db (q <> " AND p.image = ?") (userId, contactId, CSActive, displayName, fullName, img) Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, contactId, CSActive, displayName, fullName) - rights <$> mapM (runExceptT . getContact db user) contactIds + rights <$> mapM (runExceptT . getContact db vr user) contactIds where -- this query is different from one in getMatchingMemberContacts -- it checks that it's not the same contact @@ -1469,13 +1484,13 @@ getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalPro AND p.display_name = ? AND p.full_name = ? |] -getMatchingMembers :: DB.Connection -> User -> Contact -> IO [GroupMember] -getMatchingMembers db user@User {userId} Contact {profile = LocalProfile {displayName, fullName, image}} = do +getMatchingMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO [GroupMember] +getMatchingMembers db vr user@User {userId} Contact {profile = LocalProfile {displayName, fullName, image}} = do memberIds <- map fromOnly <$> case image of Just img -> DB.query db (q <> " AND p.image = ?") (userId, GCUserMember, displayName, fullName, img) Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, GCUserMember, displayName, fullName) - filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds + filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds where -- only match with members without associated contact q = @@ -1488,14 +1503,14 @@ getMatchingMembers db user@User {userId} Contact {profile = LocalProfile {displa AND p.display_name = ? AND p.full_name = ? |] -getMatchingMemberContacts :: DB.Connection -> User -> GroupMember -> IO [Contact] -getMatchingMemberContacts _ _ GroupMember {memberContactId = Just _} = pure [] -getMatchingMemberContacts db user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} = do +getMatchingMemberContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> IO [Contact] +getMatchingMemberContacts _ _ _ GroupMember {memberContactId = Just _} = pure [] +getMatchingMemberContacts db vr user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} = do contactIds <- map fromOnly <$> case image of Just img -> DB.query db (q <> " AND p.image = ?") (userId, CSActive, displayName, fullName, img) Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, CSActive, displayName, fullName) - rights <$> mapM (runExceptT . getContact db user) contactIds + rights <$> mapM (runExceptT . getContact db vr user) contactIds where q = [sql| @@ -1527,8 +1542,8 @@ createSentProbeHash db userId probeId to = do "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, group_member_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" (probeId, ctId, gmId, userId, currentTs, currentTs) -matchReceivedProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO [ContactOrMember] -matchReceivedProbe db user@User {userId} from (Probe probe) = do +matchReceivedProbe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> Probe -> IO [ContactOrMember] +matchReceivedProbe db vr user@User {userId} from (Probe probe) = do let probeHash = C.sha256Hash probe cgmIds <- DB.query @@ -1549,7 +1564,7 @@ matchReceivedProbe db user@User {userId} from (Probe probe) = do "INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)" (ctId, gmId, probe, probeHash, userId, currentTs, currentTs) let cgmIds' = filterFirstContactId cgmIds - catMaybes <$> mapM (getContactOrMember_ db user) cgmIds' + catMaybes <$> mapM (getContactOrMember_ db vr user) cgmIds' where filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] filterFirstContactId cgmIds = do @@ -1559,8 +1574,8 @@ matchReceivedProbe db user@User {userId} from (Probe probe) = do (x : _) -> [x] ctIds' <> memIds -matchReceivedProbeHash :: DB.Connection -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe)) -matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do +matchReceivedProbeHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe)) +matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do probeIds <- maybeFirstRow id $ DB.query @@ -1580,11 +1595,11 @@ matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do db "INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" (ctId, gmId, probeHash, userId, currentTs, currentTs) - pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db user cgmIds + pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db vr user cgmIds -matchSentProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember) -matchSentProbe db user@User {userId} _from (Probe probe) = do - cgmIds $>>= getContactOrMember_ db user +matchSentProbe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember) +matchSentProbe db vr user@User {userId} _from (Probe probe) = do + cgmIds $>>= getContactOrMember_ db vr user where (ctId, gmId) = contactOrMemberIds _from cgmIds = @@ -1603,16 +1618,16 @@ matchSentProbe db user@User {userId} _from (Probe probe) = do |] (userId, probe, ctId, gmId) -getContactOrMember_ :: DB.Connection -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember) -getContactOrMember_ db user ids = +getContactOrMember_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember) +getContactOrMember_ db vr user ids = fmap eitherToMaybe . runExceptT $ case ids of - (Just ctId, _, _) -> COMContact <$> getContact db user ctId - (_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db user gId gmId + (Just ctId, _, _) -> COMContact <$> getContact db vr user ctId + (_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db vr user gId gmId _ -> throwError $ SEInternalError "" -- if requested merge direction is overruled (toFromContacts), keepLDN is kept -mergeContactRecords :: DB.Connection -> User -> Contact -> Contact -> ExceptT StoreError IO Contact -mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN} from = do +mergeContactRecords :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> Contact -> ExceptT StoreError IO Contact +mergeContactRecords db vr user@User {userId} to@Contact {localDisplayName = keepLDN} from = do let (toCt, fromCt) = toFromContacts to from Contact {contactId = toContactId, localDisplayName = toLDN} = toCt Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt @@ -1670,7 +1685,7 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN WHERE user_id = ? AND local_display_name = ? |] (keepLDN, currentTs, userId, toLDN) - getContact db user toContactId + getContact db vr user toContactId where toFromContacts :: Contact -> Contact -> (Contact, Contact) toFromContacts c1 c2 @@ -1701,9 +1716,10 @@ associateMemberWithContactRecord when (memProfileId /= profileId) $ deleteUnusedProfile_ db userId memProfileId when (memLDN /= localDisplayName) $ deleteUnusedDisplayName_ db userId memLDN -associateContactWithMemberRecord :: DB.Connection -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact +associateContactWithMemberRecord :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact associateContactWithMemberRecord db + vr user@User {userId} GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}} Contact {contactId, localDisplayName, profile = LocalProfile {profileId}} = do @@ -1727,7 +1743,7 @@ associateContactWithMemberRecord (memLDN, memProfileId, currentTs, userId, contactId) when (profileId /= memProfileId) $ deleteUnusedProfile_ db userId profileId when (localDisplayName /= memLDN) $ deleteUnusedDisplayName_ db userId localDisplayName - getContact db user contactId + getContact db vr user contactId deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO () deleteUnusedDisplayName_ db userId localDisplayName = @@ -1875,7 +1891,7 @@ createMemberContact cReq gInfo GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId} - Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))} + Connection {connLevel, connChatVersion, peerChatVRange = peerChatVRange@(VersionRange minV maxV)} subMode = do currentTs <- getCurrentTime let incognitoProfile = incognitoMembershipProfile gInfo @@ -1902,25 +1918,49 @@ createMemberContact [sql| INSERT INTO connections ( user_id, agent_conn_id, conn_req_inv, conn_level, conn_status, conn_type, contact_conn_initiated, contact_id, custom_user_profile_id, - peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) + conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (userId, acId, cReq, connLevel, ConnNew, ConnContact, True, contactId, customUserProfileId) - :. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate) + :. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate) ) connId <- insertedRowId db - let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = True, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} + let ctConn = + Connection + { connId, + agentConnId = AgentConnId acId, + peerChatVRange, + connChatVersion, + connType = ConnContact, + contactConnInitiated = True, + entityId = Just contactId, + viaContact = Nothing, + viaUserContactLink = Nothing, + viaGroupLink = False, + groupLinkId = Nothing, + customUserProfileId, + connLevel, + connStatus = ConnNew, + localAlias = "", + createdAt = currentTs, + connectionCode = Nothing, + pqSupport = PQSupportOff, + pqEncryption = PQEncOff, + pqSndEnabled = Nothing, + pqRcvEnabled = Nothing, + authErrCounter = 0 + } mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False} -getMemberContact :: DB.Connection -> VersionRange -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) +getMemberContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) getMemberContact db vr user contactId = do - ct <- getContact db user contactId + ct <- getContact db vr user contactId let Contact {contactGroupMemberId, activeConn} = ct case (activeConn, contactGroupMemberId) of (Just Connection {connId}, Just groupMemberId) -> do cReq <- getConnReqInv db connId - m@GroupMember {groupId} <- getGroupMemberById db user groupMemberId + m@GroupMember {groupId} <- getGroupMemberById db vr user groupMemberId g <- getGroupInfo db vr user groupId pure (g, m, ct, cReq) _ -> @@ -2000,7 +2040,7 @@ createMemberContactConn_ user@User {userId} (cmdId, acId) gInfo - _memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))} + _memberConn@Connection {connLevel, connChatVersion, peerChatVRange = peerChatVRange@(VersionRange minV maxV)} contactId subMode = do currentTs <- liftIO getCurrentTime @@ -2010,15 +2050,39 @@ createMemberContactConn_ [sql| INSERT INTO connections ( user_id, agent_conn_id, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id, - peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?) + conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (userId, acId, connLevel, ConnJoined, ConnContact, contactId, customUserProfileId) - :. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate) + :. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate) ) connId <- insertedRowId db setCommandConnId db user cmdId connId - pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = False, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnJoined, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} + pure + Connection + { connId, + agentConnId = AgentConnId acId, + connChatVersion, + peerChatVRange, + connType = ConnContact, + contactConnInitiated = False, + entityId = Just contactId, + viaContact = Nothing, + viaUserContactLink = Nothing, + viaGroupLink = False, + groupLinkId = Nothing, + customUserProfileId, + connLevel, + connStatus = ConnJoined, + localAlias = "", + createdAt = currentTs, + connectionCode = Nothing, + pqSupport = PQSupportOff, + pqEncryption = PQEncOff, + pqSndEnabled = Nothing, + pqRcvEnabled = Nothing, + authErrCounter = 0 + } updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember updateMemberProfile db user@User {userId} m p' @@ -2069,7 +2133,7 @@ setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do "UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?" (xGrpLinkMemReceived, currentTs, mId) -createNewUnknownGroupMember :: DB.Connection -> VersionRange -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember +createNewUnknownGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {groupId} memberId memberName = do currentTs <- liftIO getCurrentTime let memberProfile = profileFromName memberName @@ -2089,12 +2153,12 @@ createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {g :. (minV, maxV) ) insertedRowId db - getGroupMemberById db user groupMemberId + getGroupMemberById db vr user groupMemberId where - VersionRange minV maxV = vr + VersionRange minV maxV = vr PQSupportOff -updateUnknownMemberAnnounced :: DB.Connection -> User -> GroupMember -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember -updateUnknownMemberAnnounced db user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do +updateUnknownMemberAnnounced :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember +updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do _ <- updateMemberProfile db user unknownMember profile currentTs <- liftIO getCurrentTime liftIO $ @@ -2114,9 +2178,9 @@ updateUnknownMemberAnnounced db user@User {userId} invitingMember unknownMember@ ( (memberRole, GCPostMember, GSMemAnnounced, groupMemberId' invitingMember) :. (minV, maxV, currentTs, userId, groupMemberId) ) - getGroupMemberById db user groupMemberId + getGroupMemberById db vr user groupMemberId where - VersionRange minV maxV = maybe (fromJVersionRange memberChatVRange) fromChatVRange v + VersionRange minV maxV = maybe memberChatVRange fromChatVRange v updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO () updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs = diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index a755353da7..05b1a153b2 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -145,9 +145,9 @@ import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserI import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Ratchet (PQSupport) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import Simplex.Messaging.Util (eitherToMaybe) -import Simplex.Messaging.Version (VersionRange) import UnliftIO.STM deleteContactCIs :: DB.Connection -> User -> Contact -> IO () @@ -482,7 +482,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow -getChatPreviews :: DB.Connection -> VersionRange -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat] +getChatPreviews :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat] getChatPreviews db vr user withPCC pagination query = do directChats <- findDirectChatPreviews_ db user pagination query groupChats <- findGroupChatPreviews_ db user pagination query @@ -505,7 +505,7 @@ getChatPreviews db vr user withPCC pagination query = do PTBefore _ count -> take count . sortBy (comparing $ Down . ts) getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat getChatPreview (ACPD cType cpd) = case cType of - SCTDirect -> getDirectChatPreview_ db user cpd + SCTDirect -> getDirectChatPreview_ db vr user cpd SCTGroup -> getGroupChatPreview_ db vr user cpd SCTLocal -> getLocalChatPreview_ db user cpd SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat @@ -619,9 +619,9 @@ findDirectChatPreviews_ db User {userId} pagination clq = ) ([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams) -getDirectChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat -getDirectChatPreview_ db user (DirectChatPD _ contactId lastItemId_ stats) = do - contact <- getContact db user contactId +getDirectChatPreview_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat +getDirectChatPreview_ db vr user (DirectChatPD _ contactId lastItemId_ stats) = do + contact <- getContact db vr user contactId lastItem <- case lastItemId_ of Just lastItemId -> (: []) <$> getDirectChatItem db user contactId lastItemId Nothing -> pure [] @@ -715,7 +715,7 @@ findGroupChatPreviews_ db User {userId} pagination clq = ) ([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams) -getGroupChatPreview_ :: DB.Connection -> VersionRange -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat +getGroupChatPreview_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do groupInfo <- getGroupInfo db vr user groupId lastItem <- case lastItemId_ of @@ -857,7 +857,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of ( [sql| SELECT cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, - c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, + c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences, cr.created_at, cr.updated_at as ts, cr.peer_chat_min_version, cr.peer_chat_max_version FROM contact_requests cr @@ -920,10 +920,10 @@ getContactConnectionChatPreviews_ db User {userId} pagination clq = case clq of aChat = AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats in ACPD SCTContactConnection $ ContactConnectionPD updatedAt aChat -getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect) -getDirectChat db user contactId pagination search_ = do +getDirectChat :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect) +getDirectChat db vr user contactId pagination search_ = do let search = fromMaybe "" search_ - ct <- getContact db user contactId + ct <- getContact db vr user contactId liftIO $ case pagination of CPLast count -> getDirectChatLast_ db user ct count search CPAfter afterId count -> getDirectChatAfter_ db user ct afterId count search @@ -1040,7 +1040,7 @@ getDirectChatBefore_ db user@User {userId} ct@Contact {contactId} beforeChatItem |] (userId, contactId, search, beforeChatItemId, count) -getGroupChat :: DB.Connection -> VersionRange -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChat :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup) getGroupChat db vr user groupId pagination search_ = do let search = fromMaybe "" search_ g <- getGroupInfo db vr user groupId @@ -1506,7 +1506,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, ciTimed :: Maybe CITimed ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} -getAllChatItems :: DB.Connection -> VersionRange -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] +getAllChatItems :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] getAllChatItems db vr user@User {userId} pagination search_ = do itemRefs <- rights . map toChatItemRef <$> case pagination of @@ -2150,7 +2150,7 @@ deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do |] (userId, noteFolderId, itemId) -getChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO AChatItem +getChatItemByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO AChatItem getChatItemByFileId db vr user@User {userId} fileId = do (chatRef, itemId) <- ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $ @@ -2166,13 +2166,13 @@ getChatItemByFileId db vr user@User {userId} fileId = do (userId, fileId) getAChatItem db vr user chatRef itemId -lookupChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem) +lookupChatItemByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem) lookupChatItemByFileId db vr user fileId = do fmap Just (getChatItemByFileId db vr user fileId) `catchError` \case SEChatItemNotFoundByFileId {} -> pure Nothing e -> throwError e -getChatItemByGroupId :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO AChatItem +getChatItemByGroupId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO AChatItem getChatItemByGroupId db vr user@User {userId} groupId = do (chatRef, itemId) <- ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $ @@ -2198,10 +2198,10 @@ getChatRefViaItemId db User {userId} itemId = do (Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId (_, _) -> Left $ SEBadChatItem itemId Nothing -getAChatItem :: DB.Connection -> VersionRange -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem +getAChatItem :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem getAChatItem db vr user chatRef itemId = case chatRef of ChatRef CTDirect contactId -> do - ct <- getContact db user contactId + ct <- getContact db vr user contactId (CChatItem msgDir ci) <- getDirectChatItem db user contactId itemId pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci ChatRef CTGroup groupId -> do @@ -2438,9 +2438,9 @@ createCIModeration db GroupInfo {groupId} moderatorMember itemMemberId itemShare |] (groupId, groupMemberId' moderatorMember, itemMemberId, itemSharedMId, msgId, moderatedAtTs) -getCIModeration :: DB.Connection -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration) -getCIModeration _ _ _ _ Nothing = pure Nothing -getCIModeration db user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do +getCIModeration :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration) +getCIModeration _ _ _ _ _ Nothing = pure Nothing +getCIModeration db vr user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do r_ <- maybeFirstRow id $ DB.query @@ -2454,7 +2454,7 @@ getCIModeration db user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do (groupId, itemMemberId, sharedMsgId) case r_ of Just (moderationId, moderatorId, createdByMsgId, moderatedAt) -> do - runExceptT (getGroupMember db user groupId moderatorId) >>= \case + runExceptT (getGroupMember db vr user groupId moderatorId) >>= \case Right moderatorMember -> pure (Just CIModeration {moderationId, moderatorMember, createdByMsgId, moderatedAt}) _ -> pure Nothing _ -> pure Nothing diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 6d3a7a9a4f..d8bdbd6fd3 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -101,6 +101,7 @@ import Simplex.Chat.Migrations.M20240122_indexes import Simplex.Chat.Migrations.M20240214_redirect_file_id import Simplex.Chat.Migrations.M20240222_app_settings import Simplex.Chat.Migrations.M20240226_users_restrict +import Simplex.Chat.Migrations.M20240228_pq import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -201,7 +202,8 @@ schemaMigrations = ("20240122_indexes", m20240122_indexes, Just down_m20240122_indexes), ("20240214_redirect_file_id", m20240214_redirect_file_id, Just down_m20240214_redirect_file_id), ("20240222_app_settings", m20240222_app_settings, Just down_m20240222_app_settings), - ("20240226_users_restrict", m20240226_users_restrict, Just down_m20240226_users_restrict) + ("20240226_users_restrict", m20240226_users_restrict, Just down_m20240226_users_restrict), + ("20240228_pq", m20240228_pq, Just down_m20240228_pq) ] -- | 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 eceb19ba34..512c857b23 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -85,6 +85,8 @@ import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C +import qualified Simplex.Messaging.Crypto.Ratchet as CR +import Simplex.Messaging.Crypto.Ratchet (PQSupport) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode) @@ -323,37 +325,39 @@ createUserContactLink db User {userId} agentConnId cReq subMode = "INSERT INTO user_contact_links (user_id, conn_req_contact, created_at, updated_at) VALUES (?,?,?,?)" (userId, cReq, currentTs, currentTs) userContactLinkId <- insertedRowId db - void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode + void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff -getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection] -getUserAddressConnections db User {userId} = do +getUserAddressConnections :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ExceptT StoreError IO [Connection] +getUserAddressConnections db vr User {userId} = do cs <- liftIO getUserAddressConnections_ if null cs then throwError SEUserContactLinkNotFound else pure cs where getUserAddressConnections_ :: IO [Connection] getUserAddressConnections_ = - map toConnection + map (toConnection vr) <$> DB.query db [sql| SELECT 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 + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version FROM connections c JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id WHERE c.user_id = ? AND uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL |] (userId, userId) -getUserContactLinks :: DB.Connection -> User -> IO [(Connection, UserContact)] -getUserContactLinks db User {userId} = +getUserContactLinks :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [(Connection, UserContact)] +getUserContactLinks db vr User {userId} = map toUserContactConnection <$> DB.query db [sql| SELECT 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, + 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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, + c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version, uc.user_contact_link_id, uc.conn_req_contact, uc.group_id FROM connections c JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id @@ -362,7 +366,7 @@ getUserContactLinks db User {userId} = (userId, userId) where toUserContactConnection :: (ConnectionRow :. (Int64, ConnReqContact, Maybe GroupId)) -> (Connection, UserContact) - toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection connRow, UserContact {userContactLinkId, connReqContact, groupId}) + toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection vr connRow, UserContact {userContactLinkId, connReqContact, groupId}) deleteUserAddress :: DB.Connection -> User -> IO () deleteUserAddress db user@User {userId} = do @@ -470,8 +474,8 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) = |] (userId, cReqSchema1, cReqSchema2) -getContactWithoutConnViaAddress :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact) -getContactWithoutConnViaAddress db user@User {userId} (cReqSchema1, cReqSchema2) = do +getContactWithoutConnViaAddress :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact) +getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchema2) = do ctId_ <- maybeFirstRow fromOnly $ DB.query @@ -484,7 +488,7 @@ getContactWithoutConnViaAddress db user@User {userId} (cReqSchema1, cReqSchema2) WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL |] (userId, cReqSchema1, cReqSchema2) - maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) ctId_ + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_ updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink updateUserAddressAutoAccept db user@User {userId} autoAccept = do diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index bc1232f427..6d5c41c1a5 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} @@ -36,6 +37,8 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..)) +import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (allFinally) @@ -148,17 +151,38 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64) -type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Int, Version, Version) +type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, PQSupport, PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Int, Maybe VersionChat, VersionChat, VersionChat) -type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe Int, Maybe Version, Maybe Version) +type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat) -toConnection :: ConnectionRow -> Connection -toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) = - let entityId = entityId_ connType - connectionCode = SecurityCode <$> code_ <*> verifiedAt_ - peerChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer - in Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias, entityId, connectionCode, authErrCounter, createdAt} +toConnection :: (PQSupport -> VersionRangeChat) -> ConnectionRow -> Connection +toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, chatV, minVer, maxVer)) = + Connection + { connId, + agentConnId = AgentConnId acId, + connChatVersion = fromMaybe (vr pqSupport `peerConnChatVersion` peerChatVRange) chatV, + peerChatVRange = peerChatVRange, + connLevel, + viaContact, + viaUserContactLink, + viaGroupLink, + groupLinkId, + customUserProfileId, + connStatus, + connType, + contactConnInitiated, + localAlias, + entityId = entityId_ connType, + connectionCode = SecurityCode <$> code_ <*> verifiedAt_, + pqSupport, + pqEncryption, + pqSndEnabled, + pqRcvEnabled, + authErrCounter, + createdAt + } where + peerChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer entityId_ :: ConnType -> Maybe Int64 entityId_ ConnContact = contactId entityId_ ConnMember = groupMemberId @@ -166,13 +190,13 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup entityId_ ConnSndFile = sndFileId entityId_ ConnUserContact = userContactLinkId -toMaybeConnection :: MaybeConnectionRow -> Maybe Connection -toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just authErrCounter, Just minVer, Just maxVer)) = - Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) -toMaybeConnection _ = Nothing +toMaybeConnection :: (PQSupport -> VersionRangeChat) -> MaybeConnectionRow -> Maybe Connection +toMaybeConnection vr ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, connChatVersion, Just minVer, Just maxVer)) = + Just $ toConnection vr ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, connChatVersion, minVer, maxVer)) +toMaybeConnection _ _ = Nothing -createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRange -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> IO Connection -createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode = do +createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> IO Connection +createConnection_ db userId connType entityId acId connChatVersion peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode pqSup = do viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId -> maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId) let viaGroupLink = isJust viaLinkGroupId @@ -182,15 +206,39 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange INSERT INTO connections ( user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, custom_user_profile_id, conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, updated_at, - peer_chat_min_version, peer_chat_max_version, to_subscribe - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + conn_chat_version, peer_chat_min_version, peer_chat_max_version, to_subscribe, pq_support, pq_encryption + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (userId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, customUserProfileId, ConnNew, connType) :. (ent ConnContact, ent ConnMember, ent ConnSndFile, ent ConnRcvFile, ent ConnUserContact, currentTs, currentTs) - :. (minV, maxV, subMode == SMOnlyCreate) + :. (connChatVersion, minV, maxV, subMode == SMOnlyCreate, pqSup, pqSup) ) connId <- insertedRowId db - pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange = JVersionRange peerChatVRange, connType, contactConnInitiated = False, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} + pure + Connection + { connId, + agentConnId = AgentConnId acId, + connChatVersion, + peerChatVRange, + connType, + contactConnInitiated = False, + entityId, + viaContact, + viaUserContactLink, + viaGroupLink, + groupLinkId = Nothing, + customUserProfileId, + connLevel, + connStatus = ConnNew, + localAlias = "", + createdAt = currentTs, + connectionCode = Nothing, + pqSupport = pqSup, + pqEncryption = CR.pqSupportToEnc pqSup, + pqSndEnabled = Nothing, + pqRcvEnabled = Nothing, + authErrCounter = 0 + } where ent ct = if connType == ct then entityId else Nothing @@ -205,18 +253,62 @@ createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, imag (displayName, fullName, image, userId, Just True, createdAt, createdAt) insertedRowId db -setPeerChatVRange :: DB.Connection -> Int64 -> VersionRange -> IO () -setPeerChatVRange db connId (VersionRange minVer maxVer) = +updateConnSupportPQ :: DB.Connection -> Int64 -> PQSupport -> PQEncryption -> IO () +updateConnSupportPQ db connId pqSup pqEnc = DB.execute db [sql| UPDATE connections - SET peer_chat_min_version = ?, peer_chat_max_version = ? + SET pq_support = ?, pq_encryption = ? WHERE connection_id = ? |] - (minVer, maxVer, connId) + (pqSup, pqEnc, connId) -setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRange -> IO () +updateConnPQSndEnabled :: DB.Connection -> Int64 -> PQEncryption -> IO () +updateConnPQSndEnabled db connId pqSndEnabled = + DB.execute + db + [sql| + UPDATE connections + SET pq_snd_enabled = ? + WHERE connection_id = ? + |] + (pqSndEnabled, connId) + +updateConnPQRcvEnabled :: DB.Connection -> Int64 -> PQEncryption -> IO () +updateConnPQRcvEnabled db connId pqRcvEnabled = + DB.execute + db + [sql| + UPDATE connections + SET pq_rcv_enabled = ? + WHERE connection_id = ? + |] + (pqRcvEnabled, connId) + +updateConnPQEnabledCON :: DB.Connection -> Int64 -> PQEncryption -> IO () +updateConnPQEnabledCON db connId pqEnabled = + DB.execute + db + [sql| + UPDATE connections + SET pq_snd_enabled = ?, pq_rcv_enabled = ? + WHERE connection_id = ? + |] + (pqEnabled, pqEnabled, connId) + +setPeerChatVRange :: DB.Connection -> Int64 -> VersionChat -> VersionRangeChat -> IO () +setPeerChatVRange db connId chatV (VersionRange minVer maxVer) = + DB.execute + db + [sql| + UPDATE connections + SET conn_chat_version = ?, peer_chat_min_version = ?, peer_chat_max_version = ? + WHERE connection_id = ? + |] + (chatV, minVer, maxVer, connId) + +setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRangeChat -> IO () setMemberChatVRange db mId (VersionRange minVer maxVer) = DB.execute db @@ -279,10 +371,10 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId = 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 :. MaybeConnectionRow -> 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) = +toContact :: (PQSupport -> VersionRangeChat) -> User -> ContactRow :. MaybeConnectionRow -> Contact +toContact vr 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 = toMaybeConnection connRow + activeConn = toMaybeConnection vr connRow chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} incognito = maybe False connIncognito activeConn mergedPreferences = contactUserPreferences user userPreferences preferences incognito @@ -303,13 +395,13 @@ getProfileById db userId profileId = toProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences) -> LocalProfile toProfile (displayName, fullName, image, contactLink, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} -type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime, Version, Version) +type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, PQSupport, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat) toContactRequest :: ContactRequestRow -> UserContactRequest -toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt, minVer, maxVer)) = do +toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, pqSupport, preferences, createdAt, updatedAt, minVer, maxVer)) = do let profile = Profile {displayName, fullName, image, contactLink, preferences} - cReqChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer - in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt} + cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer + in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, createdAt, updatedAt} userQuery :: Query userQuery = diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 0a35a83edd..f16913439d 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -23,7 +23,7 @@ module Simplex.Chat.Types where import Crypto.Number.Serialize (os2ip) -import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=)) +import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J import qualified Data.Aeson.Encoding as JE import qualified Data.Aeson.TH as JQ @@ -38,6 +38,7 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (UTCTime) import Data.Typeable (Typeable) +import Data.Word (Word16) import Database.SQLite.Simple (ResultError (..), SQLData (..)) import Database.SQLite.Simple.FromField (FromField (..), returnError) import Database.SQLite.Simple.Internal (Field (..)) @@ -48,11 +49,13 @@ import Simplex.Chat.Types.Util import Simplex.FileTransfer.Description (FileDigest) import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, RcvFileId, SAEntity (..), SndFileId, UserId) import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON) import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI) import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>)) import Simplex.Messaging.Version +import Simplex.Messaging.Version.Internal class IsContact a where contactId' :: a -> ContactId @@ -211,6 +214,9 @@ contactDeleted Contact {contactStatus} = contactStatus == CSDeleted contactSecurityCode :: Contact -> Maybe SecurityCode contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn +contactPQEnabled :: Contact -> PQEncryption +contactPQEnabled Contact {activeConn} = maybe PQEncOff connPQEnabled activeConn + data ContactStatus = CSActive | CSDeleted -- contact deleted by contact @@ -272,13 +278,14 @@ data UserContactRequest = UserContactRequest agentInvitationId :: AgentInvId, userContactLinkId :: Int64, agentContactConnId :: AgentConnId, -- connection id of user contact - cReqChatVRange :: JVersionRange, + cReqChatVRange :: VersionRangeChat, localDisplayName :: ContactName, profileId :: Int64, profile :: Profile, createdAt :: UTCTime, updatedAt :: UTCTime, - xContactId :: Maybe XContactId + xContactId :: Maybe XContactId, + pqSupport :: PQSupport } deriving (Eq, Show) @@ -563,7 +570,8 @@ data GroupInvitation = GroupInvitation invitedMember :: MemberIdRole, connRequest :: ConnReqInvitation, groupProfile :: GroupProfile, - groupLinkId :: Maybe GroupLinkId + groupLinkId :: Maybe GroupLinkId, + groupSize :: Maybe Int } deriving (Eq, Show) @@ -571,7 +579,8 @@ data GroupLinkInvitation = GroupLinkInvitation { fromMember :: MemberIdRole, fromMemberName :: ContactName, invitedMember :: MemberIdRole, - groupProfile :: GroupProfile + groupProfile :: GroupProfile, + groupSize :: Maybe Int } deriving (Eq, Show) @@ -600,7 +609,7 @@ memberInfo GroupMember {memberId, memberRole, memberProfile, activeConn} = MemberInfo { memberId, memberRole, - v = ChatVersionRange . fromJVersionRange . peerChatVRange <$> activeConn, + v = ChatVersionRange . peerChatVRange <$> activeConn, profile = redactedMemberProfile $ fromLocalProfile memberProfile } @@ -682,7 +691,7 @@ data GroupMember = GroupMember -- member chat protocol version range; if member has active connection, its version range is preferred; -- for membership current supportedChatVRange is set, it's not updated on protocol version increase in database, -- but it's correctly set on read (see toGroupInfo) - memberChatVRange :: JVersionRange + memberChatVRange :: VersionRangeChat } deriving (Eq, Show) @@ -699,11 +708,13 @@ memberConn GroupMember {activeConn} = activeConn memberConnId :: GroupMember -> Maybe ConnId memberConnId GroupMember {activeConn} = aConnId <$> activeConn -memberChatVRange' :: GroupMember -> VersionRange -memberChatVRange' GroupMember {activeConn, memberChatVRange} = - fromJVersionRange $ case activeConn of - Just Connection {peerChatVRange} -> peerChatVRange - Nothing -> memberChatVRange +memberChatVRange' :: GroupMember -> VersionRangeChat +memberChatVRange' GroupMember {activeConn, memberChatVRange} = case activeConn of + Just Connection {peerChatVRange} -> peerChatVRange + Nothing -> memberChatVRange + +supportsVersion :: GroupMember -> VersionChat -> Bool +supportsVersion m v = maxVersion (memberChatVRange' m) >= v groupMemberId' :: GroupMember -> GroupMemberId groupMemberId' GroupMember {groupMemberId} = groupMemberId @@ -1280,7 +1291,8 @@ type ConnReqContact = ConnectionRequestUri 'CMContact data Connection = Connection { connId :: Int64, agentConnId :: AgentConnId, - peerChatVRange :: JVersionRange, + connChatVersion :: VersionChat, + peerChatVRange :: VersionRangeChat, connLevel :: Int, viaContact :: Maybe Int64, -- group member contact ID, if not direct connection viaUserContactLink :: Maybe Int64, -- user contact link ID, if connected via "user address" @@ -1293,6 +1305,10 @@ data Connection = Connection localAlias :: Text, entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID connectionCode :: Maybe SecurityCode, + pqSupport :: PQSupport, + pqEncryption :: PQEncryption, + pqSndEnabled :: Maybe PQEncryption, + pqRcvEnabled :: Maybe PQEncryption, authErrCounter :: Int, createdAt :: UTCTime } @@ -1327,6 +1343,10 @@ aConnId Connection {agentConnId = AgentConnId cId} = cId connIncognito :: Connection -> Bool connIncognito Connection {customUserProfileId} = isJust customUserProfileId +connPQEnabled :: Connection -> PQEncryption +connPQEnabled Connection {pqSndEnabled = Just (PQEncryption s), pqRcvEnabled = Just (PQEncryption r)} = PQEncryption $ s && r +connPQEnabled _ = PQEncOff + data PendingContactConnection = PendingContactConnection { pccConnId :: Int64, pccAgentConnId :: AgentConnId, @@ -1615,10 +1635,32 @@ data ServerCfg p = ServerCfg } deriving (Show) -newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRange} deriving (Eq, Show) +data ChatVersion -chatInitialVRange :: VersionRange -chatInitialVRange = versionToRange 1 +instance VersionScope ChatVersion + +type VersionChat = Version ChatVersion + +type VersionRangeChat = VersionRange ChatVersion + +pattern VersionChat :: Word16 -> VersionChat +pattern VersionChat v = Version v + +-- this newtype exists to have a concise JSON encoding of version ranges in chat protocol messages in the form of "1-2" or just "1" +newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRangeChat} deriving (Eq, Show) + +-- TODO v6.0 review +peerConnChatVersion :: VersionRangeChat -> VersionRangeChat -> VersionChat +peerConnChatVersion _local@(VersionRange lmin lmax) _peer@(VersionRange rmin rmax) + | lmin <= rmax && rmin <= lmax = min lmax rmax -- compatible + | rmin > lmax = rmin + | otherwise = rmax + +initialChatVersion :: VersionChat +initialChatVersion = VersionChat 1 + +chatInitialVRange :: VersionRangeChat +chatInitialVRange = versionToRange initialChatVersion instance FromJSON ChatVersionRange where parseJSON v = ChatVersionRange <$> strParseJSON "ChatVersionRange" v @@ -1627,18 +1669,6 @@ instance ToJSON ChatVersionRange where toJSON (ChatVersionRange vr) = strToJSON vr toEncoding (ChatVersionRange vr) = strToJEncoding vr -newtype JVersionRange = JVersionRange {fromJVersionRange :: VersionRange} deriving (Eq, Show) - -instance FromJSON JVersionRange where - parseJSON = J.withObject "JVersionRange" $ \o -> do - minv <- o .: "minVersion" - maxv <- o .: "maxVersion" - maybe (fail "bad version range") (pure . JVersionRange) $ safeVersionRange minv maxv - -instance ToJSON JVersionRange where - toJSON (JVersionRange (VersionRange minV maxV)) = J.object ["minVersion" .= minV, "maxVersion" .= maxV] - toEncoding (JVersionRange (VersionRange minV maxV)) = J.pairs $ "minVersion" .= minV <> "maxVersion" .= maxV - $(JQ.deriveJSON defaultJSON ''UserContact) $(JQ.deriveJSON defaultJSON ''Profile) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 7648cba32a..8aa917f044 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -49,13 +49,14 @@ import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (.. import Simplex.Chat.Styled import Simplex.Chat.Types import Simplex.Chat.Types.Preferences -import qualified Simplex.FileTransfer.Protocol as XFTP +import qualified Simplex.FileTransfer.Transport as XFTPTransport import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..)) import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..)) import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) +import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON) @@ -341,6 +342,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} -> ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName] CRRemoteCtrlStopped {} -> ["remote controller stopped"] + CRContactPQAllowed u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": enable " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption"] + CRContactPQEnabled u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption enabled"] CRSQLResult rows -> map plain rows CRSlowSQLQueries {chatQueries, agentQueries} -> let viewQuery SlowSQLQuery {query, queryStats = SlowQueryStats {count, timeMax, timeAvg}} = @@ -1134,7 +1137,7 @@ viewServerTestResult (AProtoServerWithAuth p _) = \case Just ProtocolTestFailure {testStep, testError} -> result <> [pName <> " server requires authorization to create queues, check password" | testStep == TSCreateQueue && testError == SMP SMP.AUTH] - <> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && testError == XFTP XFTP.AUTH] + <> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && testError == XFTP XFTPTransport.AUTH] <> ["Possibly, certificate fingerprint in " <> pName <> " server address is incorrect" | testStep == TSConnect && brokerErr] where result = [pName <> " server test failed at " <> plain (drop 2 $ show testStep) <> ", error: " <> plain (strEncode testError)] @@ -1174,6 +1177,7 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta incognitoProfile <> ["alias: " <> plain localAlias | localAlias /= ""] <> [viewConnectionVerified (contactSecurityCode ct)] + <> ["quantum resistant end-to-end encryption" | contactPQEnabled ct == CR.PQEncOn] <> maybe [] (\ac -> [viewPeerChatVRange (peerChatVRange ac)]) activeConn viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString] @@ -1197,8 +1201,8 @@ viewConnectionVerified :: Maybe SecurityCode -> StyledString viewConnectionVerified (Just _) = "connection verified" -- TODO show verification time? viewConnectionVerified _ = "connection not verified, use " <> highlight' "/code" <> " command to see security code" -viewPeerChatVRange :: JVersionRange -> StyledString -viewPeerChatVRange (JVersionRange (VersionRange minVer maxVer)) = "peer chat protocol version range: (" <> sShow minVer <> ", " <> sShow maxVer <> ")" +viewPeerChatVRange :: VersionRangeChat -> StyledString +viewPeerChatVRange (VersionRange minVer maxVer) = "peer chat protocol version range: (" <> sShow minVer <> ", " <> sShow maxVer <> ")" viewConnectionStats :: ConnectionStats -> [StyledString] viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} = diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 13c814d3c5..792f9642d3 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -3,7 +3,9 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} @@ -26,24 +28,29 @@ import Simplex.Chat import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..)) import Simplex.Chat.Core import Simplex.Chat.Options +import Simplex.Chat.Protocol (currentChatVersion, pqEncryptionCompressionVersion) import Simplex.Chat.Store import Simplex.Chat.Store.Profiles import Simplex.Chat.Terminal import Simplex.Chat.Terminal.Output (newChatTerminal) -import Simplex.Chat.Types (AgentUserId (..), Profile, User (..)) +import Simplex.Chat.Types import Simplex.FileTransfer.Description (kb, mb) import Simplex.FileTransfer.Server (runXFTPServerBlocking) import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration) import Simplex.Messaging.Agent.Env.SQLite +import Simplex.Messaging.Agent.Protocol (currentSMPAgentVersion, duplexHandshakeSMPAgentVersion, pqdrSMPAgentVersion, supportedSMPAgentVRange) import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..)) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultNetworkConfig) +import Simplex.Messaging.Crypto.Ratchet (supportedE2EEncryptVRange, pattern PQSupportOff) +import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Server (runSMPServerBlocking) import Simplex.Messaging.Server.Env.STM import Simplex.Messaging.Transport import Simplex.Messaging.Transport.Server (defaultTransportServerConfig) import Simplex.Messaging.Version +import Simplex.Messaging.Version.Internal import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive) import System.FilePath (()) import qualified System.Terminal as C @@ -136,60 +143,85 @@ testCfg = testAgentCfgVPrev :: AgentConfig testAgentCfgVPrev = testAgentCfg - { smpAgentVRange = prevRange $ smpAgentVRange testAgentCfg, - smpClientVRange = prevRange $ smpClientVRange testAgentCfg, - e2eEncryptVRange = prevRange $ e2eEncryptVRange testAgentCfg, + { smpClientVRange = prevRange $ smpClientVRange testAgentCfg, + smpAgentVRange = \_ -> prevRange $ supportedSMPAgentVRange PQSupportOff, + e2eEncryptVRange = \_ -> prevRange $ supportedE2EEncryptVRange PQSupportOff, smpCfg = (smpCfg testAgentCfg) {serverVRange = prevRange $ serverVRange $ smpCfg testAgentCfg} } +testAgentCfgVNext :: AgentConfig +testAgentCfgVNext = + testAgentCfg + { smpClientVRange = nextRange $ smpClientVRange testAgentCfg, + smpAgentVRange = \_ -> mkVersionRange duplexHandshakeSMPAgentVersion $ max pqdrSMPAgentVersion currentSMPAgentVersion, + e2eEncryptVRange = \_ -> mkVersionRange CR.kdfX3DHE2EEncryptVersion $ max CR.pqRatchetE2EEncryptVersion CR.currentE2EEncryptVersion, + smpCfg = (smpCfg testAgentCfg) {serverVRange = nextRange $ serverVRange $ smpCfg testAgentCfg} + } + testAgentCfgV1 :: AgentConfig testAgentCfgV1 = testAgentCfg { smpClientVRange = v1Range, - smpAgentVRange = versionToRange 2, -- duplexHandshakeSMPAgentVersion, - e2eEncryptVRange = versionToRange 2, -- kdfX3DHE2EEncryptVersion, - smpCfg = (smpCfg testAgentCfg) {serverVRange = versionToRange 4} -- batchCmdsSMPVersion + smpAgentVRange = \_ -> versionToRange duplexHandshakeSMPAgentVersion, + e2eEncryptVRange = \_ -> versionToRange CR.kdfX3DHE2EEncryptVersion, + smpCfg = (smpCfg testAgentCfg) {serverVRange = versionToRange batchCmdsSMPVersion} } testCfgVPrev :: ChatConfig testCfgVPrev = testCfg - { chatVRange = prevRange $ chatVRange testCfg, + { chatVRange = \_ -> prevRange $ chatVRange testCfg PQSupportOff, agentConfig = testAgentCfgVPrev } +testCfgVNext :: ChatConfig +testCfgVNext = + testCfg + { chatVRange = \_ -> mkVersionRange initialChatVersion $ max pqEncryptionCompressionVersion currentChatVersion, + agentConfig = testAgentCfgVNext + } + testCfgV1 :: ChatConfig testCfgV1 = testCfg - { chatVRange = v1Range, + { chatVRange = const v1Range, agentConfig = testAgentCfgV1 } -prevRange :: VersionRange -> VersionRange -prevRange vr = vr {maxVersion = max (minVersion vr) (maxVersion vr - 1)} +prevRange :: VersionRange v -> VersionRange v +prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr)} -v1Range :: VersionRange -v1Range = mkVersionRange 1 1 +nextRange :: VersionRange v -> VersionRange v +nextRange vr = vr {maxVersion = max (minVersion vr) (nextVersion $ maxVersion vr)} + +v1Range :: VersionRange v +v1Range = mkVersionRange (Version 1) (Version 1) + +prevVersion :: Version v -> Version v +prevVersion (Version v) = Version (v - 1) + +nextVersion :: Version v -> Version v +nextVersion (Version v) = Version (v + 1) testCfgCreateGroupDirect :: ChatConfig testCfgCreateGroupDirect = mkCfgCreateGroupDirect testCfg mkCfgCreateGroupDirect :: ChatConfig -> ChatConfig -mkCfgCreateGroupDirect cfg = cfg {chatVRange = groupCreateDirectVRange} +mkCfgCreateGroupDirect cfg = cfg {chatVRange = const groupCreateDirectVRange} -groupCreateDirectVRange :: VersionRange -groupCreateDirectVRange = mkVersionRange 1 1 +groupCreateDirectVRange :: VersionRangeChat +groupCreateDirectVRange = mkVersionRange (VersionChat 1) (VersionChat 1) testCfgGroupLinkViaContact :: ChatConfig testCfgGroupLinkViaContact = mkCfgGroupLinkViaContact testCfg mkCfgGroupLinkViaContact :: ChatConfig -> ChatConfig -mkCfgGroupLinkViaContact cfg = cfg {chatVRange = groupLinkViaContactVRange} +mkCfgGroupLinkViaContact cfg = cfg {chatVRange = const groupLinkViaContactVRange} -groupLinkViaContactVRange :: VersionRange -groupLinkViaContactVRange = mkVersionRange 1 2 +groupLinkViaContactVRange :: VersionRangeChat +groupLinkViaContactVRange = mkVersionRange (VersionChat 1) (VersionChat 2) createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC createTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefix profile = do @@ -318,7 +350,8 @@ getTermLine cc = _ -> error "no output for 5 seconds" userName :: TestCC -> IO [Char] -userName (TestCC ChatController {currentUser} _ _ _ _ _) = maybe "no current user" (T.unpack . localDisplayName) <$> readTVarIO currentUser +userName (TestCC ChatController {currentUser} _ _ _ _ _) = + maybe "no current user" (\User {localDisplayName} -> T.unpack localDisplayName) <$> readTVarIO currentUser testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO () testChat2 = testChatCfgOpts2 testCfg testOpts diff --git a/tests/ChatTests/ChatList.hs b/tests/ChatTests/ChatList.hs index 8492ab0f0d..7f02fafc2c 100644 --- a/tests/ChatTests/ChatList.hs +++ b/tests/ChatTests/ChatList.hs @@ -199,14 +199,14 @@ testPaginationAllChatTypes = ts7 <- iso8601Show <$> getCurrentTime - getChats_ alice "count=10" [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice "count=3" [("*", "psst"), ("@dan", "hey"), ("#team", "")] + getChats_ alice "count=10" [("*", "psst"), ("@dan", "hey"), ("#team", e2eeInfoNoPQStr), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice "count=3" [("*", "psst"), ("@dan", "hey"), ("#team", e2eeInfoNoPQStr)] getChats_ alice ("after=" <> ts2 <> " count=2") [(":3", ""), ("<@cath", "")] - getChats_ alice ("before=" <> ts5 <> " count=2") [("#team", ""), (":3", "")] - getChats_ alice ("after=" <> ts3 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", "")] + getChats_ alice ("before=" <> ts5 <> " count=2") [("#team", e2eeInfoNoPQStr), (":3", "")] + getChats_ alice ("after=" <> ts3 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", e2eeInfoNoPQStr), (":3", "")] getChats_ alice ("before=" <> ts4 <> " count=10") [(":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice ("after=" <> ts1 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice ("before=" <> ts7 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice ("after=" <> ts1 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", e2eeInfoNoPQStr), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice ("before=" <> ts7 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", e2eeInfoNoPQStr), (":3", ""), ("<@cath", ""), ("@bob", "hey")] getChats_ alice ("after=" <> ts7 <> " count=10") [] getChats_ alice ("before=" <> ts1 <> " count=10") [] @@ -218,11 +218,11 @@ testPaginationAllChatTypes = alice ##> "/_settings #1 {\"enableNtfs\":\"all\",\"favorite\":true}" alice <## "ok" - getChats_ alice queryFavorite [("#team", ""), ("@bob", "hey")] + getChats_ alice queryFavorite [("#team", e2eeInfoNoPQStr), ("@bob", "hey")] getChats_ alice ("before=" <> ts4 <> " count=1 " <> queryFavorite) [("@bob", "hey")] - getChats_ alice ("before=" <> ts5 <> " count=1 " <> queryFavorite) [("#team", "")] + getChats_ alice ("before=" <> ts5 <> " count=1 " <> queryFavorite) [("#team", e2eeInfoNoPQStr)] getChats_ alice ("after=" <> ts1 <> " count=1 " <> queryFavorite) [("@bob", "hey")] - getChats_ alice ("after=" <> ts4 <> " count=1 " <> queryFavorite) [("#team", "")] + getChats_ alice ("after=" <> ts4 <> " count=1 " <> queryFavorite) [("#team", e2eeInfoNoPQStr)] let queryUnread = "{\"type\": \"filters\", \"favorite\": false, \"unread\": true}" diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 44bfb543f6..4e06f68fb6 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PostfixOperators #-} {-# LANGUAGE RankNTypes #-} @@ -9,7 +10,7 @@ import ChatClient import ChatTests.Utils import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) -import Control.Monad (forM_) +import Control.Monad (forM_, when) import Data.Aeson (ToJSON) import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B @@ -20,10 +21,11 @@ import qualified Simplex.Chat.AppSettings as AS import Simplex.Chat.Call import Simplex.Chat.Controller (ChatConfig (..)) import Simplex.Chat.Options (ChatOpts (..)) -import Simplex.Chat.Protocol (supportedChatVRange) +import Simplex.Chat.Protocol (currentChatVersion, pqEncryptionCompressionVersion, supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) -import Simplex.Chat.Types (authErrDisableCount, sameVerificationCode, verificationCode) +import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, VersionChat, pattern VersionChat) import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) import Simplex.Messaging.Util (safeDecodeUtf8) import Simplex.Messaging.Version import System.Directory (copyFile, doesDirectoryExist, doesFileExist) @@ -114,18 +116,25 @@ chatDirectTests = do it "should send delivery receipts depending on configuration" testConfigureDeliveryReceipts describe "negotiate connection peer chat protocol version range" $ do describe "peer version range correctly set for new connection via invitation" $ do - testInvVRange supportedChatVRange supportedChatVRange - testInvVRange supportedChatVRange vr11 - testInvVRange vr11 supportedChatVRange + testInvVRange (supportedChatVRange PQSupportOff) (supportedChatVRange PQSupportOff) + testInvVRange (supportedChatVRange PQSupportOff) vr11 + testInvVRange vr11 (supportedChatVRange PQSupportOff) testInvVRange vr11 vr11 describe "peer version range correctly set for new connection via contact request" $ do - testReqVRange supportedChatVRange supportedChatVRange - testReqVRange supportedChatVRange vr11 - testReqVRange vr11 supportedChatVRange + testReqVRange (supportedChatVRange PQSupportOff) (supportedChatVRange PQSupportOff) + testReqVRange (supportedChatVRange PQSupportOff) vr11 + testReqVRange vr11 (supportedChatVRange PQSupportOff) testReqVRange vr11 vr11 it "update peer version range on received messages" testUpdatePeerChatVRange describe "network statuses" $ do it "should get network statuses" testGetNetworkStatuses + describe "PQ tests" $ do + describe "enable PQ before connection, connect via invitation link" $ pqMatrix2 runTestPQConnectViaLink + describe "enable PQ before connection, connect via contact address" $ pqMatrix2 runTestPQConnectViaAddress + describe "connect via invitation link with PQ encryption enabled" $ pqVersionTestMatrix2 runTestPQVersionsViaLink + describe "connect via contact address with PQ encryption enabled" $ pqVersionTestMatrix2 runTestPQVersionsViaAddress + it "should enable PQ after several messages in connection without PQ" testPQEnableContact + it "should enable PQ, reduce envelope size and enable compression" testPQEnableContactCompression where testInvVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnInvChatVRange vr1 vr2 testReqVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnReqChatVRange vr1 vr2 @@ -633,13 +642,13 @@ testDirectLiveMessage = connectUsers alice bob -- non-empty live message is sent instantly alice `send` "/live @bob hello" - bob <# "alice> [LIVE started] use /show [on/off/6] hello" + bob <# "alice> [LIVE started] use /show [on/off/7] hello" alice ##> ("/_update item @2 " <> itemId 1 <> " text hello there") alice <# "@bob [LIVE] hello there" bob <# "alice> [LIVE ended] hello there" -- empty live message is also sent instantly alice `send` "/live @bob" - bob <# "alice> [LIVE started] use /show [on/off/7]" + bob <# "alice> [LIVE started] use /show [on/off/8]" alice ##> ("/_update item @2 " <> itemId 2 <> " text hello 2") alice <# "@bob [LIVE] hello 2" bob <# "alice> [LIVE ended] hello 2" @@ -2083,15 +2092,16 @@ testUserPrivacy = alice <##? chatHistory alice ##> "/_get items count=10" alice <##? chatHistory - alice ##> "/_get items before=11 count=10" + alice ##> "/_get items before=13 count=10" alice - <##? [ "bob> Disappearing messages: allowed", + <##? [ ConsoleString ("bob> " <> e2eeInfoNoPQStr), + "bob> Disappearing messages: allowed", "bob> Full deletion: off", "bob> Message reactions: enabled", "bob> Voice messages: enabled", "bob> Audio/video calls: enabled" ] - alice ##> "/_get items after=10 count=10" + alice ##> "/_get items after=12 count=10" alice <##? [ "@bob hello", "bob> hey", @@ -2155,7 +2165,8 @@ testUserPrivacy = alice <## "messages are shown" alice <## "profile is visible" chatHistory = - [ "bob> Disappearing messages: allowed", + [ ConsoleString ("bob> " <> e2eeInfoNoPQStr), + "bob> Disappearing messages: allowed", "bob> Full deletion: off", "bob> Message reactions: enabled", "bob> Voice messages: enabled", @@ -2269,7 +2280,7 @@ testSwitchGroupMember = alice <## "#team: you started changing address for bob" bob <## "#team: alice changed address for you" alice <## "#team: you changed address for bob" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "started changing address for bob..."), (1, "you changed address for bob")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "started changing address for bob..."), (1, "you changed address for bob")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "started changing address for you..."), (0, "changed address for you")]) alice #> "#team hey" bob <# "#team alice> hey" @@ -2300,7 +2311,7 @@ testAbortSwitchGroupMember tmp = do bob <## "#team: alice started changing address for you" bob <## "#team: alice changed address for you" alice <## "#team: you changed address for bob" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "started changing address for bob..."), (1, "started changing address for bob..."), (1, "you changed address for bob")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "started changing address for bob..."), (1, "started changing address for bob..."), (1, "you changed address for bob")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "started changing address for you..."), (0, "started changing address for you..."), (0, "changed address for you")]) alice #> "#team hey" bob <# "#team alice> hey" @@ -2654,10 +2665,10 @@ testConfigureDeliveryReceipts tmp = cc2 <# (name1 <> "> " <> msg) cc1 VersionRange -> VersionRange -> FilePath -> IO () +testConnInvChatVRange :: HasCallStack => VersionRangeChat -> VersionRangeChat -> FilePath -> IO () testConnInvChatVRange ct1VRange ct2VRange tmp = - withNewTestChatCfg tmp testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do - withNewTestChatCfg tmp testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do + withNewTestChatCfg tmp testCfg {chatVRange = const ct1VRange} "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp testCfg {chatVRange = const ct2VRange} "bob" bobProfile $ \bob -> do connectUsers alice bob alice ##> "/i bob" @@ -2666,10 +2677,10 @@ testConnInvChatVRange ct1VRange ct2VRange tmp = bob ##> "/i alice" contactInfoChatVRange bob ct1VRange -testConnReqChatVRange :: HasCallStack => VersionRange -> VersionRange -> FilePath -> IO () +testConnReqChatVRange :: HasCallStack => VersionRangeChat -> VersionRangeChat -> FilePath -> IO () testConnReqChatVRange ct1VRange ct2VRange tmp = - withNewTestChatCfg tmp testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do - withNewTestChatCfg tmp testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do + withNewTestChatCfg tmp testCfg {chatVRange = const ct1VRange} "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp testCfg {chatVRange = const ct2VRange} "bob" bobProfile $ \bob -> do alice ##> "/ad" cLink <- getContactLink alice True bob ##> ("/c " <> cLink) @@ -2696,7 +2707,7 @@ testUpdatePeerChatVRange tmp = contactInfoChatVRange alice vr11 bob ##> "/i alice" - contactInfoChatVRange bob supportedChatVRange + contactInfoChatVRange bob (supportedChatVRange PQSupportOff) withTestChat tmp "bob" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" @@ -2705,10 +2716,10 @@ testUpdatePeerChatVRange tmp = alice <# "bob> hello 1" alice ##> "/i bob" - contactInfoChatVRange alice supportedChatVRange + contactInfoChatVRange alice (supportedChatVRange PQSupportOff) bob ##> "/i alice" - contactInfoChatVRange bob supportedChatVRange + contactInfoChatVRange bob (supportedChatVRange PQSupportOff) withTestChatCfg tmp cfg11 "bob" $ \bob -> do bob <## "1 contacts connected (use /cs for the list)" @@ -2720,9 +2731,9 @@ testUpdatePeerChatVRange tmp = contactInfoChatVRange alice vr11 bob ##> "/i alice" - contactInfoChatVRange bob supportedChatVRange + contactInfoChatVRange bob (supportedChatVRange PQSupportOff) where - cfg11 = testCfg {chatVRange = vr11} :: ChatConfig + cfg11 = testCfg {chatVRange = const vr11} :: ChatConfig testGetNetworkStatuses :: HasCallStack => FilePath -> IO () testGetNetworkStatuses tmp = do @@ -2738,10 +2749,10 @@ testGetNetworkStatuses tmp = do where cfg = testCfg {coreApi = True} -vr11 :: VersionRange -vr11 = mkVersionRange 1 1 +vr11 :: VersionRangeChat +vr11 = mkVersionRange (VersionChat 1) (VersionChat 1) -contactInfoChatVRange :: TestCC -> VersionRange -> IO () +contactInfoChatVRange :: TestCC -> VersionRangeChat -> IO () contactInfoChatVRange cc (VersionRange minVer maxVer) = do cc <## "contact ID: 2" cc <## "receiving messages via: localhost" @@ -2749,3 +2760,253 @@ contactInfoChatVRange cc (VersionRange minVer maxVer) = do cc <## "you've shared main profile with this contact" cc <## "connection not verified, use /code command to see security code" cc <## ("peer chat protocol version range: (" <> show minVer <> ", " <> show maxVer <> ")") + +runTestPQConnectViaLink :: HasCallStack => (TestCC, PQEnabled) -> (TestCC, PQEnabled) -> IO () +runTestPQConnectViaLink (alice, aPQ) (bob, bPQ) = do + when aPQ $ pqOn alice + when bPQ $ pqOn bob + + connectUsers alice bob + + (alice, "hi") `pqSend` bob + (bob, "hey") `pqSend` alice + + alice ##> "/_get chat @2 count=100" + ra <- chat <$> getTermLine alice + ra `shouldContain` [(0, e2eeInfo)] + alice `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled + + bob ##> "/_get chat @2 count=100" + rb <- chat <$> getTermLine bob + rb `shouldContain` [(0, e2eeInfo)] + bob `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled + where + pqEnabled = aPQ && bPQ + pqSend = if pqEnabled then (+#>) else (\#>) + e2eeInfo = if pqEnabled then e2eeInfoPQStr else e2eeInfoNoPQStr + +pqOn :: TestCC -> IO () +pqOn cc = do + cc ##> "/pq on" + cc <## "ok" + +runTestPQConnectViaAddress :: HasCallStack => (TestCC, PQEnabled) -> (TestCC, PQEnabled) -> IO () +runTestPQConnectViaAddress (alice, aPQ) (bob, bPQ) = do + when aPQ $ pqOn alice + when bPQ $ pqOn bob + + alice ##> "/ad" + cLink <- getContactLink alice True + 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, "hi") `pqSend` bob + (bob, "hey") `pqSend` alice + + alice ##> "/_get chat @2 count=100" + ra <- chat <$> getTermLine alice + ra `shouldContain` [(0, e2eeInfo)] + alice `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled + + bob ##> "/_get chat @2 count=100" + rb <- chat <$> getTermLine bob + rb `shouldContain` [(0, e2eeInfo)] + bob `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled + where + pqEnabled = aPQ && bPQ + pqSend = if pqEnabled then (+#>) else (\#>) + e2eeInfo = if pqEnabled then e2eeInfoPQStr else e2eeInfoNoPQStr + +runTestPQVersionsViaLink :: HasCallStack => TestCC -> TestCC -> Bool -> VersionChat -> IO () +runTestPQVersionsViaLink alice bob pqExpected vExpected = do + img <- genProfileImg + let profileImage = "data:image/png;base64," <> B.unpack img + alice `send` ("/set profile image " <> profileImage) + _trimmedCmd1 <- getTermLine alice + alice <## "profile image updated" + bob `send` ("/set profile image " <> profileImage) + _trimmedCmd2 <- getTermLine bob + bob <## "profile image updated" + + pqOn alice + pqOn bob + + connectUsers alice bob + + (alice, "hi", vExpected) `pqSend` (bob, vExpected) + (bob, "hey", vExpected) `pqSend` (alice, vExpected) + + alice ##> "/_get chat @2 count=100" + ra <- chat <$> getTermLine alice + ra `shouldContain` [(0, e2eeInfo)] + alice `pqForContact` 2 `shouldReturn` PQEncryption pqExpected + + bob ##> "/_get chat @2 count=100" + rb <- chat <$> getTermLine bob + rb `shouldContain` [(0, e2eeInfo)] + bob `pqForContact` 2 `shouldReturn` PQEncryption pqExpected + where + pqSend = if pqExpected then (+:#>) else (\:#>) + e2eeInfo = if pqExpected then e2eeInfoPQStr else e2eeInfoNoPQStr + +runTestPQVersionsViaAddress :: HasCallStack => TestCC -> TestCC -> Bool -> VersionChat -> IO () +runTestPQVersionsViaAddress alice bob pqExpected vExpected = do + img <- genProfileImg + let profileImage = "data:image/png;base64," <> B.unpack img + alice `send` ("/set profile image " <> profileImage) + _trimmedCmd1 <- getTermLine alice + alice <## "profile image updated" + bob `send` ("/set profile image " <> profileImage) + _trimmedCmd2 <- getTermLine bob + bob <## "profile image updated" + + pqOn alice + pqOn bob + + alice ##> "/ad" + cLink <- getContactLink alice True + 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, "hi", vExpected) `pqSend` (bob, vExpected) + (bob, "hey", vExpected) `pqSend` (alice, vExpected) + + alice ##> "/_get chat @2 count=100" + ra <- chat <$> getTermLine alice + ra `shouldContain` [(0, e2eeInfo)] + alice `pqForContact` 2 `shouldReturn` PQEncryption pqExpected + + bob ##> "/_get chat @2 count=100" + rb <- chat <$> getTermLine bob + rb `shouldContain` [(0, e2eeInfo)] + bob `pqForContact` 2 `shouldReturn` PQEncryption pqExpected + where + pqSend = if pqExpected then (+:#>) else (\:#>) + e2eeInfo = if pqExpected then e2eeInfoPQStr else e2eeInfoNoPQStr + +testPQEnableContact :: HasCallStack => FilePath -> IO () +testPQEnableContact = + testChat2 aliceProfile bobProfile $ \alice bob -> do + connectUsers alice bob + (alice, "hi") \#> bob + (bob, "hey") \#> alice + + alice ##> "/_get chat @2 count=100" + ra <- chat <$> getTermLine alice + ra `shouldContain` [(0, e2eeInfoNoPQStr)] + PQEncOff <- alice `pqForContact` 2 + + bob ##> "/_get chat @2 count=100" + rb <- chat <$> getTermLine bob + rb `shouldContain` [(0, e2eeInfoNoPQStr)] + PQEncOff <- bob `pqForContact` 2 + + sendMany PQEncOff alice bob + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + + -- enabling experimental flags doesn't enable PQ in previously created connection + pqOn alice + sendMany PQEncOff alice bob + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + + pqOn bob + sendMany PQEncOff alice bob + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + + -- if only one contact allows PQ, it's not enabled + alice ##> "/pq @bob on" + alice <## "bob: enable quantum resistant end-to-end encryption" + sendMany PQEncOff alice bob + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + + -- both contacts have to allow PQ to enable it + bob ##> "/pq @alice on" + bob <## "alice: enable quantum resistant end-to-end encryption" + + (alice, "1") \#> bob + (bob, "2") \#> alice + (alice, "3") \#> bob + (bob, "4") \#> alice + (alice, "5") +#> bob + + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + + (bob, "6") ++#> alice + -- equivalent to: + -- bob `send` "@alice 6" + -- bob <## "alice: quantum resistant end-to-end encryption enabled" + -- bob <# "@alice 6" + -- alice <## "bob: quantum resistant end-to-end encryption enabled" + -- alice <# "bob> 6" + + PQEncOn <- alice `pqForContact` 2 + alice #$> ("/_get chat @2 count=2", chat, [(0, e2eeInfoPQStr), (0, "6")]) + + PQEncOn <- bob `pqForContact` 2 + bob #$> ("/_get chat @2 count=2", chat, [(1, e2eeInfoPQStr), (1, "6")]) + + (alice, "6") +#> bob + (bob, "7") +#> alice + + sendMany PQEncOn alice bob + + PQEncOn <- alice `pqForContact` 2 + PQEncOn <- bob `pqForContact` 2 + pure () + +sendMany :: PQEncryption -> TestCC -> TestCC -> IO () +sendMany pqEnc alice bob = + forM_ [(1 :: Int) .. 10] $ \i -> do + sndRcv pqEnc False (alice, show i) bob + sndRcv pqEnc False (bob, show i) alice + +testPQEnableContactCompression :: HasCallStack => FilePath -> IO () +testPQEnableContactCompression = + testChat2 aliceProfile bobProfile $ \alice bob -> do + connectUsers alice bob + (alice, "hi") \#> bob + (bob, "hey") \#> alice + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + (alice, "lrg 1", v) \:#> (bob, v) + (bob, "lrg 2", v) \:#> (alice, v) + PQSupportOff <- alice `pqSupportForCt` 2 + alice ##> "/pq @bob on" + alice <## "bob: enable quantum resistant end-to-end encryption" + PQSupportOn <- alice `pqSupportForCt` 2 + (alice, "lrg 3", v) \:#> (bob, v) + (bob, "lrg 4", v) \:#> (alice, v) + PQSupportOff <- bob `pqSupportForCt` 2 + bob ##> "/pq @alice on" + bob <## "alice: enable quantum resistant end-to-end encryption" + PQSupportOn <- bob `pqSupportForCt` 2 + (alice, "lrg 1", v) \:#> (bob, v') + (bob, "lrg 2", v') \:#> (alice, v') + (alice, "lrg 3", v') \:#> (bob, v') + (bob, "lrg 4", v') \:#> (alice, v') + (alice, "lrg 5", v') +:#> (bob, v') + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + (bob, "lrg 6", v') ++:#> (alice, v') + (alice, "lrg 7", v') +:#> (bob, v') + (bob, "lrg 8", v') +:#> (alice, v') + where + v = currentChatVersion + v' = pqEncryptionCompressionVersion diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 3057fa7b70..bf9b445925 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PostfixOperators #-} module ChatTests.Groups where @@ -14,9 +15,9 @@ import qualified Data.Text as T import Simplex.Chat.Controller (ChatConfig (..)) import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) -import Simplex.Chat.Types (GroupMemberRole (..)) +import Simplex.Chat.Types (GroupMemberRole (..), VersionRangeChat) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import Simplex.Messaging.Version +import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) import System.Directory (copyFile) import System.FilePath (()) import Test.Hspec hiding (it) @@ -148,19 +149,19 @@ chatGroupTests = do it "member was blocked before joining group" testBlockForAllBeforeJoining it "can't repeat block, unblock" testBlockForAllCantRepeat where - _0 = supportedChatVRange -- don't create direct connections + _0 = supportedChatVRange PQSupportOff -- don't create direct connections _1 = groupCreateDirectVRange -- having host configured with older version doesn't have effect in tests -- because host uses current code and sends version in MemberInfo testNoDirect vrMem2 vrMem3 noConns = it ( "host " - <> vRangeStr supportedChatVRange + <> vRangeStr (supportedChatVRange PQSupportOff) <> (", 2nd mem " <> vRangeStr vrMem2) <> (", 3rd mem " <> vRangeStr vrMem3) <> (if noConns then " : 2 3" else " : 2 <##> 3") ) - $ testNoGroupDirectConns supportedChatVRange vrMem2 vrMem3 noConns + $ testNoGroupDirectConns (supportedChatVRange PQSupportOff) vrMem2 vrMem3 noConns testGroup :: HasCallStack => FilePath -> IO () testGroup = @@ -336,11 +337,11 @@ testGroupShared alice bob cath checkMessages directConnections = do getReadChats :: HasCallStack => String -> String -> IO () getReadChats msgItem1 msgItem2 = do alice @@@ [("#team", "hey team"), ("@cath", "sent invitation to join group team as admin"), ("@bob", "sent invitation to join group team as admin")] - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")]) -- "before" and "after" define a chat item id across all chats, -- so we take into account group event items as well as sent group invitations in direct chats alice #$> ("/_get chat #1 after=" <> msgItem1 <> " count=100", chat, [(0, "hi there"), (0, "hey team")]) - alice #$> ("/_get chat #1 before=" <> msgItem2 <> " count=100", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")]) + alice #$> ("/_get chat #1 before=" <> msgItem2 <> " count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")]) alice #$> ("/_get chat #1 count=100 search=team", chat, [(0, "hey team")]) bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")]) @@ -499,9 +500,10 @@ testGroup2 = dan <##> cath dan <##> alice -- show last messages - alice ##> "/t #club 8" + alice ##> "/t #club 9" alice -- these strings are expected in any order because of sorting by time and rounding of time for sent - <##? [ "#club bob> connected", + <##? [ ConsoleString ("#club " <> e2eeInfoNoPQStr), + "#club bob> connected", "#club cath> connected", "#club bob> added dan (Daniel)", "#club dan> connected", @@ -1858,7 +1860,7 @@ testGroupLink = bob <## "#team: you joined the group" ] threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "invited via your group link"), (0, "connected")]) -- contacts connected via group link are not in chat previews alice @@@ [("#team", "connected")] bob @@@ [("#team", "connected")] @@ -2697,7 +2699,7 @@ testGroupLinkNoContact = ] threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, [(1, "Recent history: off"), (0, "invited via your group link"), (0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (1, "Recent history: off"), (0, "invited via your group link"), (0, "connected")]) alice @@@ [("#team", "connected")] bob @@@ [("#team", "connected")] @@ -2760,7 +2762,7 @@ testGroupLinkNoContactInviteesWereConnected = ] threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, [(1, "Recent history: off"), (0, "invited via your group link"), (0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (1, "Recent history: off"), (0, "invited via your group link"), (0, "connected")]) alice @@@ [("#team", "connected")] bob @@@ [("#team", "connected"), ("@cath", "hey")] @@ -2841,7 +2843,7 @@ testGroupLinkNoContactAllMembersWereConnected = ] threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, [(1, "Recent history: off"), (0, "invited via your group link"), (0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (1, "Recent history: off"), (0, "invited via your group link"), (0, "connected")]) alice @@@ [("#team", "connected"), ("@bob", "hey"), ("@cath", "hey")] bob @@@ [("#team", "connected"), ("@alice", "hey"), ("@cath", "hey")] @@ -2996,7 +2998,7 @@ testGroupLinkNoContactHostIncognito = ] threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "invited via your group link"), (0, "connected")]) alice @@@ [("#team", "connected")] bob @@@ [("#team", "connected")] @@ -3029,7 +3031,7 @@ testGroupLinkNoContactInviteeIncognito = ] threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "invited via your group link"), (0, "connected")]) alice @@@ [("#team", "connected")] bob @@@ [("#team", "connected")] @@ -3096,7 +3098,7 @@ testGroupLinkNoContactExistingContactMerged = ] threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "invited via your group link"), (0, "connected")]) alice <##> bob @@ -3579,11 +3581,11 @@ testConfigureGroupDeliveryReceipts tmp = cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg) cc1 VersionRange -> VersionRange -> VersionRange -> Bool -> FilePath -> IO () +testNoGroupDirectConns :: HasCallStack => VersionRangeChat -> VersionRangeChat -> VersionRangeChat -> Bool -> FilePath -> IO () testNoGroupDirectConns hostVRange mem2VRange mem3VRange noDirectConns tmp = - withNewTestChatCfg tmp testCfg {chatVRange = hostVRange} "alice" aliceProfile $ \alice -> do - withNewTestChatCfg tmp testCfg {chatVRange = mem2VRange} "bob" bobProfile $ \bob -> do - withNewTestChatCfg tmp testCfg {chatVRange = mem3VRange} "cath" cathProfile $ \cath -> do + withNewTestChatCfg tmp testCfg {chatVRange = const hostVRange} "alice" aliceProfile $ \alice -> do + withNewTestChatCfg tmp testCfg {chatVRange = const mem2VRange} "bob" bobProfile $ \bob -> do + withNewTestChatCfg tmp testCfg {chatVRange = const mem3VRange} "cath" cathProfile $ \cath -> do createGroup3 "team" alice bob cath if noDirectConns then contactsDontExist bob cath @@ -5050,8 +5052,7 @@ testGroupHistoryDeletedMessage = testGroupHistoryDisappearingMessage :: HasCallStack => FilePath -> IO () testGroupHistoryDisappearingMessage = testChat3 aliceProfile bobProfile cathProfile $ - -- \alice bob cath -> do -- revert when test is stable - \a b c -> withTestOutput a $ \alice -> withTestOutput b $ \bob -> withTestOutput c $ \cath -> do + \alice bob cath -> do createGroup2 "team" alice bob threadDelay 1000000 diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 30c78138ad..7996fde3ad 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -1509,7 +1509,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $ alice ##> "/_set prefs @2 {}" alice <## "your preferences for bob did not change" (bob ("/_get chat @2 count=100", chat, startFeatures) bob #$> ("/_get chat @2 count=100", chat, startFeatures) let sendVoice = "/_send @2 json {\"filePath\": \"test.txt\", \"msgContent\": {\"type\": \"voice\", \"text\": \"\", \"duration\": 10}}" @@ -1608,13 +1608,13 @@ testUpdateGroupPrefs = testChat2 aliceProfile bobProfile $ \alice bob -> do createGroup2 "team" alice bob - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected")]) threadDelay 500000 bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected")]) alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}" alice <## "updated group preferences:" alice <## "Full deletion: on" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Full deletion: on")]) bob <## "alice updated group #team:" bob <## "updated group preferences:" bob <## "Full deletion: on" @@ -1624,7 +1624,7 @@ testUpdateGroupPrefs = alice <## "updated group preferences:" alice <## "Full deletion: off" alice <## "Voice messages: off" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off")]) bob <## "alice updated group #team:" bob <## "updated group preferences:" bob <## "Full deletion: off" @@ -1634,7 +1634,7 @@ testUpdateGroupPrefs = alice ##> "/set voice #team on" alice <## "updated group preferences:" alice <## "Voice messages: on" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")]) bob <## "alice updated group #team:" bob <## "updated group preferences:" bob <## "Voice messages: on" @@ -1644,14 +1644,14 @@ testUpdateGroupPrefs = alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}" -- no update threadDelay 500000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")]) alice #> "#team hey" bob <# "#team alice> hey" threadDelay 1000000 bob #> "#team hi" alice <# "#team bob> hi" threadDelay 500000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on"), (1, "hey"), (0, "hi")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on"), (1, "hey"), (0, "hi")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off"), (0, "Voice messages: on"), (0, "hey"), (1, "hi")]) testAllowFullDeletionContact :: HasCallStack => FilePath -> IO () @@ -1677,7 +1677,7 @@ testAllowFullDeletionGroup = testChat2 aliceProfile bobProfile $ \alice bob -> do createGroup2 "team" alice bob - threadDelay 1000000 + threadDelay 1500000 alice #> "#team hi" bob <# "#team alice> hi" threadDelay 1000000 @@ -1691,11 +1691,11 @@ testAllowFullDeletionGroup = bob <## "alice updated group #team:" bob <## "updated group preferences:" bob <## "Full deletion: on" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "hi"), (0, "hey"), (1, "Full deletion: on")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "hi"), (0, "hey"), (1, "Full deletion: on")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "hi"), (1, "hey"), (0, "Full deletion: on")]) bob #$> ("/_delete item #1 " <> msgItemId <> " broadcast", id, "message deleted") alice <# "#team bob> [deleted] hey" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "hi"), (1, "Full deletion: on")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "hi"), (1, "Full deletion: on")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "hi"), (0, "Full deletion: on")]) testProhibitDirectMessages :: HasCallStack => FilePath -> IO () @@ -1817,12 +1817,12 @@ testEnableTimedMessagesGroup = alice #> "#team hi" bob <# "#team alice> hi" threadDelay 500000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "hi")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "hi")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "hi")]) threadDelay 1000000 alice <## "timed message deleted: hi" bob <## "timed message deleted: hi" - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on (1 sec)")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Disappearing messages: on (1 sec)")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)")]) -- turn off, messages are not disappearing alice ##> "/set disappear #team off" @@ -1835,7 +1835,7 @@ testEnableTimedMessagesGroup = alice #> "#team hey" bob <# "#team alice> hey" threadDelay 1500000 - alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "Disappearing messages: off"), (1, "hey")]) + alice #$> ("/_get chat #1 count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "Disappearing messages: off"), (1, "hey")]) bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "Disappearing messages: off"), (0, "hey")]) -- test api alice ##> "/set disappear #team on 30s" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index b7cf46766a..3b0748e7d0 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} module ChatTests.Utils where @@ -12,6 +13,8 @@ import Control.Concurrent.Async (concurrently_) import Control.Concurrent.STM import Control.Monad (unless, when) import Control.Monad.Except (runExceptT) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as B import Data.Char (isDigit) import Data.List (isPrefixOf, isSuffixOf) @@ -20,7 +23,9 @@ import Data.String import qualified Data.Text as T import Database.SQLite.Simple (Only (..)) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..)) +import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText, e2eInfoPQText) import Simplex.Chat.Protocol +import Simplex.Chat.Store.Direct (getContact) import Simplex.Chat.Store.NoteFolders (createNoteFolder) import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Types @@ -28,6 +33,8 @@ import Simplex.Chat.Types.Preferences import Simplex.FileTransfer.Client.Main (xftpClientCLI) import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB +import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Version import System.Directory (doesFileExist) @@ -76,6 +83,9 @@ ifCI xrun run d t = do ci <- runIO $ lookupEnv "CI" (if ci == Just "true" then xrun else run) d t +skip :: String -> SpecWith a -> SpecWith a +skip = before_ . pendingWith + versionTestMatrix2 :: (HasCallStack => TestCC -> TestCC -> IO ()) -> SpecWith FilePath versionTestMatrix2 runTest = do it "current" $ testChat2 aliceProfile bobProfile runTest @@ -108,6 +118,34 @@ runTestCfg3 aliceCfg bobCfg cathCfg runTest tmp = withNewTestChatCfg tmp cathCfg "cath" cathProfile $ \cath -> runTest alice bob cath +type PQEnabled = Bool + +pqMatrix2 :: (HasCallStack => (TestCC, PQEnabled) -> (TestCC, PQEnabled) -> IO ()) -> SpecWith FilePath +pqMatrix2 runTest = do + it "PQ: off, off" $ test False False + it "PQ: on, off" $ test False True + it "PQ: off, on" $ test True False + it "PQ: on, on" $ test True True + where + test aPQ bPQ = testChat2 aliceProfile bobProfile $ \a b -> runTest (a, aPQ) (b, bPQ) + +pqVersionTestMatrix2 :: (HasCallStack => TestCC -> TestCC -> Bool -> VersionChat -> IO ()) -> SpecWith FilePath +pqVersionTestMatrix2 runTest = do + it "current" $ testChat2 aliceProfile bobProfile (runTest' True pqEncryptionCompressionVersion) + it "prev" $ testChatCfg2 testCfgVPrev aliceProfile bobProfile (runTest' False (VersionChat 6)) + it "prev to curr" $ runTestCfg2 testCfg testCfgVPrev (runTest' False (VersionChat 6)) + it "curr to prev" $ runTestCfg2 testCfgVPrev testCfg (runTest' False (VersionChat 6)) + it "old (1st supported)" $ testChatCfg2 testCfgV1 aliceProfile bobProfile (runTest' False (VersionChat 1)) + it "old to curr" $ runTestCfg2 testCfg testCfgV1 (runTest' False (VersionChat 1)) + it "curr to old" $ runTestCfg2 testCfgV1 testCfg (runTest' False (VersionChat 1)) + it "next" $ testChatCfg2 testCfgVNext aliceProfile bobProfile (runTest' True pqEncryptionCompressionVersion) + it "next to curr" $ runTestCfg2 testCfg testCfgVNext (runTest' True pqEncryptionCompressionVersion) + it "curr to next" $ runTestCfg2 testCfgVNext testCfg (runTest' True pqEncryptionCompressionVersion) + it "next to prev" $ runTestCfg2 testCfgVPrev testCfgVNext (runTest' False (VersionChat 6)) + it "prev to next" $ runTestCfg2 testCfgVNext testCfgVPrev (runTest' False (VersionChat 6)) + where + runTest' pqExpected v a b = runTest a b pqExpected v + withTestChatGroup3Connected :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a withTestChatGroup3Connected tmp dbPrefix action = do withTestChat tmp dbPrefix $ \cc -> do @@ -166,6 +204,65 @@ cc #$> (cmd, f, res) = do cc ##> cmd (f <$> getTermLine cc) `shouldReturn` res +-- / PQ combinators + +(\#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO () +(\#>) = sndRcv PQEncOff False + +(+#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO () +(+#>) = sndRcv PQEncOn False + +(++#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO () +(++#>) = sndRcv PQEncOn True + +sndRcv :: HasCallStack => PQEncryption -> Bool -> (TestCC, String) -> TestCC -> IO () +sndRcv pqEnc enabled (cc1, msg) cc2 = do + name1 <- userName cc1 + name2 <- userName cc2 + let cmd = "@" <> name2 <> " " <> msg + cc1 `send` cmd + when enabled $ cc1 <## (name2 <> ": quantum resistant end-to-end encryption enabled") + cc1 <# cmd + cc1 `pqSndForContact` 2 `shouldReturn` pqEnc + when enabled $ cc2 <## (name1 <> ": quantum resistant end-to-end encryption enabled") + cc2 <# (name1 <> "> " <> msg) + cc2 `pqRcvForContact` 2 `shouldReturn` pqEnc + +(\:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () +(\:#>) = sndRcvImg PQEncOff False + +(+:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () +(+:#>) = sndRcvImg PQEncOn False + +(++:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () +(++:#>) = sndRcvImg PQEncOn True + +sndRcvImg :: HasCallStack => PQEncryption -> Bool -> (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () +sndRcvImg pqEnc enabled (cc1, msg, v1) (cc2, v2) = do + name1 <- userName cc1 + name2 <- userName cc2 + g <- C.newRandom + img <- atomically $ B64.encode <$> C.randomBytes lrgLen g + cc1 `send` ("/_send @2 json {\"msgContent\":{\"type\":\"image\",\"text\":\"" <> msg <> "\",\"image\":\"" <> B.unpack img <> "\"}}") + cc1 .<## "}}" + cc1 <### ([ConsoleString (name2 <> ": quantum resistant end-to-end encryption enabled") | enabled] <> [WithTime ("@" <> name2 <> " " <> msg)]) + cc1 `pqSndForContact` 2 `shouldReturn` pqEnc + cc1 `pqVerForContact` 2 `shouldReturn` v1 + cc2 <### ([ConsoleString (name1 <> ": quantum resistant end-to-end encryption enabled") | enabled] <> [WithTime (name1 <> "> " <> msg)]) + cc2 `pqRcvForContact` 2 `shouldReturn` pqEnc + cc2 `pqVerForContact` 2 `shouldReturn` v2 + where + lrgLen = maxEncodedMsgLength * 3 `div` 4 - 110 -- 98 is ~ max size for binary image preview given the rest of the message + +genProfileImg :: IO ByteString +genProfileImg = do + g <- C.newRandom + atomically $ B64.encode <$> C.randomBytes lrgLen g + where + lrgLen = maxEncodedInfoLength * 3 `div` 4 - 420 + +-- PQ combinators / + chat :: String -> [(Int, String)] chat = map (\(a, _, _) -> a) . chat'' @@ -189,13 +286,20 @@ chatFeaturesF = map (\(a, _, c) -> (a, c)) chatFeatures'' chatFeatures'' :: [((Int, String), Maybe (Int, String), Maybe String)] chatFeatures'' = - [ ((0, "Disappearing messages: allowed"), Nothing, Nothing), + [ ((0, e2eeInfoNoPQStr), Nothing, Nothing), + ((0, "Disappearing messages: allowed"), Nothing, Nothing), ((0, "Full deletion: off"), Nothing, Nothing), ((0, "Message reactions: enabled"), Nothing, Nothing), ((0, "Voice messages: enabled"), Nothing, Nothing), ((0, "Audio/video calls: enabled"), Nothing, Nothing) ] +e2eeInfoNoPQStr :: String +e2eeInfoNoPQStr = T.unpack e2eInfoNoPQText + +e2eeInfoPQStr :: String +e2eeInfoPQStr = T.unpack e2eInfoPQText + lastChatFeature :: String lastChatFeature = snd $ last chatFeatures @@ -204,7 +308,8 @@ groupFeatures = map (\(a, _, _) -> a) groupFeatures'' groupFeatures'' :: [((Int, String), Maybe (Int, String), Maybe String)] groupFeatures'' = - [ ((0, "Disappearing messages: off"), Nothing, Nothing), + [ ((0, e2eeInfoNoPQStr), Nothing, Nothing), + ((0, "Disappearing messages: off"), Nothing, Nothing), ((0, "Direct messages: on"), Nothing, Nothing), ((0, "Full deletion: off"), Nothing, Nothing), ((0, "Message reactions: on"), Nothing, Nothing), @@ -465,6 +570,34 @@ getProfilePictureByName cc displayName = maybeFirstRow fromOnly $ DB.query db "SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName) +pqSndForContact :: TestCC -> ContactId -> IO PQEncryption +pqSndForContact = pqForContact_ pqSndEnabled PQEncOff + +pqRcvForContact :: TestCC -> ContactId -> IO PQEncryption +pqRcvForContact = pqForContact_ pqRcvEnabled PQEncOff + +pqForContact :: TestCC -> ContactId -> IO PQEncryption +pqForContact = pqForContact_ (Just . connPQEnabled) (error "impossible") + +pqSupportForCt :: TestCC -> ContactId -> IO PQSupport +pqSupportForCt = pqForContact_ (\Connection {pqSupport} -> Just pqSupport) PQSupportOff + +pqVerForContact :: TestCC -> ContactId -> IO VersionChat +pqVerForContact = pqForContact_ (Just . connChatVersion) (error "impossible") + +pqForContact_ :: (Connection -> Maybe a) -> a -> TestCC -> ContactId -> IO a +pqForContact_ pqSel def cc contactId = (fromMaybe def . pqSel) <$> getCtConn cc contactId + +getCtConn :: TestCC -> ContactId -> IO Connection +getCtConn cc contactId = getTestCCContact cc contactId >>= maybe (fail "no connection") pure . contactConn + +getTestCCContact :: TestCC -> ContactId -> IO Contact +getTestCCContact cc contactId = do + let TestCC {chatController = ChatController {config = ChatConfig {chatVRange = vr}}} = cc + withCCTransaction cc $ \db -> + withCCUser cc $ \user -> + runExceptT (getContact db vr user contactId) >>= either (fail . show) pure + lastItemId :: HasCallStack => TestCC -> IO String lastItemId cc = do cc ##> "/last_item_id" @@ -573,9 +706,9 @@ checkActionDeletesFile file action = do currentChatVRangeInfo :: String currentChatVRangeInfo = - "peer chat protocol version range: " <> vRangeStr supportedChatVRange + "peer chat protocol version range: " <> vRangeStr (supportedChatVRange PQSupportOff) -vRangeStr :: VersionRange -> String +vRangeStr :: VersionRange v -> String vRangeStr (VersionRange minVer maxVer) = "(" <> show minVer <> ", " <> show maxVer <> ")" linkAnotherSchema :: String -> String diff --git a/tests/MessageBatching.hs b/tests/MessageBatching.hs index 1a9d968718..54a0ae4f1c 100644 --- a/tests/MessageBatching.hs +++ b/tests/MessageBatching.hs @@ -17,7 +17,7 @@ import Data.Text.Encoding (encodeUtf8) import Simplex.Chat.Messages.Batch import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..)) import Simplex.Chat.Messages (SndMessage (..)) -import Simplex.Chat.Protocol (SharedMsgId (..), maxChatMsgSize) +import Simplex.Chat.Protocol (SharedMsgId (..), maxEncodedMsgLength) import Test.Hspec batchingTests :: Spec @@ -99,7 +99,7 @@ testImageFitsSingleBatch = do msg s = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = s} batched = "[" <> xMsgNewStr <> "," <> descrStr <> "]" - runBatcherTest' maxChatMsgSize [msg xMsgNewStr, msg descrStr] [] [batched] + runBatcherTest' maxEncodedMsgLength [msg xMsgNewStr, msg descrStr] [] [batched] runBatcherTest :: Int -> [SndMessage] -> [ChatError] -> [ByteString] -> Spec runBatcherTest maxLen msgs expectedErrors expectedBatches = diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index c076ebecfc..082af825e5 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} module ProtocolTests where @@ -39,7 +40,7 @@ connReqData :: ConnReqUriData connReqData = ConnReqUriData { crScheme = SSSimplex, - crAgentVRange = mkVersionRange 1 1, + crAgentVRange = mkVersionRange (VersionSMPA 1) (VersionSMPA 1), crSmpQueues = [queue], crClientData = Nothing } @@ -47,8 +48,8 @@ connReqData = testDhPubKey :: C.PublicKeyX448 testDhPubKey = "MEIwBQYDK2VvAzkAmKuSYeQ/m0SixPDS8Wq8VBaTS1cW+Lp0n0h4Diu+kUpR+qXx4SDJ32YGEFoGFGSbGPry5Ychr6U=" -testE2ERatchetParams :: E2ERatchetParamsUri 'C.X448 -testE2ERatchetParams = E2ERatchetParamsUri supportedE2EEncryptVRange testDhPubKey testDhPubKey +testE2ERatchetParams :: RcvE2ERatchetParamsUri 'C.X448 +testE2ERatchetParams = E2ERatchetParamsUri (supportedE2EEncryptVRange PQSupportOn) testDhPubKey testDhPubKey Nothing testConnReq :: ConnectionRequestUri 'CMInvitation testConnReq = CRInvitationUri connReqData testE2ERatchetParams @@ -71,12 +72,12 @@ s ==## msg = do (##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation s ##== msg = do - let r = encodeChatMessage msg + let r = encodeChatMessage maxEncodedMsgLength msg case r of ECMEncoded encodedBody -> J.eitherDecodeStrict' encodedBody `shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value) - ECMLarge -> expectationFailure $ "large message" + ECMLarge -> expectationFailure "large message" (##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation s ##==## msg = do @@ -131,7 +132,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) it "x.msg.new chat message with chat version range" $ "{\"v\":\"1-7\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" - ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) + ##==## ChatMessage (supportedChatVRange PQSupportOff) (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing))) it "x.msg.new quote" $ "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}" ##==## ChatMessage @@ -192,7 +193,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"1\",\"event\":\"x.msg.deleted\",\"params\":{}}" #==# XMsgDeleted it "x.file" $ - "{\"v\":\"1\",\"event\":\"x.file\",\"params\":{\"file\":{\"fileConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" + "{\"v\":\"1\",\"event\":\"x.file\",\"params\":{\"file\":{\"fileConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" #==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Just testConnReq, fileInline = Nothing, fileDescr = Nothing} it "x.file without file invitation" $ "{\"v\":\"1\",\"event\":\"x.file\",\"params\":{\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" @@ -201,7 +202,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"1\",\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}" #==# XFileAcpt "photo.jpg" it "x.file.acpt.inv" $ - "{\"v\":\"1\",\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\",\"fileConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}" + "{\"v\":\"1\",\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\",\"fileConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}" #==# XFileAcptInv (SharedMsgId "\1\2\3\4") (Just testConnReq) "photo.jpg" it "x.file.acpt.inv" $ "{\"v\":\"1\",\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\"}}" @@ -228,11 +229,11 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"1\",\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" ==# XContact testProfile Nothing it "x.grp.inv" $ - "{\"v\":\"1\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" - #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Nothing} + "{\"v\":\"1\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" + #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Nothing, groupSize = Nothing} it "x.grp.inv with group link id" $ - "{\"v\":\"1\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}, \"groupLinkId\":\"AQIDBA==\"}}}" - #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Just $ GroupLinkId "\1\2\3\4"} + "{\"v\":\"1\",\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"reactions\":{\"enable\":\"on\"},\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}, \"groupLinkId\":\"AQIDBA==\"}}}" + #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Just $ GroupLinkId "\1\2\3\4", groupSize = Nothing} it "x.grp.acpt without incognito profile" $ "{\"v\":\"1\",\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpAcpt (MemberId "\1\2\3\4") @@ -241,28 +242,28 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} it "x.grp.mem.new with member chat version range" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" - #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} + #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQSupportOff, profile = testProfile} it "x.grp.mem.intro" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} Nothing it "x.grp.mem.intro with member chat version range" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" - #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} Nothing + #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQSupportOff, profile = testProfile} Nothing it "x.grp.mem.intro with member restrictions" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberRestrictions\":{\"restriction\":\"blocked\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} (Just MemberRestrictions {restriction = MRSBlocked}) it "x.grp.mem.inv" $ - "{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" + "{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq} it "x.grp.mem.inv w/t directConnReq" $ - "{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" + "{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing} it "x.grp.mem.fwd" $ - "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq} it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $ - "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" - #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing} + "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}" + #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQSupportOff, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing} it "x.grp.mem.info" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}" #==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile @@ -282,10 +283,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"v\":\"1\",\"event\":\"x.grp.del\",\"params\":{}}" ==# XGrpDel it "x.grp.direct.inv" $ - "{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" + "{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XGrpDirectInv testConnReq (Just $ MCText "hello") it "x.grp.direct.inv without content" $ - "{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}" + "{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}" #==# XGrpDirectInv testConnReq Nothing -- it "x.grp.msg.forward" -- $ "{\"v\":\"1\",\"event\":\"x.grp.msg.forward\",\"params\":{\"msgForward\":{\"memberId\":\"AQIDBA==\",\"msg\":\"{\"v\":\"1\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}\",\"msgTs\":\"1970-01-01T00:00:01.000000001Z\"}}}"