dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-07-11 18:28:52 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #3858 from simplex-chat/pq

Browse Source 
core: post-quantum encryption support
This commit is contained in:
Evgeny Poberezkin
2024-03-11 08:28:36 +00:00
committed by GitHub
parent 7fb3c4abdb 0e7d81681f
commit eaf720a0f2
45 changed files with 2261 additions and 911 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.github/workflows/build.yml
+1 -1
View File
@@ -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
apps/ios/Shared/Model/SimpleXAPI.swift
+19
View File
@@ -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)")
}
apps/ios/Shared/Views/Chat/ChatInfoView.swift
+57
View File
@@ -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 {
apps/ios/Shared/Views/Chat/ChatItemView.swift
+5
View File
@@ -111,6 +111,11 @@ struct ChatItemContentView<Content: View>: 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))
}
}
apps/ios/Shared/Views/UserSettings/DeveloperView.swift
+25
View File
@@ -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 {
apps/ios/SimpleX.xcodeproj/project.pbxproj
+20 -20
View File
@@ -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 = "<group>"; };
5C7505A727B6D34800BE3227 /* ChatInfoToolbar.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatInfoToolbar.swift; sourceTree = "<group>"; };
5C764E88279CBCB3000C6508 /* ChatModel.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatModel.swift; sourceTree = "<group>"; };
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 = "<group>"; };
5C777BE82B9D21A900C72EFF /* libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.5.6.0-9o3DFFEYPI8LImicClpr6N.a"; sourceTree = "<group>"; };
5C777BE92B9D21A900C72EFF /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
5C777BEA2B9D21A900C72EFF /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
5C777BEB2B9D21A900C72EFF /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
5C777BD32B99B38B00C72EFF /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
5C777BD42B99B38B00C72EFF /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
5C777BD52B99B38B00C72EFF /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
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 = "<group>"; };
5C777BD72B99B38B00C72EFF /* libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.5.6.0-AiwFoGVZWFALIHlLc8SJrg.a"; sourceTree = "<group>"; };
5C84FE9129A216C800D95B1A /* nl */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = nl; path = nl.lproj/Localizable.strings; sourceTree = "<group>"; };
5C84FE9329A2179C00D95B1A /* nl */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = nl; path = "nl.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = "<group>"; };
5C84FE9429A2179C00D95B1A /* nl */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = nl; path = nl.lproj/InfoPlist.strings; sourceTree = "<group>"; };
@@ -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 = "<group>";
apps/ios/SimpleXChat/APITypes.swift
+13
View File
@@ -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))
apps/ios/SimpleXChat/AppGroup.swift
+4
View File
@@ -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
apps/ios/SimpleXChat/ChatTypes.swift
+53 -3
View File
@@ -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")
}
}
}
}
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt
+46 -1
View File
@@ -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<MsgContent> {
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)
}
}
}
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+29
View File
@@ -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<UpMigration>, val agentMigrations: List<UpMigration>): 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 })}"
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/platform/Core.kt
+1
View File
@@ -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)
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatInfoView.kt
+50
View File
@@ -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 = {},
)
}
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/item/ChatItemView.kt
+5
View File
@@ -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)
}
}
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/DeveloperView.kt
+8
View File
@@ -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()
}
apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml
+5
View File
@@ -54,6 +54,9 @@
<string name="decryption_error">Decryption error</string>
<string name="encryption_renegotiation_error">Encryption re-negotiation error</string>
<string name="e2ee_info_no_pq">This conversation is protected by end-to-end encryption with perfect forward secrecy, repudiation and break-in recovery.</string>
<string name="e2ee_info_pq">This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery.</string>
<!-- NoteFolder - ChatModel.kt -->
<string name="note_folder_local_display_name">Private notes</string>
@@ -1239,6 +1242,8 @@
<string name="snd_conn_event_ratchet_sync_started">agreeing encryption for %s…</string>
<string name="snd_conn_event_ratchet_sync_agreed">encryption agreed for %s</string>
<string name="rcv_conn_event_verification_code_reset">security code changed</string>
<string name="conn_event_enabled_pq">quantum resistant e2e encryption</string>
<string name="conn_event_disabled_pq">standard end-to-end encryption</string>
<!-- GroupMemberRole -->
<string name="group_member_role_observer">observer</string>
cabal.project
+1 -1
View File
@@ -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
scripts/nix/sha256map.nix
+1 -1
View File
@@ -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";
simplex-chat.cabal
+1
View File
@@ -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
src/Simplex/Chat.hs
+618 -392
View File
File diff suppressed because it is too large Load Diff
src/Simplex/Chat/Controller.hs
+9 -3
View File
@@ -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}
src/Simplex/Chat/Help.hs
+3
View File
@@ -185,6 +185,8 @@ contactsHelpInfo =
indent <> highlight "/verify @<name> " <> " - clear security code verification",
indent <> highlight "/info @<name> " <> " - info about contact connection",
indent <> highlight "/switch @<name> " <> " - switch receiving messages to another SMP relay",
indent <> highlight "/pq @<name> 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 @<name> 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",
src/Simplex/Chat/Messages/CIContent.hs
+68
View File
@@ -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"
src/Simplex/Chat/Messages/CIContent/Events.hs
+3
View File
@@ -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
src/Simplex/Chat/Migrations/M20240228_pq.hs
+30
View File
@@ -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;
|]
src/Simplex/Chat/Migrations/chat_schema.sql
+6
View File
@@ -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
src/Simplex/Chat/Protocol.hs
+76 -27
View File
@@ -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 =
src/Simplex/Chat/Store/Connections.hs
+9 -8
View File
@@ -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
src/Simplex/Chat/Store/Direct.hs
+80 -66
View File
@@ -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 = ?
|]
src/Simplex/Chat/Store/Files.hs
+19 -17
View File
@@ -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
src/Simplex/Chat/Store/Groups.hs
+214 -150
View File
@@ -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 =
src/Simplex/Chat/Store/Messages.hs
+22 -22
View File
@@ -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
src/Simplex/Chat/Store/Migrations.hs
+3 -1
View File
@@ -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
src/Simplex/Chat/Store/Profiles.hs
+18 -14
View File
@@ -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
src/Simplex/Chat/Store/Shared.hs
+122 -30
View File
@@ -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 =
src/Simplex/Chat/Types.hs
+58 -28
View File
@@ -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)
src/Simplex/Chat/View.hs
+8 -4
View File
@@ -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} =
tests/ChatClient.hs
+53 -20
View File
@@ -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
tests/ChatTests/ChatList.hs
+9 -9
View File
@@ -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}"
tests/ChatTests/Direct.hs
+292 -31
View File
@@ -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 <// 50000
testConnInvChatVRange :: HasCallStack => 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
tests/ChatTests/Groups.hs
+23 -22
View File
@@ -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 <// 50000
testNoGroupDirectConns :: HasCallStack => 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
tests/ChatTests/Profiles.hs
+13 -13
View File
@@ -1509,7 +1509,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
alice ##> "/_set prefs @2 {}"
alice <## "your preferences for bob did not change"
(bob </)
let startFeatures = [(0, "Disappearing messages: allowed"), (0, "Full deletion: off"), (0, "Message reactions: enabled"), (0, "Voice messages: off"), (0, "Audio/video calls: enabled")]
let startFeatures = [(0, e2eeInfoNoPQStr), (0, "Disappearing messages: allowed"), (0, "Full deletion: off"), (0, "Message reactions: enabled"), (0, "Voice messages: off"), (0, "Audio/video calls: enabled")]
alice #$> ("/_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"
tests/ChatTests/Utils.hs
+137 -4
View File
@@ -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
tests/MessageBatching.hs
+2 -2
View File
@@ -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 =
tests/ProtocolTests.hs
+22 -21
View File
@@ -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\"}}}"