dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-13 23:43:26 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into ep/forward-api

Browse Source
This commit is contained in:
spaced4ndy
2024-04-05 11:03:16 +04:00
parent 4d68fd81b0 18efc28d16
commit c72ff21bf2
55 changed files with 892 additions and 385 deletions
Download Patch File Download Diff File Expand all files Collapse all files
apps/ios/Shared/Views/Chat/ChatItem/CIImageView.swift
+2 -2
View File
@@ -70,14 +70,14 @@ struct CIImageView: View {
}
private func imageView(_ img: UIImage) -> some View {
let w = img.size.width <= img.size.height ? maxWidth * 0.75 : img.imageData == nil ? .infinity : maxWidth
let w = img.size.width <= img.size.height ? maxWidth * 0.75 : maxWidth
DispatchQueue.main.async { imgWidth = w }
return ZStack(alignment: .topTrailing) {
if img.imageData == nil {
Image(uiImage: img)
.resizable()
.scaledToFit()
.frame(maxWidth: w)
.frame(width: w)
} else {
SwiftyGif(image: img)
.frame(width: w, height: w * img.size.height / img.size.width)
apps/ios/Shared/Views/Chat/ChatItem/CIVideoView.swift
+2 -2
View File
@@ -243,13 +243,13 @@ struct CIVideoView: View {
}
private func imageView(_ img: UIImage) -> some View {
let w = img.size.width <= img.size.height ? maxWidth * 0.75 : .infinity
let w = img.size.width <= img.size.height ? maxWidth * 0.75 : maxWidth
DispatchQueue.main.async { videoWidth = w }
return ZStack(alignment: .topTrailing) {
Image(uiImage: img)
.resizable()
.scaledToFit()
.frame(maxWidth: w)
.frame(width: w)
loadingIndicator()
}
}
apps/ios/Shared/Views/Chat/ChatView.swift
+3 -1
View File
@@ -514,6 +514,7 @@ struct ChatView: View {
chat: chat,
chatItem: ci,
maxWidth: maxWidth,
itemWidth: maxWidth,
composeState: $composeState,
selectedMember: $selectedMember,
chatView: self
@@ -526,6 +527,7 @@ struct ChatView: View {
@ObservedObject var chat: Chat
var chatItem: ChatItem
var maxWidth: CGFloat
@State var itemWidth: CGFloat
@Binding var composeState: ComposeState
@Binding var selectedMember: GMember?
var chatView: ChatView
@@ -654,7 +656,7 @@ struct ChatView: View {
playbackState: $playbackState,
playbackTime: $playbackTime
)
.uiKitContextMenu(maxWidth: maxWidth, menu: uiMenu, allowMenu: $allowMenu)
.uiKitContextMenu(hasImageOrVideo: ci.content.msgContent?.isImageOrVideo == true, maxWidth: maxWidth, itemWidth: $itemWidth, menu: uiMenu, allowMenu: $allowMenu)
.accessibilityLabel("")
if ci.content.msgContent != nil && (ci.meta.itemDeleted == nil || revealed) && ci.reactions.count > 0 {
chatItemReactions(ci)
apps/ios/Shared/Views/Helpers/ContextMenu.swift
+19 -5
View File
@@ -11,11 +11,20 @@ import UIKit
import SwiftUI
extension View {
func uiKitContextMenu(maxWidth: CGFloat, menu: Binding<UIMenu>, allowMenu: Binding<Bool>) -> some View {
func uiKitContextMenu(hasImageOrVideo: Bool, maxWidth: CGFloat, itemWidth: Binding<CGFloat>, menu: Binding<UIMenu>, allowMenu: Binding<Bool>) -> some View {
Group {
if allowMenu.wrappedValue {
InteractionView(content: self, maxWidth: maxWidth, menu: menu)
.fixedSize(horizontal: true, vertical: false)
if hasImageOrVideo {
InteractionView(content:
self.environmentObject(ChatModel.shared)
.overlay(DetermineWidthImageVideoItem())
.onPreferenceChange(DetermineWidthImageVideoItem.Key.self) { itemWidth.wrappedValue = $0 == 0 ? maxWidth : $0 }
, maxWidth: maxWidth, itemWidth: itemWidth, menu: menu)
.frame(maxWidth: itemWidth.wrappedValue)
} else {
InteractionView(content: self.environmentObject(ChatModel.shared), maxWidth: maxWidth, itemWidth: itemWidth, menu: menu)
.fixedSize(horizontal: true, vertical: false)
}
} else {
self
}
@@ -31,13 +40,14 @@ private class HostingViewHolder: UIView {
struct InteractionView<Content: View>: UIViewRepresentable {
let content: Content
var maxWidth: CGFloat
var itemWidth: Binding<CGFloat>
@Binding var menu: UIMenu
func makeUIView(context: Context) -> UIView {
let view = HostingViewHolder()
view.contentSize = CGSizeMake(maxWidth, .infinity)
view.backgroundColor = .clear
let hostView = UIHostingController(rootView: content)
view.contentSize = hostView.view.intrinsicContentSize
hostView.view.translatesAutoresizingMaskIntoConstraints = false
let constraints = [
hostView.view.topAnchor.constraint(equalTo: view.topAnchor),
@@ -57,7 +67,11 @@ struct InteractionView<Content: View>: UIViewRepresentable {
}
func updateUIView(_ uiView: UIView, context: Context) {
(uiView as! HostingViewHolder).contentSize = uiView.subviews[0].sizeThatFits(CGSizeMake(maxWidth, .infinity))
let was = (uiView as! HostingViewHolder).contentSize
(uiView as! HostingViewHolder).contentSize = uiView.subviews[0].sizeThatFits(CGSizeMake(itemWidth.wrappedValue, .infinity))
if was != (uiView as! HostingViewHolder).contentSize {
uiView.invalidateIntrinsicContentSize()
}
}
func makeCoordinator() -> Coordinator {
apps/ios/Shared/Views/Helpers/DetermineWidth.swift
+20
View File
@@ -21,6 +21,19 @@ struct DetermineWidth: View {
}
}
struct DetermineWidthImageVideoItem: View {
typealias Key = MaximumWidthImageVideoPreferenceKey
var body: some View {
GeometryReader { proxy in
Color.clear
.preference(
key: MaximumWidthImageVideoPreferenceKey.self,
value: proxy.size.width
)
}
}
}
struct MaximumWidthPreferenceKey: PreferenceKey {
static var defaultValue: CGFloat = 0
static func reduce(value: inout CGFloat, nextValue: () -> CGFloat) {
@@ -28,6 +41,13 @@ struct MaximumWidthPreferenceKey: PreferenceKey {
}
}
struct MaximumWidthImageVideoPreferenceKey: PreferenceKey {
static var defaultValue: CGFloat = 0
static func reduce(value: inout CGFloat, nextValue: () -> CGFloat) {
value = max(value, nextValue())
}
}
struct DetermineWidth_Previews: PreviewProvider {
static var previews: some View {
DetermineWidth()
apps/ios/SimpleX.xcodeproj/project.pbxproj
+32 -32
View File
@@ -111,6 +111,11 @@
5CC2C0FC2809BF11000C35E3 /* Localizable.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CC2C0FA2809BF11000C35E3 /* Localizable.strings */; };
5CC2C0FF2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CC2C0FD2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings */; };
5CC868F329EB540C0017BBFD /* CIRcvDecryptionError.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */; };
5CC932F52BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC932F02BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto-ghc9.6.3.a */; };
5CC932F62BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC932F12BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto.a */; };
5CC932F72BBDD9FA008A1EB6 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC932F22BBDD9F9008A1EB6 /* libgmpxx.a */; };
5CC932F82BBDD9FA008A1EB6 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC932F32BBDD9F9008A1EB6 /* libgmp.a */; };
5CC932F92BBDD9FA008A1EB6 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC932F42BBDD9F9008A1EB6 /* libffi.a */; };
5CCB939C297EFCB100399E78 /* NavStackCompat.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCB939B297EFCB100399E78 /* NavStackCompat.swift */; };
5CD67B8F2B0E858A00C510B1 /* hs_init.h in Headers */ = {isa = PBXBuildFile; fileRef = 5CD67B8D2B0E858A00C510B1 /* hs_init.h */; settings = {ATTRIBUTES = (Public, ); }; };
5CD67B902B0E858A00C510B1 /* hs_init.c in Sources */ = {isa = PBXBuildFile; fileRef = 5CD67B8E2B0E858A00C510B1 /* hs_init.c */; };
@@ -139,11 +144,6 @@
5CEACCED27DEA495000BD591 /* MsgContentView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEACCEC27DEA495000BD591 /* MsgContentView.swift */; };
5CEBD7462A5C0A8F00665FE2 /* KeyboardPadding.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */; };
5CEBD7482A5F115D00665FE2 /* SetDeliveryReceiptsView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */; };
5CF898622BB984E400EE33B6 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF8985D2BB984E400EE33B6 /* libgmpxx.a */; };
5CF898632BB984E400EE33B6 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF8985E2BB984E400EE33B6 /* libffi.a */; };
5CF898642BB984E400EE33B6 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF8985F2BB984E400EE33B6 /* libgmp.a */; };
5CF898652BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF898602BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a */; };
5CF898662BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CF898612BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a */; };
5CF937202B24DE8C00E1D781 /* SharedFileSubscriber.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CF9371F2B24DE8C00E1D781 /* SharedFileSubscriber.swift */; };
5CF937232B2503D000E1D781 /* NSESubscriber.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CF937212B25034A00E1D781 /* NSESubscriber.swift */; };
5CFA59C42860BC6200863A68 /* MigrateToAppGroupView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */; };
@@ -402,6 +402,11 @@
5CC2C0FB2809BF11000C35E3 /* ru */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ru; path = ru.lproj/Localizable.strings; sourceTree = "<group>"; };
5CC2C0FE2809BF11000C35E3 /* ru */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ru; path = "ru.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = "<group>"; };
5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIRcvDecryptionError.swift; sourceTree = "<group>"; };
5CC932F02BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto-ghc9.6.3.a"; sourceTree = "<group>"; };
5CC932F12BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto.a"; sourceTree = "<group>"; };
5CC932F22BBDD9F9008A1EB6 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
5CC932F32BBDD9F9008A1EB6 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
5CC932F42BBDD9F9008A1EB6 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
5CCB939B297EFCB100399E78 /* NavStackCompat.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NavStackCompat.swift; sourceTree = "<group>"; };
5CD67B8D2B0E858A00C510B1 /* hs_init.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = hs_init.h; sourceTree = "<group>"; };
5CD67B8E2B0E858A00C510B1 /* hs_init.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = hs_init.c; sourceTree = "<group>"; };
@@ -431,11 +436,6 @@
5CEACCEC27DEA495000BD591 /* MsgContentView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MsgContentView.swift; sourceTree = "<group>"; };
5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = KeyboardPadding.swift; sourceTree = "<group>"; };
5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SetDeliveryReceiptsView.swift; sourceTree = "<group>"; };
5CF8985D2BB984E400EE33B6 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
5CF8985E2BB984E400EE33B6 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
5CF8985F2BB984E400EE33B6 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
5CF898602BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a"; sourceTree = "<group>"; };
5CF898612BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a"; sourceTree = "<group>"; };
5CF9371F2B24DE8C00E1D781 /* SharedFileSubscriber.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SharedFileSubscriber.swift; sourceTree = "<group>"; };
5CF937212B25034A00E1D781 /* NSESubscriber.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NSESubscriber.swift; sourceTree = "<group>"; };
5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MigrateToAppGroupView.swift; sourceTree = "<group>"; };
@@ -521,13 +521,13 @@
isa = PBXFrameworksBuildPhase;
buildActionMask = 2147483647;
files = (
5CF898652BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a in Frameworks */,
5CF898622BB984E400EE33B6 /* libgmpxx.a in Frameworks */,
5CF898642BB984E400EE33B6 /* libgmp.a in Frameworks */,
5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */,
5CC932F72BBDD9FA008A1EB6 /* libgmpxx.a in Frameworks */,
5CC932F62BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto.a in Frameworks */,
5CC932F52BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto-ghc9.6.3.a in Frameworks */,
5CC932F92BBDD9FA008A1EB6 /* libffi.a in Frameworks */,
5CC932F82BBDD9FA008A1EB6 /* libgmp.a in Frameworks */,
5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */,
5CF898632BB984E400EE33B6 /* libffi.a in Frameworks */,
5CF898662BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a in Frameworks */,
);
runOnlyForDeploymentPostprocessing = 0;
};
@@ -590,11 +590,11 @@
5C764E5C279C70B7000C6508 /* Libraries */ = {
isa = PBXGroup;
children = (
5CF8985E2BB984E400EE33B6 /* libffi.a */,
5CF8985F2BB984E400EE33B6 /* libgmp.a */,
5CF8985D2BB984E400EE33B6 /* libgmpxx.a */,
5CF898612BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a */,
5CF898602BB984E400EE33B6 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a */,
5CC932F42BBDD9F9008A1EB6 /* libffi.a */,
5CC932F32BBDD9F9008A1EB6 /* libgmp.a */,
5CC932F22BBDD9F9008A1EB6 /* libgmpxx.a */,
5CC932F02BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto-ghc9.6.3.a */,
5CC932F12BBDD9F9008A1EB6 /* libHSsimplex-chat-5.6.1.1-KSjuZv7tE7cHRWd28F1Zto.a */,
);
path = Libraries;
sourceTree = "<group>";
@@ -1536,7 +1536,7 @@
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 204;
CURRENT_PROJECT_VERSION = 206;
DEAD_CODE_STRIPPING = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
@@ -1561,7 +1561,7 @@
"@executable_path/Frameworks",
);
LLVM_LTO = YES_THIN;
MARKETING_VERSION = 5.6;
MARKETING_VERSION = 5.6.1;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.app;
PRODUCT_NAME = SimpleX;
SDKROOT = iphoneos;
@@ -1585,7 +1585,7 @@
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 204;
CURRENT_PROJECT_VERSION = 206;
DEAD_CODE_STRIPPING = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
@@ -1610,7 +1610,7 @@
"@executable_path/Frameworks",
);
LLVM_LTO = YES;
MARKETING_VERSION = 5.6;
MARKETING_VERSION = 5.6.1;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.app;
PRODUCT_NAME = SimpleX;
SDKROOT = iphoneos;
@@ -1671,7 +1671,7 @@
CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements";
CODE_SIGN_IDENTITY = "Apple Development";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 204;
CURRENT_PROJECT_VERSION = 206;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
GCC_OPTIMIZATION_LEVEL = s;
@@ -1686,7 +1686,7 @@
"@executable_path/../../Frameworks",
);
LLVM_LTO = YES;
MARKETING_VERSION = 5.6;
MARKETING_VERSION = 5.6.1;
PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-NSE";
PRODUCT_NAME = "$(TARGET_NAME)";
PROVISIONING_PROFILE_SPECIFIER = "";
@@ -1708,7 +1708,7 @@
CODE_SIGN_ENTITLEMENTS = "SimpleX NSE/SimpleX NSE.entitlements";
CODE_SIGN_IDENTITY = "Apple Development";
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 204;
CURRENT_PROJECT_VERSION = 206;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
ENABLE_BITCODE = NO;
ENABLE_CODE_COVERAGE = NO;
@@ -1723,7 +1723,7 @@
"@executable_path/../../Frameworks",
);
LLVM_LTO = YES;
MARKETING_VERSION = 5.6;
MARKETING_VERSION = 5.6.1;
PRODUCT_BUNDLE_IDENTIFIER = "chat.simplex.app.SimpleX-NSE";
PRODUCT_NAME = "$(TARGET_NAME)";
PROVISIONING_PROFILE_SPECIFIER = "";
@@ -1745,7 +1745,7 @@
CLANG_TIDY_BUGPRONE_REDUNDANT_BRANCH_CONDITION = YES;
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 204;
CURRENT_PROJECT_VERSION = 206;
DEFINES_MODULE = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
DYLIB_COMPATIBILITY_VERSION = 1;
@@ -1771,7 +1771,7 @@
"$(PROJECT_DIR)/Libraries/sim",
);
LLVM_LTO = YES;
MARKETING_VERSION = 5.6;
MARKETING_VERSION = 5.6.1;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleXChat;
PRODUCT_NAME = "$(TARGET_NAME:c99extidentifier)";
SDKROOT = iphoneos;
@@ -1796,7 +1796,7 @@
CLANG_TIDY_BUGPRONE_REDUNDANT_BRANCH_CONDITION = YES;
CLANG_TIDY_MISC_REDUNDANT_EXPRESSION = YES;
CODE_SIGN_STYLE = Automatic;
CURRENT_PROJECT_VERSION = 204;
CURRENT_PROJECT_VERSION = 206;
DEFINES_MODULE = YES;
DEVELOPMENT_TEAM = 5NN7GUYB6T;
DYLIB_COMPATIBILITY_VERSION = 1;
@@ -1822,7 +1822,7 @@
"$(PROJECT_DIR)/Libraries/sim",
);
LLVM_LTO = YES;
MARKETING_VERSION = 5.6;
MARKETING_VERSION = 5.6.1;
PRODUCT_BUNDLE_IDENTIFIER = chat.simplex.SimpleXChat;
PRODUCT_NAME = "$(TARGET_NAME:c99extidentifier)";
SDKROOT = iphoneos;
apps/ios/SimpleXChat/ChatTypes.swift
+8
View File
@@ -3209,6 +3209,14 @@ public enum MsgContent: Equatable {
}
}
public var isImageOrVideo: Bool {
switch self {
case .image: true
case .video: true
default: false
}
}
var cmdString: String {
"json \(encodeJSON(self))"
}
apps/multiplatform/common/build.gradle.kts
+1 -3
View File
@@ -12,9 +12,7 @@ version = extra["android.version_name"] as String
kotlin {
androidTarget()
jvm("desktop") {
jvmToolchain(11)
}
jvm("desktop")
applyDefaultHierarchyTemplate()
sourceSets {
all {
apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/item/CIImageView.android.kt
+1 -2
View File
@@ -6,7 +6,6 @@ import androidx.compose.ui.graphics.ImageBitmap
import androidx.compose.ui.graphics.painter.BitmapPainter
import androidx.compose.ui.graphics.painter.Painter
import androidx.compose.ui.platform.LocalContext
import chat.simplex.common.helpers.toUri
import chat.simplex.common.model.CIFile
import chat.simplex.common.platform.*
import chat.simplex.common.views.helpers.ModalManager
@@ -15,7 +14,6 @@ import coil.compose.rememberAsyncImagePainter
import coil.decode.GifDecoder
import coil.decode.ImageDecoderDecoder
import coil.request.ImageRequest
import java.net.URI
@Composable
actual fun SimpleAndAnimatedImageView(
@@ -43,6 +41,7 @@ actual fun SimpleAndAnimatedImageView(
}
private val imageLoader = ImageLoader.Builder(androidAppContext)
.networkObserverEnabled(false)
.components {
if (SDK_INT >= 28) {
add(ImageDecoderDecoder.Factory())
apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/views/chat/item/ImageFullScreenView.android.kt
+14 -13
View File
@@ -3,7 +3,7 @@ package chat.simplex.common.views.chat.item
import android.os.Build
import android.view.View
import androidx.compose.foundation.Image
import androidx.compose.runtime.Composable
import androidx.compose.runtime.*
import androidx.compose.ui.Modifier
import androidx.compose.ui.graphics.*
import androidx.compose.ui.graphics.painter.BitmapPainter
@@ -11,8 +11,8 @@ import androidx.compose.ui.layout.ContentScale
import androidx.compose.ui.platform.LocalContext
import androidx.compose.ui.viewinterop.AndroidView
import androidx.core.view.isVisible
import chat.simplex.common.helpers.toUri
import chat.simplex.common.platform.VideoPlayer
import chat.simplex.common.platform.androidAppContext
import chat.simplex.res.MR
import coil.ImageLoader
import coil.compose.rememberAsyncImagePainter
@@ -23,21 +23,11 @@ import coil.size.Size
import com.google.android.exoplayer2.ui.AspectRatioFrameLayout
import com.google.android.exoplayer2.ui.StyledPlayerView
import dev.icerock.moko.resources.compose.stringResource
import java.net.URI
@Composable
actual fun FullScreenImageView(modifier: Modifier, data: ByteArray, imageBitmap: ImageBitmap) {
// I'm making a new instance of imageLoader here because if I use one instance in multiple places
// I'm using a new private instance of imageLoader here because if I use one instance in multiple places
// after end of composition here a GIF from the first instance will be paused automatically which isn't what I want
val imageLoader = ImageLoader.Builder(LocalContext.current)
.components {
if (Build.VERSION.SDK_INT >= 28) {
add(ImageDecoderDecoder.Factory())
} else {
add(GifDecoder.Factory())
}
}
.build()
Image(
rememberAsyncImagePainter(
ImageRequest.Builder(LocalContext.current).data(data = data).size(Size.ORIGINAL).build(),
@@ -73,3 +63,14 @@ actual fun FullScreenVideoView(player: VideoPlayer, modifier: Modifier, close: (
modifier
)
}
private val imageLoader = ImageLoader.Builder(androidAppContext)
.networkObserverEnabled(false)
.components {
if (Build.VERSION.SDK_INT >= 28) {
add(ImageDecoderDecoder.Factory())
} else {
add(GifDecoder.Factory())
}
}
.build()
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt
+3 -2
View File
@@ -1392,11 +1392,12 @@ private fun providerForGallery(
return null
}
var initialIndex = Int.MAX_VALUE / 2
// Pager has a bug with overflowing when total pages is around Int.MAX_VALUE. Using smaller value
var initialIndex = 10000 / 2
var initialChatId = cItemId
return object: ImageGalleryProvider {
override val initialIndex: Int = initialIndex
override val totalMediaSize = mutableStateOf(Int.MAX_VALUE)
override val totalMediaSize = mutableStateOf(10000)
override fun getMedia(index: Int): ProviderMedia? {
val internalIndex = initialIndex - index
val item = item(internalIndex, initialChatId)?.second ?: return null
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/remote/ConnectMobileView.kt
+20 -6
View File
@@ -38,9 +38,7 @@ import chat.simplex.common.views.usersettings.*
import chat.simplex.res.MR
import dev.icerock.moko.resources.compose.painterResource
import dev.icerock.moko.resources.compose.stringResource
import kotlinx.coroutines.delay
import kotlinx.coroutines.flow.distinctUntilChanged
import kotlinx.coroutines.runBlocking
@Composable
fun ConnectMobileView() {
@@ -269,12 +267,20 @@ fun AddingMobileDevice(showTitle: Boolean, staleQrCode: MutableState<Boolean>, c
var cachedR by remember { mutableStateOf<CR.RemoteHostStarted?>(null) }
val customAddress = rememberSaveable { mutableStateOf<RemoteCtrlAddress?>(null) }
val customPort = rememberSaveable { mutableStateOf<Int?>(null) }
var userChangedAddress by rememberSaveable { mutableStateOf(false) }
var userChangedPort by rememberSaveable { mutableStateOf(false) }
val startRemoteHost = suspend {
if (customAddress.value != cachedR.address && cachedR != null) {
userChangedAddress = true
}
if (customPort.value != cachedR.port && cachedR != null) {
userChangedPort = true
}
val r = chatModel.controller.startRemoteHost(
rhId = null,
multicast = controller.appPrefs.offerRemoteMulticast.get(),
address = if (customAddress.value?.address != cachedR.address?.address) customAddress.value else cachedR.rh?.bindAddress_,
port = if (customPort.value != cachedR.port) customPort.value else cachedR.rh?.bindPort_
address = if (customAddress.value != null && userChangedAddress) customAddress.value else cachedR.rh?.bindAddress_,
port = if (customPort.value != null && userChangedPort) customPort.value else cachedR.rh?.bindPort_
)
if (r != null) {
cachedR = r
@@ -343,12 +349,20 @@ private fun showConnectMobileDevice(rh: RemoteHostInfo, connecting: MutableState
var cachedR by remember { mutableStateOf<CR.RemoteHostStarted?>(null) }
val customAddress = rememberSaveable { mutableStateOf<RemoteCtrlAddress?>(null) }
val customPort = rememberSaveable { mutableStateOf<Int?>(null) }
var userChangedAddress by rememberSaveable { mutableStateOf(false) }
var userChangedPort by rememberSaveable { mutableStateOf(false) }
val startRemoteHost = suspend {
if (customAddress.value != cachedR.address && cachedR != null) {
userChangedAddress = true
}
if (customPort.value != cachedR.port && cachedR != null) {
userChangedPort = true
}
val r = chatModel.controller.startRemoteHost(
rhId = rh.remoteHostId,
multicast = controller.appPrefs.offerRemoteMulticast.get(),
address = if (customAddress.value?.address != cachedR.address?.address) customAddress.value else cachedR.rh?.bindAddress_ ?: rh.bindAddress_,
port = if (customPort.value != cachedR.port) customPort.value else cachedR.rh?.bindPort_ ?: rh.bindPort_
address = if (customAddress.value != null && userChangedAddress) customAddress.value else cachedR.rh?.bindAddress_ ?: rh.bindAddress_,
port = if (customPort.value != null && userChangedPort) customPort.value else cachedR.rh?.bindPort_ ?: rh.bindPort_
)
if (r != null) {
cachedR = r
apps/multiplatform/common/src/commonMain/resources/MR/images/ic_simplex.svg
+44
View File
@@ -0,0 +1,44 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg
width="120"
height="120"
viewBox="121 0 40 40"
fill="none"
version="1.1"
id="svg3"
xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg">
<path
fill-rule="evenodd"
clip-rule="evenodd"
d="m 126.52238,11.425398 5.80302,5.716401 5.88962,-5.889626 2.8582,2.858201 L 135.1836,20 l 5.7164,5.716402 -2.94482,2.8582 -5.7164,-5.629789 -5.88962,5.803014 -2.8582,-2.858201 5.88962,-5.803014 -5.803,-5.716402 z"
fill="#030749"
id="path1"
style="stroke-width:0.866122" />
<path
fill-rule="evenodd"
clip-rule="evenodd"
d="m 137.86858,28.661214 2.94481,-2.944812 v 0 l 5.88963,-5.803014 -5.80302,-5.62979 v 0 l -2.8582,-2.8582 -5.7164,-5.7164023 2.94481,-2.9448129 5.7164,5.7164017 5.88963,-5.8030138 2.8582,2.8582008 -5.88962,5.8030145 5.7164,5.716401 5.88962,-5.803014 2.8582,2.858201 -5.88962,5.803014 5.803,5.716402 -2.9448,2.858201 -5.7164,-5.716402 -5.88963,5.803013 5.7164,5.716402 -2.8582,2.944813 -5.80301,-5.716402 -5.80302,5.803015 -2.8582,-2.858201 z"
fill="url(#paint0_linear_40_164)"
id="path2"
style="fill:url(#paint0_linear_40_164);stroke-width:0.866122" />
<defs
id="defs3">
<linearGradient
x1="135.948"
y1="-0.81632602"
x2="132.09599"
y2="36.985699"
gradientUnits="userSpaceOnUse"
id="paint0_linear_40_164"
gradientTransform="matrix(0.86612147,0,0,0.86612147,18.863485,2.6775707)">
<stop
stop-color="#01f1ff"
id="stop2" />
<stop
offset="1"
stop-color="#0197ff"
id="stop3" />
</linearGradient>
</defs>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 1.7 KiB

apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/DesktopApp.kt
+2 -1
View File
@@ -21,6 +21,7 @@ import chat.simplex.common.ui.theme.SimpleXTheme
import chat.simplex.common.views.TerminalView
import chat.simplex.common.views.helpers.*
import chat.simplex.res.MR
import dev.icerock.moko.resources.compose.painterResource
import dev.icerock.moko.resources.compose.stringResource
import kotlinx.coroutines.*
import java.awt.event.WindowEvent
@@ -103,7 +104,7 @@ private fun ApplicationScope.AppWindow(closedByError: MutableState<Boolean>) {
simplexWindowState.windowState = windowState
// Reload all strings in all @Composable's after language change at runtime
if (remember { ChatController.appPrefs.appLanguage.state }.value != "") {
Window(state = windowState, onCloseRequest = { closedByError.value = false; exitApplication() }, onKeyEvent = {
Window(state = windowState, icon = painterResource(MR.images.ic_simplex), onCloseRequest = { closedByError.value = false; exitApplication() }, onKeyEvent = {
if (it.key == Key.Escape && it.type == KeyEventType.KeyUp) {
simplexWindowState.backstack.lastOrNull()?.invoke() != null
} else {
apps/multiplatform/common/src/desktopMain/kotlin/chat/simplex/common/views/chat/item/CIVideoView.desktop.kt
+11 -8
View File
@@ -7,6 +7,8 @@ import androidx.compose.ui.Modifier
import androidx.compose.ui.platform.LocalDensity
import androidx.compose.ui.unit.Dp
import chat.simplex.common.platform.*
import chat.simplex.common.simplexWindowState
import java.awt.Window
@Composable
actual fun PlayerView(player: VideoPlayer, width: Dp, onClick: () -> Unit, onLongClick: () -> Unit, stop: () -> Unit) {
@@ -23,14 +25,15 @@ actual fun PlayerView(player: VideoPlayer, width: Dp, onClick: () -> Unit, onLon
}
}
/*
* This function doesn't take into account multi-window environment. In case more windows will be used, modify the code
* */
@Composable
actual fun LocalWindowWidth(): Dp {
return with(LocalDensity.current) { (java.awt.Window.getWindows().find { it.isActive }?.width ?: 0).toDp() }
/*val density = LocalDensity.current
var width by remember { mutableStateOf(with(density) { (java.awt.Window.getWindows().find { it.isActive }?.width ?: 0).toDp() }) }
SideEffect {
if (width != with(density) { (java.awt.Window.getWindows().find { it.isActive }?.width ?: 0).toDp() })
width = with(density) { (java.awt.Window.getWindows().find { it.isActive }?.width ?: 0).toDp() }
actual fun LocalWindowWidth(): Dp = with(LocalDensity.current) {
val windows = java.awt.Window.getWindows()
if (windows.size == 1) {
(windows.getOrNull(0)?.width ?: 0).toDp()
} else {
simplexWindowState.windowState.size.width
}
return width.also { println("LALAL $it") }*/
}
apps/multiplatform/desktop/build.gradle.kts
+2 -5
View File
@@ -12,10 +12,7 @@ version = extra["desktop.version_name"] as String
kotlin {
jvm {
jvmToolchain(11)
withJava()
}
jvm()
sourceSets {
val jvmMain by getting {
dependencies {
@@ -151,7 +148,7 @@ cmake {
tasks.named("clean") {
dependsOn("cmakeClean")
}
tasks.named("compileJava") {
tasks.named("compileKotlinJvm") {
dependsOn("cmakeBuildAndCopy")
}
afterEvaluate {
apps/multiplatform/gradle.properties
+4 -4
View File
@@ -25,11 +25,11 @@ android.nonTransitiveRClass=true
android.enableJetifier=true
kotlin.mpp.androidSourceSetLayoutVersion=2
android.version_name=5.6
android.version_code=191
android.version_name=5.6.1
android.version_code=193
desktop.version_name=5.6
desktop.version_code=35
desktop.version_name=5.6.1
desktop.version_code=36
kotlin.version=1.9.23
gradle.plugin.version=8.2.0
apps/simplex-directory-service/src/Directory/Events.hs
+1
View File
@@ -31,6 +31,7 @@ import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol (MsgContent (..))
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Util ((<$?>))
import Data.Char (isSpace)
apps/simplex-directory-service/src/Directory/Service.hs
+1
View File
@@ -36,6 +36,7 @@ import Simplex.Chat.Messages
import Simplex.Chat.Options
import Simplex.Chat.Protocol (MsgContent (..))
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Chat.View (serializeChatResponse, simplexChatContact)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.TMap (TMap)
blog/20240404-why-i-joined-simplex-chat-esraa-al-shafei.md
+38
View File
@@ -0,0 +1,38 @@
---
layout: layouts/article.html
title: "Why I joined SimpleX Chat - by Esra'a al Shafei"
date: 2024-04-04
previewBody: blog_previews/20240404.html
image: images/20240404-esraa.png
permalink: "/blog/20240404-why-i-joined-simplex-chat-esraa-al-shafei.html"
---
# Why I joined SimpleX Chat
**Published:** Apr 4, 2024
_By [Esra'a al Shafei](https://mastodon.social/@alshafei)_
Transitioning from a lifelong career dedicated to nonprofits, including Board roles at organizations like the Wikimedia Foundation, Access Now and Tor, my decision to join SimpleX Chat may come as a surprise to some. But, as I step into this new chapter, I want to share the insights and convictions that have guided me here, shedding light on what I think sets SimpleX Chat apart and why this move feels like an essential learning opportunity.
The nonprofit world has been my primary focus for decades. My team and I ran the platforms at Majal.org with an extremely limited budget. We had to navigate many complexities and challenges that shadow the nonprofit model. And because we worked primarily in creating applications and tools, a recurring theme has been financial sustainability. Being a Bahrain-based entity for most of these years meant that the many communities we served were not in a position to provide contributions and we were not eligible for most foundation grants. This drastically limited our growth and the reliability of our apps. When we failed to raise sufficient funds or meet our target budgets, we often had to shutter certain applications, sometimes after spending more than 10 years building them.
With secure and private messaging, the stakes are even graver. Any failure to commit and resource/fund ongoing development, security patches, etc means lives can be at risk. I still believe in nonprofit models, and it’s why I continue to serve them through various volunteer roles. I do also believe that there is room for a mixture of models that, in the case of something as unique as SimpleX Chat, can serve as a fully open and transparent public interest technology while also having a profitable values-aligned company that can keep the lights on to continue developing, expanding, and improving the protocol, network and their reach.
I’m no stranger to writing about some VC models being [corrupt](https://mastodon.social/@alshafei/112125959080515656). Frankly, I also hold the view that some tech VCs are amongst the [most complicit](https://responsiblestatecraft.org/defense-tech/) in egregious war crimes worldwide, or enabling the [intrusive surveillance](https://mastodon.social/@alshafei/112140566088322925) we’re fighting against. So being part of a VC-funded venture is not a decision I take lightly. However, I have been following SimpleX Chat’s growth since early 2022 when I first met Evgeny at the Mozilla Festival. I appreciated the drive and Evgeny’s firm refusal to settle for the current models of private messaging. We share the belief that messaging is something we need to keep improving and that we must continue pushing its boundaries to make it even more private, secure, usable for groups, and, most importantly - fully decentralized. This is a major undertaking, and it requires funding to achieve. Candidly, I did worry about funding and sustainability because, at the time, SimpleX was still primarily funded by user contributions.
But even knowing this, I scrutinized SimpleX Chat for taking VC funding ($350K) from Village Global and questioned the individuals featured on its frontpage. I had to speak with Evgeny directly to learn who exactly from this fund was involved, how much power they wielded, if any, and if this changes the ethos of the company - all of which he is already making public. It was only after these discussions that I was comfortable to take a leap of faith and continue to use the app and vouch for its current and future offerings. It required me to question my own views on whether a VC-funded company can actually have major positive contributions to privacy as well as the open ecosystem.
<img src="./images/20240404-messsaging-apps.png" class="float-to-right" width="50%">
The web has a long history of [trading privacy](https://www.engadget.com/from-its-start-gmail-conditioned-us-to-trade-privacy-for-free-services-120009741.html) for “free” services. Traditionally, these services have also been centralized, closed-source, non-transparent, and profit-oriented. The companies behind these apps and services became prolific because of their disregard of privacy rights, which normalized lucrative surveillance capitalism. There is such an extensive global monopoly that in Africa, only 1 of the 5 biggest messaging apps in Africa isn't owned by Meta, notoriously known for spying not just through its own apps but even through [its competitors](https://qz.com/project-ghostbusters-facebook-meta-wiretap-snapchat-1851366814), – relentless, massive data harvesting that stretches far beyond its own walled gardens:
Some of the world’s top engineers often go to these companies because of the benefits and financial opportunities. We can question their ethics all day long, but we also need to question if the web would look significantly different if there were as many opportunities at privacy-first companies with purpose and strong, proven moral boundaries, set up in a way that can guarantee operational independence from any shareholders and VCs.
SimpleX could have taken the route of other companies in the privacy space, whether it’s Skiff which rushed to take a large amount of [VC money](https://techcrunch.com/2022/03/30/skiff-series-a-encrypted-workspaces/) only to [shutter its doors](https://www.techradar.com/computing/cyber-security/skiff-gets-bought-by-notion-raising-privacy-concerns) after an acquisition, leaving its users hanging with many unanswered questions, or giving up control of the company, which would puts its future solely in the hands of VCs with majority ownership. SimpleX aims to prevent this, and in fact has left money on the table to ensure that it does not occur. Had it not been for this information, I would not have joined, and I would have remained a user of the product, albeit a very cautious one, constantly wondering whether it will be sold or corrupted.
It’s worth noting that some private foundations operate on the VC model in supporting nonprofits, either by requiring Board seats or requesting that their funding be used towards very specific objectives not always in alignment with the organization’s values and mission. It’s also worth noting that [some nonprofits](https://www.engadget.com/2019-05-31-sex-lies-and-surveillance-fosta-privacy.html) actually operate on the models of surveillance and censorship. Therefore, whether an organization or company is VC-backed or a nonprofit should not be the sole factor in deciding whether or not it is trustworthy. Actions are important, with full transparency being one of the most critical factors, and being fully open source being another to attract valid criticisms and audits to ensure any product or protocol lives up to its privacy and security promise. SimpleX Chat prides itself on being both transparent and open, on top of also being fully decentralized. If you’re new to it and eager to know more, you can start with [this overview](https://github.com/simplex-chat/simplexmq/blob/stable/protocol/overview-tjr.md).
Another important consideration is that the SimpleX network does have a plan that would rely on users' payments for specific or tailored services, and not on some other sources of revenue or funds (ads, etc.). Building anything that users would be willing to pay for requires substantially more time and resources, hence the VC route to establish a business model that doesn’t translate to the user being the product. But any business services need to be separate from SimpleX as a public interest technology. As outlined in this [recent post](./20240323-simplex-network-privacy-non-profit-v5-6-quantum-resistant-e2e-encryption-simple-migration.md), I’ll be using my background in nonprofit governance structures to ensure that the SimpleX network protocols evolve under the stewardship of nonprofit entities in various jurisdictions, so that its continued evolution aligns more closely with the vision of community-driven, independent and decentralized governance. This would help create a necessary balance between different structures, in the same way many tech nonprofits also have for-profit subsidiaries to attract fee-for-service agreements to sustain their operations.
In summary: My decision to join Simplex Chat, despite my deep-rooted beliefs and skepticism towards VC funding, reflects a broader realization: that the fight for privacy, security, and decentralization in today’s web is multifaceted and sometimes requires us to depart from our comfort zones to explore sustainable paths for continuous growth and impact so that open source privacy tools and protocols are no longer “niche”, but universally accessible standards. As long as nothing in this journey compromises our moral principles and integrity, this will remain a very worthwhile goal to pursue.
blog/README.md
+8
View File
@@ -1,5 +1,13 @@
# Blog
Apr 4. 2024 [Why I joined SimpleX Chat](./20240404-why-i-joined-simplex-chat-esraa-al-shafei.md)
_By [Esra'a al Shafei](https://mastodon.social/@alshafei)_
Transitioning from a lifelong career dedicated to nonprofits, including Board roles at organizations like the Wikimedia Foundation, Access Now and Tor, my decision to join SimpleX Chat may come as a surprise to some. But, as I step into this new chapter, I want to share the insights and convictions that have guided me here, shedding light on what I think sets SimpleX Chat apart and why this move feels like an essential learning opportunity.
---
Mar 23, 2024 [SimpleX network: real privacy and stable profits, non-profits for protocols, v5.6 released with quantum resistant e2e encryption and simple profile migration](./20240323-simplex-network-privacy-non-profit-v5-6-quantum-resistant-e2e-encryption-simple-migration.md)
SimpleX network: deliver real privacy via a profitable business and non-profit protocol governance:
blog/images/20240404-esraa.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 12 KiB

blog/images/20240404-messsaging-apps.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 182 KiB

cabal.project
+1 -7
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: bfd532e833aff36754ef766f4e021f0079a7f83c
tag: 791368c7beb3996ab4a10f25dbf8cad1e289b413
source-repository-package
type: git
@@ -34,12 +34,6 @@ source-repository-package
location: https://github.com/simplex-chat/aeson.git
tag: aab7b5a14d6c5ea64c64dcaee418de1bb00dcc2b
-- old bs/text compat for 8.10
source-repository-package
type: git
location: https://github.com/simplex-chat/base64.git
tag: 2d77b6dbcaffc00570a70be8694049f3710e7c94
source-repository-package
type: git
location: https://github.com/simplex-chat/haskell-terminal.git
package.yaml
+2 -1
View File
@@ -1,5 +1,5 @@
name: simplex-chat
version: 5.6.1.0
version: 5.6.1.1
#synopsis:
#description:
homepage: https://github.com/simplex-chat/simplex-chat#readme
@@ -18,6 +18,7 @@ dependencies:
- async == 2.2.*
- attoparsec == 0.14.*
- base >= 4.7 && < 5
- base64-bytestring >= 1.0 && < 1.3
- composition == 1.0.*
- constraints >= 0.12 && < 0.14
- containers == 0.6.*
scripts/nix/sha256map.nix
+1 -2
View File
@@ -1,10 +1,9 @@
{
"https://github.com/simplex-chat/simplexmq.git"."bfd532e833aff36754ef766f4e021f0079a7f83c" = "1xxcdadllimk2hgzz6aggvywr14zm2h0l62c92yvnyvps9j49gdx";
"https://github.com/simplex-chat/simplexmq.git"."791368c7beb3996ab4a10f25dbf8cad1e289b413" = "0wbxk69lv6h17b5rdqskxwhc1wfvn1zi8q4a4w57qfzkzyaxkymk";
"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";
"https://github.com/simplex-chat/aeson.git"."aab7b5a14d6c5ea64c64dcaee418de1bb00dcc2b" = "0jz7kda8gai893vyvj96fy962ncv8dcsx71fbddyy8zrvc88jfrr";
"https://github.com/simplex-chat/base64.git"."2d77b6dbcaffc00570a70be8694049f3710e7c94" = "0zdskk67fzqrrx1i29s3shp7fh9c0krmq5h6hq03qx0n3xy2m44b";
"https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
"https://github.com/simplex-chat/android-support.git"."9aa09f148089d6752ce563b14c2df1895718d806" = "0pbf2pf13v2kjzi397nr13f1h3jv0imvsq8rpiyy2qyx5vd50pqn";
"https://github.com/simplex-chat/zip.git"."bd421c6b19cc4c465cd7af1f6f26169fb8ee1ebc" = "1csqfjhvc8wb5h4kxxndmb6iw7b4ib9ff2n81hrizsmnf45a6gg0";
simplex-chat.cabal
+9 -1
View File
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: simplex-chat
version: 5.6.1.0
version: 5.6.1.1
category: Web, System, Services, Cryptography
homepage: https://github.com/simplex-chat/simplex-chat#readme
author: simplex.chat
@@ -175,6 +175,7 @@ library
Simplex.Chat.Terminal.Output
Simplex.Chat.Types
Simplex.Chat.Types.Preferences
Simplex.Chat.Types.Shared
Simplex.Chat.Types.Util
Simplex.Chat.Util
Simplex.Chat.View
@@ -191,6 +192,7 @@ library
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.7 && <5
, base64-bytestring >=1.0 && <1.3
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
@@ -252,6 +254,7 @@ executable simplex-bot
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.7 && <5
, base64-bytestring >=1.0 && <1.3
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
@@ -314,6 +317,7 @@ executable simplex-bot-advanced
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.7 && <5
, base64-bytestring >=1.0 && <1.3
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
@@ -379,6 +383,7 @@ executable simplex-broadcast-bot
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.7 && <5
, base64-bytestring >=1.0 && <1.3
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
@@ -442,6 +447,7 @@ executable simplex-chat
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.7 && <5
, base64-bytestring >=1.0 && <1.3
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
@@ -511,6 +517,7 @@ executable simplex-directory-service
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.7 && <5
, base64-bytestring >=1.0 && <1.3
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
@@ -606,6 +613,7 @@ test-suite simplex-chat-test
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.7 && <5
, base64-bytestring >=1.0 && <1.3
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
src/Simplex/Chat.hs
+228 -181
View File
@@ -29,6 +29,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (bimap, first, second)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
@@ -79,6 +80,7 @@ import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.Util
import Simplex.Chat.Util (encryptFile, liftIOEither, shuffle)
import Simplex.FileTransfer.Client.Main (maxFileSize, maxFileSizeHard)
@@ -87,9 +89,9 @@ import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescr
import qualified Simplex.FileTransfer.Description as FD
import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentWorkersDetails, getAgentWorkersSummary, temporaryAgentError)
import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentWorkersDetails, getAgentWorkersSummary, temporaryAgentError, withLockMap)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
import Simplex.Messaging.Agent.Lock
import Simplex.Messaging.Agent.Lock (withLock)
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, SQLiteStore (dbNew), execSQL, upMigration, withConnection)
@@ -103,9 +105,8 @@ import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKNoPQ, pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.Base64 (base64P)
import qualified Simplex.Messaging.Encoding.Base64 as B64
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (base64P)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
@@ -227,6 +228,7 @@ newChatController
connNetworkStatuses <- atomically TM.empty
subscriptionMode <- newTVarIO SMSubscribe
chatLock <- newEmptyTMVarIO
entityLocks <- atomically TM.empty
sndFiles <- newTVarIO M.empty
rcvFiles <- newTVarIO M.empty
currentCalls <- atomically TM.empty
@@ -263,6 +265,7 @@ newChatController
connNetworkStatuses,
subscriptionMode,
chatLock,
entityLocks,
sndFiles,
rcvFiles,
currentCalls,
@@ -313,6 +316,37 @@ newChatController
withChatLock :: String -> CM a -> CM a
withChatLock name action = asks chatLock >>= \l -> withLock l name action
withEntityLock :: String -> ChatLockEntity -> CM a -> CM a
withEntityLock name entity action = do
chatLock <- asks chatLock
ls <- asks entityLocks
atomically $ unlessM (isEmptyTMVar chatLock) retry
withLockMap ls entity name action
withInvitationLock :: String -> ByteString -> CM a -> CM a
withInvitationLock name = withEntityLock name . CLInvitation
{-# INLINE withInvitationLock #-}
withConnectionLock :: String -> Int64 -> CM a -> CM a
withConnectionLock name = withEntityLock name . CLConnection
{-# INLINE withConnectionLock #-}
withContactLock :: String -> ContactId -> CM a -> CM a
withContactLock name = withEntityLock name . CLContact
{-# INLINE withContactLock #-}
withGroupLock :: String -> GroupId -> CM a -> CM a
withGroupLock name = withEntityLock name . CLGroup
{-# INLINE withGroupLock #-}
withUserContactLock :: String -> Int64 -> CM a -> CM a
withUserContactLock name = withEntityLock name . CLUserContact
{-# INLINE withUserContactLock #-}
withFileLock :: String -> Int64 -> CM a -> CM a
withFileLock name = withEntityLock name . CLFile
{-# INLINE withFileLock #-}
activeAgentServers :: UserProtocol p => ChatConfig -> SProtocolType p -> [ServerCfg p] -> NonEmpty (ProtoServerWithAuth p)
activeAgentServers ChatConfig {defaultServers} p =
fromMaybe (cfgServers p defaultServers)
@@ -672,16 +706,18 @@ processChatCommand' vr = \case
memStatuses -> pure $ Just $ map (uncurry MemberDeliveryStatus) memStatuses
_ -> pure Nothing
pure $ CRChatItemInfo user aci ChatItemInfo {itemVersions, memberDeliveryStatuses}
APISendMessage (ChatRef cType chatId) live itemTTL cm -> withUser $ \user -> withChatLock "sendMessage" $ case cType of
CTDirect -> sendContactContentMessage user chatId live itemTTL cm False
CTGroup -> sendGroupContentMessage user chatId live itemTTL cm False
APISendMessage (ChatRef cType chatId) live itemTTL cm -> withUser $ \user -> case cType of
CTDirect -> withContactLock "sendMessage" chatId $
sendContactContentMessage user chatId live itemTTL cm False
CTGroup -> withGroupLock "sendMessage" chatId $
sendGroupContentMessage user chatId live itemTTL cm False
CTLocal -> pure $ chatCmdError (Just user) "not supported"
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APICreateChatItem folderId cm -> withUser $ \user ->
createNoteFolderContentItem user folderId cm False
APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of
CTDirect -> do
APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> case cType of
CTDirect -> withContactLock "updateChatItem" chatId $ do
ct@Contact {contactId} <- withStore $ \db -> getContact db vr user chatId
assertDirectAllowed user MDSnd ct XMsgUpdate_
cci <- withStore $ \db -> getDirectCIWithReactions db user ct itemId
@@ -703,7 +739,7 @@ processChatCommand' vr = \case
else pure $ CRChatItemNotChanged user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
_ -> throwChatError CEInvalidChatItemUpdate
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
CTGroup -> do
CTGroup -> withGroupLock "updateChatItem" chatId $ do
Group gInfo@GroupInfo {groupId} ms <- withStore $ \db -> getGroup db vr user chatId
assertUserGroupRole gInfo GRAuthor
cci <- withStore $ \db -> getGroupCIWithReactions db user gInfo itemId
@@ -738,8 +774,8 @@ processChatCommand' vr = \case
_ -> throwChatError CEInvalidChatItemUpdate
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of
CTDirect -> do
APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> case cType of
CTDirect -> withContactLock "deleteChatItem" chatId $ do
(ct, CChatItem msgDir ci@ChatItem {meta = CIMeta {itemSharedMsgId, editable}}) <- withStore $ \db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId
case (mode, msgDir, itemSharedMsgId, editable) of
(CIDMInternal, _, _, _) -> deleteDirectCI user ct ci True False
@@ -750,7 +786,7 @@ processChatCommand' vr = \case
then deleteDirectCI user ct ci True False
else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime
(CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
CTGroup -> do
CTGroup -> withGroupLock "deleteChatItem" chatId $ do
Group gInfo ms <- withStore $ \db -> getGroup db vr user chatId
CChatItem msgDir ci@ChatItem {meta = CIMeta {itemSharedMsgId, editable}} <- withStore $ \db -> getGroupChatItem db user chatId itemId
case (mode, msgDir, itemSharedMsgId, editable) of
@@ -765,7 +801,7 @@ processChatCommand' vr = \case
deleteLocalCI user nf ci True False
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do
APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do
Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db vr user gId
CChatItem _ ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}} <- withStore $ \db -> getGroupChatItem db user gId itemId
case (chatDir, itemSharedMsgId) of
@@ -775,44 +811,46 @@ processChatCommand' vr = \case
(SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId $ Just memberId
delGroupChatItem user gInfo ci msgId (Just membership)
(_, _) -> throwChatError CEInvalidChatItemDelete
APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> withChatLock "chatItemReaction" $ case cType of
APIChatItemReaction (ChatRef cType chatId) itemId add reaction -> withUser $ \user -> case cType of
CTDirect ->
withStore (\db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId) >>= \case
(ct, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
unless (featureAllowed SCFReactions forUser ct) $
throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions))
unless (ciReactionAllowed ci) $
throwChatError (CECommandError "reaction not allowed - chat item has no content")
rs <- withStore' $ \db -> getDirectReactions db ct itemSharedMId True
checkReactionAllowed rs
(SndMessage {msgId}, _) <- sendDirectContactMessage user ct $ XMsgReact itemSharedMId Nothing reaction add
createdAt <- liftIO getCurrentTime
reactions <- withStore' $ \db -> do
setDirectReaction db ct itemSharedMId True reaction add msgId createdAt
liftIO $ getDirectCIReactions db ct itemSharedMId
let ci' = CChatItem md ci {reactions}
r = ACIReaction SCTDirect SMDSnd (DirectChat ct) $ CIReaction CIDirectSnd ci' createdAt reaction
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
withContactLock "chatItemReaction" chatId $
withStore (\db -> (,) <$> getContact db vr user chatId <*> getDirectChatItem db user chatId itemId) >>= \case
(ct, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
unless (featureAllowed SCFReactions forUser ct) $
throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions))
unless (ciReactionAllowed ci) $
throwChatError (CECommandError "reaction not allowed - chat item has no content")
rs <- withStore' $ \db -> getDirectReactions db ct itemSharedMId True
checkReactionAllowed rs
(SndMessage {msgId}, _) <- sendDirectContactMessage user ct $ XMsgReact itemSharedMId Nothing reaction add
createdAt <- liftIO getCurrentTime
reactions <- withStore' $ \db -> do
setDirectReaction db ct itemSharedMId True reaction add msgId createdAt
liftIO $ getDirectCIReactions db ct itemSharedMId
let ci' = CChatItem md ci {reactions}
r = ACIReaction SCTDirect SMDSnd (DirectChat ct) $ CIReaction CIDirectSnd ci' createdAt reaction
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
CTGroup ->
withStore (\db -> (,) <$> getGroup db vr user chatId <*> getGroupChatItem db user chatId itemId) >>= \case
(Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
unless (groupFeatureAllowed SGFReactions g) $
throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions))
unless (ciReactionAllowed ci) $
throwChatError (CECommandError "reaction not allowed - chat item has no content")
let GroupMember {memberId = itemMemberId} = chatItemMember g ci
rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True
checkReactionAllowed rs
(SndMessage {msgId}, _) <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add)
createdAt <- liftIO getCurrentTime
reactions <- withStore' $ \db -> do
setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt
liftIO $ getGroupCIReactions db g itemMemberId itemSharedMId
let ci' = CChatItem md ci {reactions}
r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
withGroupLock "chatItemReaction" chatId $
withStore (\db -> (,) <$> getGroup db vr user chatId <*> getGroupChatItem db user chatId itemId) >>= \case
(Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do
unless (groupFeatureAllowed SGFReactions g) $
throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions))
unless (ciReactionAllowed ci) $
throwChatError (CECommandError "reaction not allowed - chat item has no content")
let GroupMember {memberId = itemMemberId} = chatItemMember g ci
rs <- withStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True
checkReactionAllowed rs
(SndMessage {msgId}, _) <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add)
createdAt <- liftIO getCurrentTime
reactions <- withStore' $ \db -> do
setGroupReaction db g membership itemMemberId itemSharedMId True reaction add msgId createdAt
liftIO $ getGroupCIReactions db g itemMemberId itemSharedMId
let ci' = CChatItem md ci {reactions}
r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction
pure $ CRChatItemReaction user add r
_ -> throwChatError $ CECommandError "reaction not possible - no shared item ID"
CTLocal -> pure $ chatCmdError (Just user) "not supported"
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
@@ -922,7 +960,7 @@ processChatCommand' vr = \case
CTDirect -> do
ct <- withStore $ \db -> getContact db vr user chatId
filesInfo <- withStore' $ \db -> getContactFileInfo db user ct
withChatLock "deleteChat direct" . procCmd $ do
withContactLock "deleteChat direct" chatId . procCmd $ do
cancelFilesInProgress user filesInfo
deleteFilesLocally filesInfo
let doSendDel = contactReady ct && contactActive ct && notify
@@ -934,7 +972,7 @@ processChatCommand' vr = \case
withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct
withStore $ \db -> deleteContact db user ct
pure $ CRContactDeleted user ct
CTContactConnection -> withChatLock "deleteChat contactConnection" . procCmd $ do
CTContactConnection -> withConnectionLock "deleteChat contactConnection" chatId . procCmd $ do
conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId
deleteAgentConnectionAsync user acId
withStore' $ \db -> deletePendingContactConnection db userId chatId
@@ -946,7 +984,7 @@ processChatCommand' vr = \case
canDelete = isOwner || not (memberCurrent membership)
unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner
filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo
withChatLock "deleteChat group" . procCmd $ do
withGroupLock "deleteChat group" chatId . procCmd $ do
cancelFilesInProgress user filesInfo
deleteFilesLocally filesInfo
let doSendDel = memberActive membership && isOwner
@@ -1001,28 +1039,29 @@ processChatCommand' vr = \case
CTLocal -> do
nf <- withStore $ \db -> getNoteFolder db user chatId
filesInfo <- withStore' $ \db -> getNoteFolderFileInfo db user nf
withChatLock "clearChat local" . procCmd $ do
deleteFilesLocally filesInfo
withStore' $ \db -> deleteNoteFolderFiles db userId nf
withStore' $ \db -> deleteNoteFolderCIs db user nf
pure $ CRChatCleared user (AChatInfo SCTLocal $ LocalChat nf)
deleteFilesLocally filesInfo
withStore' $ \db -> deleteNoteFolderFiles db userId nf
withStore' $ \db -> deleteNoteFolderCIs db user nf
pure $ CRChatCleared user (AChatInfo SCTLocal $ LocalChat nf)
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
APIAcceptContact incognito connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do
APIAcceptContact incognito connReqId -> withUser $ \_ -> do
(user@User {userId}, cReq@UserContactRequest {userContactLinkId}) <- withStore $ \db -> getContactRequest' db connReqId
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
let contactUsed = (\(_, groupId_, _) -> isNothing groupId_) ucl
-- [incognito] generate profile to send, create connection with incognito profile
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
ct <- acceptContactRequest user cReq incognitoProfile contactUsed
pure $ CRAcceptingContactRequest user ct
APIRejectContact connReqId -> withUser $ \user -> withChatLock "rejectContact" $ do
cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <-
withUserContactLock "acceptContact" userContactLinkId $ do
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
let contactUsed = (\(_, groupId_, _) -> isNothing groupId_) ucl
-- [incognito] generate profile to send, create connection with incognito profile
incognitoProfile <- if incognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
ct <- acceptContactRequest user cReq incognitoProfile contactUsed
pure $ CRAcceptingContactRequest user ct
APIRejectContact connReqId -> withUser $ \user -> do
cReq@UserContactRequest {userContactLinkId, agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <-
withStore $ \db ->
getContactRequest db user connReqId
`storeFinally` liftIO (deleteContactRequest db user connReqId)
withAgent $ \a -> rejectContact a connId invId
pure $ CRContactRequestRejected user cReq
withUserContactLock "rejectContact" userContactLinkId $ do
withAgent $ \a -> rejectContact a connId invId
pure $ CRContactRequestRejected user cReq
APISendCallInvitation contactId callType -> withUser $ \user -> do
-- party initiating call
ct <- withStore $ \db -> getContact db vr user contactId
@@ -1030,7 +1069,7 @@ processChatCommand' vr = \case
if featureAllowed SCFCalls forUser ct
then do
calls <- asks currentCalls
withChatLock "sendCallInvitation" $ do
withContactLock "sendCallInvitation" contactId $ do
g <- asks random
callId <- atomically $ CallId <$> C.randomBytes 16 g
dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing
@@ -1155,12 +1194,11 @@ processChatCommand' vr = \case
toServerCfg server = ServerCfg {server, preset = True, tested = Nothing, enabled = True}
GetUserProtoServers aProtocol -> withUser $ \User {userId} ->
processChatCommand $ APIGetUserProtoServers userId aProtocol
APISetUserProtoServers userId (APSC p (ProtoServersConfig servers)) -> withUserId userId $ \user -> withServerProtocol p $
withChatLock "setUserSMPServers" $ do
withStore $ \db -> overwriteProtocolServers db user servers
cfg <- asks config
lift $ withAgent' $ \a -> setProtocolServers a (aUserId user) $ activeAgentServers cfg p servers
ok user
APISetUserProtoServers userId (APSC p (ProtoServersConfig servers)) -> withUserId userId $ \user -> withServerProtocol p $ do
withStore $ \db -> overwriteProtocolServers db user servers
cfg <- asks config
lift $ withAgent' $ \a -> setProtocolServers a (aUserId user) $ activeAgentServers cfg p servers
ok user
SetUserProtoServers serversConfig -> withUser $ \User {userId} ->
processChatCommand $ APISetUserProtoServers userId serversConfig
APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user ->
@@ -1263,7 +1301,7 @@ processChatCommand' vr = \case
connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId
pure $ CRGroupMemberSwitchAborted user g m connectionStats
_ -> throwChatError CEGroupMemberNotActive
APISyncContactRatchet contactId force -> withUser $ \user -> withChatLock "syncContactRatchet" $ do
APISyncContactRatchet contactId force -> withUser $ \user -> withContactLock "syncContactRatchet" contactId $ do
ct <- withStore $ \db -> getContact db vr user contactId
case contactConn ct of
Just conn@Connection {pqSupport} -> do
@@ -1271,7 +1309,7 @@ processChatCommand' vr = \case
createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing
pure $ CRContactRatchetSyncStarted user ct cStats
Nothing -> throwChatError $ CEContactNotActive ct
APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> withChatLock "syncGroupMemberRatchet" $ do
APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> withGroupLock "syncGroupMemberRatchet" gId $ do
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
case memberConnId m of
Just connId -> do
@@ -1360,7 +1398,7 @@ processChatCommand' vr = \case
EnableGroupMember gName mName -> withMemberName gName mName $ \gId mId -> APIEnableGroupMember gId mId
ChatHelp section -> pure $ CRChatHelp section
Welcome -> withUser $ pure . CRWelcome
APIAddContact userId incognito -> withUserId userId $ \user -> withChatLock "addContact" . procCmd $ do
APIAddContact userId incognito -> withUserId userId $ \user -> procCmd $ do
-- [incognito] generate profile for connection
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
subMode <- chatReadVar subscriptionMode
@@ -1387,9 +1425,8 @@ processChatCommand' vr = \case
Just conn' -> pure $ CRConnectionIncognitoUpdated user conn'
Nothing -> throwChatError CEConnectionIncognitoChangeProhibited
APIConnectPlan userId cReqUri -> withUserId userId $ \user ->
withChatLock "connectPlan" . procCmd $
CRConnectionPlan user <$> connectPlan user cReqUri
APIConnect userId incognito (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
CRConnectionPlan user <$> connectPlan user cReqUri
APIConnect userId incognito (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withInvitationLock "connect" (strEncode cReq) . procCmd $ do
subMode <- chatReadVar subscriptionMode
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
@@ -1434,7 +1471,7 @@ processChatCommand' vr = \case
CRContactsList user <$> withStore' (\db -> getUserContacts db vr user)
ListContacts -> withUser $ \User {userId} ->
processChatCommand $ APIListContacts userId
APICreateMyAddress userId -> withUserId userId $ \user -> withChatLock "createMyAddress" . procCmd $ do
APICreateMyAddress userId -> withUserId userId $ \user -> procCmd $ do
subMode <- chatReadVar subscriptionMode
-- TODO v5.7 pass IPPQOn
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing IKPQOff subMode
@@ -1513,8 +1550,9 @@ processChatCommand' vr = \case
let mc = MCText msg
case memberContactId m of
Nothing -> do
gInfo <- withStore $ \db -> getGroupInfo db vr user gId
toView $ CRNoMemberContactCreating user gInfo m
g <- withStore $ \db -> getGroupInfo db vr user gId
unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwChatError $ CECommandError "direct messages not allowed"
toView $ CRNoMemberContactCreating user g m
processChatCommand (APICreateMemberContact gId mId) >>= \case
cr@(CRNewMemberContact _ Contact {contactId} _ _) -> do
toView cr
@@ -1609,7 +1647,7 @@ processChatCommand' vr = \case
pure $ CRGroupCreated user groupInfo
NewGroup incognito gProfile -> withUser $ \User {userId} ->
processChatCommand $ APINewGroup userId incognito gProfile
APIAddMember groupId contactId memRole -> withUser $ \user -> withChatLock "addMember" $ do
APIAddMember groupId contactId memRole -> withUser $ \user -> withGroupLock "addMember" groupId $ do
-- TODO for large groups: no need to load all members to determine if contact is a member
(group, contact) <- withStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db vr user contactId
assertDirectAllowed user MDSnd contact XGrpInv_
@@ -1639,7 +1677,7 @@ processChatCommand' vr = \case
Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName
| otherwise -> throwChatError $ CEGroupDuplicateMember cName
APIJoinGroup groupId -> withUser $ \user@User {userId} -> do
withChatLock "joinGroup" . procCmd $ do
withGroupLock "joinGroup" groupId . procCmd $ do
(invitation, ct) <- withStore $ \db -> do
inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db vr user groupId
(inv,) <$> getContactViaMember db vr user fromMember
@@ -1670,7 +1708,7 @@ processChatCommand' vr = \case
changeMemberRole user gInfo members m gEvent = do
let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m
assertUserGroupRole gInfo $ maximum [GRAdmin, mRole, memRole]
withChatLock "memberRole" . procCmd $ do
withGroupLock "memberRole" groupId . procCmd $ do
unless (mRole == memRole) $ do
withStore' $ \db -> updateGroupMemberRole db user m memRole
case mStatus of
@@ -1692,7 +1730,7 @@ processChatCommand' vr = \case
let GroupMember {memberId = bmMemberId, memberRole = bmRole, memberProfile = bmp} = bm
assertUserGroupRole gInfo $ max GRAdmin bmRole
when (blocked == blockedByAdmin bm) $ throwChatError $ CECommandError $ if blocked then "already blocked" else "already unblocked"
withChatLock "blockForAll" . procCmd $ do
withGroupLock "blockForAll" groupId . procCmd $ do
let mrs = if blocked then MRSBlocked else MRSUnrestricted
event = XGrpMemRestrict bmMemberId MemberRestrictions {restriction = mrs}
(msg, _) <- sendGroupMessage' user gInfo remainingMembers event
@@ -1714,7 +1752,7 @@ processChatCommand' vr = \case
Nothing -> throwChatError CEGroupMemberNotFound
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberProfile} -> do
assertUserGroupRole gInfo $ max GRAdmin mRole
withChatLock "removeMember" . procCmd $ do
withGroupLock "removeMember" groupId . procCmd $ do
case mStatus of
GSMemInvited -> do
deleteMemberConnection user m
@@ -1730,7 +1768,7 @@ processChatCommand' vr = \case
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user groupId
filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo
withChatLock "leaveGroup" . procCmd $ do
withGroupLock "leaveGroup" groupId . procCmd $ do
cancelFilesInProgress user filesInfo
(msg, _) <- sendGroupMessage' user gInfo members XGrpLeave
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
@@ -1780,7 +1818,7 @@ processChatCommand' vr = \case
updateGroupProfileByName gName $ \p -> p {description}
ShowGroupDescription gName -> withUser $ \user ->
CRGroupDescription user <$> withStore (\db -> getGroupInfoByName db vr user gName)
APICreateGroupLink groupId mRole -> withUser $ \user -> withChatLock "createGroupLink" $ do
APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
assertUserGroupRole gInfo GRAdmin
when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole
@@ -1790,14 +1828,14 @@ processChatCommand' vr = \case
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) IKPQOff subMode
withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole subMode
pure $ CRGroupLinkCreated user gInfo cReq mRole
APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withChatLock "groupLinkMemberRole " $ do
APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withGroupLock "groupLinkMemberRole" groupId $ do
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
(groupLinkId, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo
assertUserGroupRole gInfo GRAdmin
when (mRole' > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole'
when (mRole' /= mRole) $ withStore' $ \db -> setGroupLinkMemberRole db user groupLinkId mRole'
pure $ CRGroupLink user gInfo groupLink mRole'
APIDeleteGroupLink groupId -> withUser $ \user -> withChatLock "deleteGroupLink" $ do
APIDeleteGroupLink groupId -> withUser $ \user -> withGroupLock "deleteGroupLink" groupId $ do
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
deleteGroupLink' user gInfo
pure $ CRGroupLinkDeleted user gInfo
@@ -1808,7 +1846,7 @@ processChatCommand' vr = \case
APICreateMemberContact gId gMemberId -> withUser $ \user -> do
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId
assertUserGroupRole g GRAuthor
unless (groupFeatureAllowed SGFDirectMessages g) $ throwChatError $ CECommandError "direct messages not allowed"
unless (groupFeatureMemberAllowed SGFDirectMessages (membership g) g) $ throwChatError $ CECommandError "direct messages not allowed"
case memberConn m of
Just mConn@Connection {peerChatVRange} -> do
unless (maxVersion peerChatVRange >= groupDirectInvVersion) $ throwChatError CEPeerChatVRangeIncompatible
@@ -1910,19 +1948,19 @@ processChatCommand' vr = \case
ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
ReceiveFile fileId encrypted_ rcvInline_ filePath_ -> withUser $ \_ ->
withChatLock "receiveFile" . procCmd $ do
withFileLock "receiveFile" fileId . procCmd $ do
(user, ft) <- withStore (`getRcvFileTransferById` fileId)
encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles
ft' <- (if encrypt then setFileToEncrypt else pure) ft
receiveFile' user ft' rcvInline_ filePath_
SetFileToReceive fileId encrypted_ -> withUser $ \_ -> do
withChatLock "setFileToReceive" . procCmd $ do
withFileLock "setFileToReceive" fileId . procCmd $ do
encrypt <- (`fromMaybe` encrypted_) <$> chatReadVar encryptLocalFiles
cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing
withStore' $ \db -> setRcvFileToReceive db fileId cfArgs
ok_
CancelFile fileId -> withUser $ \user@User {userId} ->
withChatLock "cancelFile" . procCmd $
withFileLock "cancelFile" fileId . procCmd $
withStore (\db -> getFileTransfer db user fileId) >>= \case
FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts
| cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled"
@@ -1994,9 +2032,12 @@ processChatCommand' vr = \case
ct@Contact {userPreferences} <- withStore $ \db -> getContactByName db vr user cName
let prefs' = setPreference f allowed_ $ Just userPreferences
updateContactPrefs user ct prefs'
SetGroupFeature (AGF f) gName enabled ->
SetGroupFeature (AGFNR f) gName enabled ->
updateGroupProfileByName gName $ \p ->
p {groupPreferences = Just . setGroupPreference f enabled $ groupPreferences p}
SetGroupFeatureRole (AGFR f) gName enabled role ->
updateGroupProfileByName gName $ \p ->
p {groupPreferences = Just . setGroupPreferenceRole f enabled role $ groupPreferences p}
SetUserTimedMessages onOff -> withUser $ \user@User {profile} -> do
let allowed = if onOff then FAYes else FANo
pref = TimedMessagesPreference allowed Nothing
@@ -2052,8 +2093,18 @@ processChatCommand' vr = \case
pure $ CRVersionInfo {versionInfo, chatMigrations, agentMigrations}
DebugLocks -> lift $ do
chatLockName <- atomically . tryReadTMVar =<< asks chatLock
chatEntityLocks <- getLocks =<< asks entityLocks
agentLocks <- withAgent' debugAgentLocks
pure CRDebugLocks {chatLockName, agentLocks}
pure CRDebugLocks {chatLockName, chatEntityLocks, agentLocks}
where
getLocks ls = atomically $ M.mapKeys enityLockString . M.mapMaybe id <$> (mapM tryReadTMVar =<< readTVar ls)
enityLockString cle = case cle of
CLInvitation bs -> "Invitation " <> B.unpack bs
CLConnection connId -> "Connection " <> show connId
CLContact ctId -> "Contact " <> show ctId
CLGroup gId -> "Group " <> show gId
CLUserContact ucId -> "UserContact " <> show ucId
CLFile fId -> "File " <> show fId
GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary
GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails
GetAgentStats -> lift $ CRAgentStats . map stat <$> withAgent' getAgentStats
@@ -2144,7 +2195,7 @@ processChatCommand' vr = \case
CTLocal -> withStore $ \db -> getLocalChatItemIdByText' db user cId msg
_ -> throwChatError $ CECommandError "not supported"
connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> CM ChatResponse
connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withInvitationLock "connectViaContact" (strEncode cReq) $ do
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
case groupLinkId of
@@ -2175,7 +2226,7 @@ processChatCommand' vr = \case
pure $ CRSentInvitation user conn incognitoProfile
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> CM ChatResponse
connectContactViaAddress user incognito ct cReq =
withChatLock "connectViaContact" $ do
withInvitationLock "connectContactViaAddress" (strEncode cReq) $ do
newXContactId <- XContactId <$> drgRandomBytes 16
pqSup <- chatReadVar pqExperimentalEnabled
(connId, incognitoProfile, subMode, chatV) <- requestContact user incognito cReq newXContactId False pqSup
@@ -2267,7 +2318,7 @@ processChatCommand' vr = \case
let mergedProfile = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct) False
mergedProfile' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False
when (mergedProfile' /= mergedProfile) $
withChatLock "updateProfile" $ do
withContactLock "updateProfile" (contactId' ct) $ do
void (sendDirectContactMessage user ct' $ XInfo mergedProfile') `catchChatError` (toView . CRChatError (Just user))
lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct'
pure $ CRContactPrefsUpdated user ct ct'
@@ -2312,7 +2363,7 @@ processChatCommand' vr = \case
user <- getUserByContactId db ctId
(user,) <$> getContact db vr user ctId
calls <- asks currentCalls
withChatLock "currentCall" $
withContactLock "currentCall" ctId $
atomically (TM.lookup ctId calls) >>= \case
Nothing -> throwChatError CENoCurrentCall
Just call@Call {contactId}
@@ -2559,10 +2610,10 @@ processChatCommand' vr = \case
assertUserGroupRole gInfo GRAuthor
send g
where
send g@(Group gInfo ms)
| isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
| not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
| otherwise = do
send g@(Group gInfo@GroupInfo {membership} ms) =
case prohibitedGroupContent gInfo membership mc file_ of
Just f -> notAllowedError f
Nothing -> do
(fInv_, ciFile_) <- L.unzip <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
timed_ <- sndGroupCITimed live gInfo itemTTL
(msgContainer, quotedItem_) <- prepareGroupMsg user gInfo mc quotedItemId_ itemForwarded fInv_ timed_ live
@@ -2676,7 +2727,7 @@ assertDirectAllowed user dir ct event =
unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $
throwChatError (CEDirectMessagesProhibited dir ct)
where
directMessagesAllowed = any (groupFeatureAllowed' SGFDirectMessages) <$> withStore' (\db -> getContactGroupPreferences db user ct)
directMessagesAllowed = any (uncurry $ groupFeatureMemberAllowed' SGFDirectMessages) <$> withStore' (\db -> getContactGroupPreferences db user ct)
allowedChatEvent = case event of
XMsgNew_ -> False
XMsgUpdate_ -> False
@@ -2686,6 +2737,13 @@ assertDirectAllowed user dir ct event =
XCallInv_ -> False
_ -> True
prohibitedGroupContent :: GroupInfo -> GroupMember -> MsgContent -> Maybe f -> Maybe GroupFeature
prohibitedGroupContent gInfo m mc file_
| isVoice mc && not (groupFeatureMemberAllowed SGFVoice m gInfo) = Just GFVoice
| not (isVoice mc) && isJust file_ && not (groupFeatureMemberAllowed SGFFiles m gInfo) = Just GFFiles
| not (groupFeatureMemberAllowed SGFSimplexLinks m gInfo) && containsFormat isSimplexLink (parseMarkdown $ msgContentText mc) = Just GFSimplexLinks
| otherwise = Nothing
roundedFDCount :: Int -> Int
roundedFDCount n
| n <= 0 = 4
@@ -3066,21 +3124,16 @@ deleteGroupLink_ user gInfo conn = do
agentSubscriber :: CM' ()
agentSubscriber = do
q <- asks $ subQ . smpAgent
l <- asks chatLock
forever $ atomically (readTBQueue q) >>= process l
forever $ atomically (readTBQueue q) >>= process
where
process :: Lock -> (ACorrId, EntityId, APartyCmd 'Agent) -> CM' ()
process l (corrId, entId, APC e msg) = run $ case e of
process :: (ACorrId, EntityId, APartyCmd 'Agent) -> CM' ()
process (corrId, entId, APC e msg) = run $ case e of
SAENone -> processAgentMessageNoConn msg
SAEConn -> processAgentMessage corrId entId msg
SAERcvFile -> processAgentMsgRcvFile corrId entId msg
SAESndFile -> processAgentMsgSndFile corrId entId msg
where
run action = do
let name = "agentSubscriber entity=" <> show e <> " entId=" <> str entId <> " msg=" <> str (aCommandTag msg)
withLock' l name $ action `catchChatError'` (toView' . CRChatError Nothing)
str :: StrEncoding a => a -> String
str = B.unpack . strEncode
run action = action `catchChatError'` (toView' . CRChatError Nothing)
type AgentBatchSubscribe = AgentClient -> [ConnId] -> ExceptT AgentErrorType IO (Map ConnId (Either AgentErrorType ()))
@@ -3228,8 +3281,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
forM_ err_ $ toView . CRSndFileSubError user ft
void . forkIO $ do
threadDelay 1000000
l <- asks chatLock
when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withLock l "subscribe sendFileChunk" $
when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withChatLock "subscribe sendFileChunk" $
sendFileChunk user ft
rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> CM ()
rcvFileSubsToView rs = mapM_ (toView . uncurry (CRRcvFileSubError user)) . filterErrors . resultsFor rs
@@ -3395,11 +3447,13 @@ processAgentMessage _ connId (DEL_RCVQ srv qId err_) =
processAgentMessage _ connId DEL_CONN =
toView $ CRAgentConnDeleted (AgentConnId connId)
processAgentMessage corrId connId msg = do
vr <- chatVersionRange
-- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here
critical (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case
Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user))
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
lockEntity <- critical (withStore (`getChatLockEntity` AgentConnId connId))
withEntityLock "processAgentMessage" lockEntity $ do
vr <- chatVersionRange
-- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here
critical (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case
Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user))
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
-- CRITICAL error will be shown to the user as alert with restart button in Android/desktop apps.
-- SEDBBusyError will only be thrown on IO exceptions or SQLError during DB queries,
@@ -3436,18 +3490,18 @@ processAgentMessageNoConn = \case
toView $ event srv cs
processAgentMsgSndFile :: ACorrId -> SndFileId -> ACommand 'Agent 'AESndFile -> CM ()
processAgentMsgSndFile _corrId aFileId msg =
withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case
Just user -> process user `catchChatError` (toView . CRChatError (Just user))
_ -> do
lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId
processAgentMsgSndFile _corrId aFileId msg = do
fileId <- withStore (`getXFTPSndFileDBId` AgentSndFileId aFileId)
withFileLock "processAgentMsgSndFile" fileId $
withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case
Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user))
_ -> do
lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
throwChatError $ CENoSndFileUser $ AgentSndFileId aFileId
where
process :: User -> CM ()
process user = do
(ft@FileTransferMeta {fileId, xftpRedirectFor, cancelled}, sfts) <- withStore $ \db -> do
fileId <- getXFTPSndFileDBId db user $ AgentSndFileId aFileId
getSndFileTransfer db user fileId
process :: User -> FileTransferId -> CM ()
process user fileId = do
(ft@FileTransferMeta {xftpRedirectFor, cancelled}, sfts) <- withStore $ \db -> getSndFileTransfer db user fileId
vr <- chatVersionRange
unless cancelled $ case msg of
SFPROG sndProgress sndTotal -> do
@@ -3464,11 +3518,11 @@ processAgentMsgSndFile _corrId aFileId msg =
lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText rfds)
case rfds of
[] -> sendFileError "no receiver descriptions" fileId vr ft
[] -> sendFileError "no receiver descriptions" vr ft
rfd : _ -> case [fd | fd@(FD.ValidFileDescription FD.FileDescription {chunks = [_]}) <- rfds] of
[] -> case xftpRedirectFor of
Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CRSndFileRedirectStartXFTP user ft
Just _ -> sendFileError "Prohibit chaining redirects" fileId vr ft
Just _ -> sendFileError "Prohibit chaining redirects" vr ft
rfds' -> do
-- we have 1 chunk - use it as URI whether it is redirect or not
ft' <- maybe (pure ft) (\fId -> withStore $ \db -> getFileTransferMeta db user fId) xftpRedirectFor
@@ -3517,7 +3571,7 @@ processAgentMsgSndFile _corrId aFileId msg =
| temporaryAgentError e ->
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
| otherwise ->
sendFileError (tshow e) fileId vr ft
sendFileError (tshow e) vr ft
where
fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text
fileDescrText = safeDecodeUtf8 . strEncode
@@ -3535,8 +3589,8 @@ processAgentMsgSndFile _corrId aFileId msg =
case L.nonEmpty fds of
Just fds' -> loopSend fds'
Nothing -> pure msgDeliveryId
sendFileError :: Text -> Int64 -> (PQSupport -> VersionRangeChat) -> FileTransferMeta -> CM ()
sendFileError err fileId vr ft = do
sendFileError :: Text -> (PQSupport -> VersionRangeChat) -> FileTransferMeta -> CM ()
sendFileError err vr ft = do
logError $ "Sent file error: " <> err
ci <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId CIFSSndError
@@ -3558,18 +3612,18 @@ splitFileDescr rfdText = do
else fileDescr <| splitParts (partNo + 1) partSize rest
processAgentMsgRcvFile :: ACorrId -> RcvFileId -> ACommand 'Agent 'AERcvFile -> CM ()
processAgentMsgRcvFile _corrId aFileId msg =
withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case
Just user -> process user `catchChatError` (toView . CRChatError (Just user))
_ -> do
lift $ withAgent' (`xftpDeleteRcvFile` aFileId)
throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId
processAgentMsgRcvFile _corrId aFileId msg = do
fileId <- withStore (`getXFTPRcvFileDBId` AgentRcvFileId aFileId)
withFileLock "processAgentMsgRcvFile" fileId $
withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case
Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user))
_ -> do
lift $ withAgent' (`xftpDeleteRcvFile` aFileId)
throwChatError $ CENoRcvFileUser $ AgentRcvFileId aFileId
where
process :: User -> CM ()
process user = do
ft@RcvFileTransfer {fileId} <- withStore $ \db -> do
fileId <- getXFTPRcvFileDBId db $ AgentRcvFileId aFileId
getRcvFileTransfer db user fileId
process :: User -> FileTransferId -> CM ()
process user fileId = do
ft <- withStore $ \db -> getRcvFileTransfer db user fileId
vr <- chatVersionRange
unless (rcvFileCompleteOrCancelled ft) $ case msg of
RFPROG rcvProgress rcvTotal -> do
@@ -3713,7 +3767,6 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
(conn'', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveDirectRcvMSG conn' msgMeta msgBody
let ct'' = ct' {activeConn = Just conn''} :: Contact
assertDirectAllowed user MDRcv ct'' $ toCMEventTag event
updateChatLock "direct message" event
case event of
XMsgNew mc -> newContentMessage ct'' mc msg msgMeta
XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct'' sharedMsgId fileDescr
@@ -4132,7 +4185,6 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
processEvent :: MsgEncodingI e => ChatMessage e -> CM ()
processEvent chatMsg = do
(m', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m conn msgMeta msgBody chatMsg
updateChatLock "groupMessage" event
case event of
XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False
XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr
@@ -4468,13 +4520,6 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView $ CRConnectionDisabled connEntity
_ -> pure ()
updateChatLock :: MsgEncodingI enc => String -> ChatMsgEvent enc -> CM ()
updateChatLock name event = do
l <- asks chatLock
atomically $ tryReadTMVar l >>= mapM_ (swapTMVar l . (<> s))
where
s = " " <> name <> "=" <> B.unpack (strEncode $ toCMEventTag event)
-- TODO v5.7 / v6.0 - together with deprecating old group protocol establishing direct connections?
-- we could save command records only for agent APIs we process continuations for (INV)
withCompletedCommand :: forall e. AEntityI e => Connection -> ACommand 'Agent e -> (CommandData -> CM ()) -> CM ()
@@ -4783,14 +4828,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> CM ()
newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded
| blockedByAdmin m = createBlockedByAdmin
| isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
| not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
| otherwise =
withStore' (\db -> getCIModeration db vr user gInfo memberId sharedMsgId_) >>= \case
Just ciModeration -> do
applyModeration ciModeration
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
Nothing -> createContentItem
| otherwise = case prohibitedGroupContent gInfo m content fInv_ of
Just f -> rejected f
Nothing ->
withStore' (\db -> getCIModeration db vr user gInfo memberId sharedMsgId_) >>= \case
Just ciModeration -> do
applyModeration ciModeration
withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
Nothing -> createContentItem
where
rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
timed' = if forwarded then rcvCITimed_ (Just Nothing) itemTTL else rcvGroupCITimed gInfo itemTTL
@@ -5233,8 +5278,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
createGroupFeatureItems g@GroupInfo {fullGroupPreferences} m =
forM_ allGroupFeatures $ \(AGF f) -> do
let p = getGroupPreference f fullGroupPreferences
(_, param) = groupFeatureState p
createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing
(_, param, role) = groupFeatureState p
createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param role) Nothing
xInfoProbe :: ContactOrMember -> Probe -> CM ()
xInfoProbe cgm2 probe = do
@@ -5745,7 +5790,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> UTCTime -> CM ()
xGrpDirectInv g m mConn connReq mContent_ msg brokerTs = do
unless (groupFeatureAllowed SGFDirectMessages g) $ messageError "x.grp.direct.inv: direct messages not allowed"
unless (groupFeatureMemberAllowed SGFDirectMessages m g) $ messageError "x.grp.direct.inv: direct messages not allowed"
let GroupMember {memberContactId} = m
subMode <- chatReadVar subscriptionMode
case memberContactId of
@@ -6725,14 +6770,14 @@ createContactsFeatureItems user cts chatDir ciFeature ciOffer getPref = do
cup = getContactUserPreference f cups
cup' = getContactUserPreference f cups'
createGroupFeatureChangedItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> CIContent d) -> GroupInfo -> GroupInfo -> CM ()
createGroupFeatureChangedItems :: MsgDirectionI d => User -> ChatDirection 'CTGroup d -> (GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent d) -> GroupInfo -> GroupInfo -> CM ()
createGroupFeatureChangedItems user cd ciContent GroupInfo {fullGroupPreferences = gps} GroupInfo {fullGroupPreferences = gps'} =
forM_ allGroupFeatures $ \(AGF f) -> do
let state = groupFeatureState $ getGroupPreference f gps
pref' = getGroupPreference f gps'
state'@(_, int') = groupFeatureState pref'
state'@(_, param', role') = groupFeatureState pref'
when (state /= state') $
createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref') int') Nothing
createInternalChatItem user cd (ciContent (toGroupFeature f) (toGroupPreference pref') param' role') Nothing
sameGroupProfileInfo :: GroupProfile -> GroupProfile -> Bool
sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferences = Nothing}
@@ -7096,20 +7141,22 @@ chatCommandP =
"/show profile image" $> ShowProfileImage,
("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> profileNames),
("/profile" <|> "/p") $> ShowProfile,
"/set voice #" *> (SetGroupFeature (AGF SGFVoice) <$> displayName <*> (A.space *> strP)),
"/set voice #" *> (SetGroupFeatureRole (AGFR SGFVoice) <$> displayName <*> _strP <*> optional memberRole),
"/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)),
"/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP),
"/set files #" *> (SetGroupFeature (AGF SGFFiles) <$> displayName <*> (A.space *> strP)),
"/set history #" *> (SetGroupFeature (AGF SGFHistory) <$> displayName <*> (A.space *> strP)),
"/set files #" *> (SetGroupFeatureRole (AGFR SGFFiles) <$> displayName <*> _strP <*> optional memberRole),
"/set history #" *> (SetGroupFeature (AGFNR SGFHistory) <$> displayName <*> (A.space *> strP)),
"/set reactions #" *> (SetGroupFeature (AGFNR SGFReactions) <$> displayName <*> (A.space *> strP)),
"/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayName <*> optional (A.space *> strP)),
"/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP),
"/set delete #" *> (SetGroupFeature (AGF SGFFullDelete) <$> displayName <*> (A.space *> strP)),
"/set delete #" *> (SetGroupFeature (AGFNR SGFFullDelete) <$> displayName <*> (A.space *> strP)),
"/set delete @" *> (SetContactFeature (ACF SCFFullDelete) <$> displayName <*> optional (A.space *> strP)),
"/set delete " *> (SetUserFeature (ACF SCFFullDelete) <$> strP),
"/set direct #" *> (SetGroupFeature (AGF SGFDirectMessages) <$> displayName <*> (A.space *> strP)),
"/set direct #" *> (SetGroupFeatureRole (AGFR SGFDirectMessages) <$> displayName <*> _strP <*> optional memberRole),
"/set disappear #" *> (SetGroupTimedMessages <$> displayName <*> (A.space *> timedTTLOnOffP)),
"/set disappear @" *> (SetContactTimedMessages <$> displayName <*> optional (A.space *> timedMessagesEnabledP)),
"/set disappear " *> (SetUserTimedMessages <$> (("yes" $> True) <|> ("no" $> False))),
"/set links #" *> (SetGroupFeatureRole (AGFR SGFSimplexLinks) <$> displayName <*> _strP <*> optional memberRole),
("/incognito" <* optional (A.space *> onOffP)) $> ChatHelp HSIncognito,
"/set device name " *> (SetLocalDeviceName <$> textP),
"/list remote hosts" $> ListRemoteHosts,
@@ -7198,7 +7245,7 @@ chatCommandP =
let groupPreferences =
Just
(emptyGroupPrefs :: GroupPreferences)
{ directMessages = Just DirectMessagesGroupPreference {enable = FEOn},
{ directMessages = Just DirectMessagesGroupPreference {enable = FEOn, role = Nothing},
history = Just HistoryGroupPreference {enable = FEOn}
}
pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences}
src/Simplex/Chat/Controller.hs
+11 -8
View File
@@ -59,9 +59,10 @@ import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
import Simplex.Chat.Remote.AppVersion
import Simplex.Chat.Remote.Types
import Simplex.Chat.Store (AutoAccept, StoreError (..), UserContactLink, UserMsgReceiptSettings)
import Simplex.Chat.Store (AutoAccept, ChatLockEntity, StoreError (..), UserContactLink, UserMsgReceiptSettings)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Util (liftIOEither)
import Simplex.FileTransfer.Description (FileDescriptionURI)
import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
@@ -165,7 +166,7 @@ defaultChatHooks =
ChatHooks
{ preCmdHook = \_ -> pure . Right,
eventHook = \_ -> pure
}
}
data DefaultAgentServers = DefaultAgentServers
{ smp :: NonEmpty SMPServerWithAuth,
@@ -208,6 +209,7 @@ data ChatController = ChatController
connNetworkStatuses :: TMap AgentConnId NetworkStatus,
subscriptionMode :: TVar SubscriptionMode,
chatLock :: Lock,
entityLocks :: TMap ChatLockEntity Lock,
sndFiles :: TVar (Map Int64 Handle),
rcvFiles :: TVar (Map Int64 Handle),
currentCalls :: TMap ContactId Call,
@@ -464,7 +466,8 @@ data ChatCommand
| ShowProfileImage
| SetUserFeature AChatFeature FeatureAllowed -- UserId (not used in UI)
| SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed)
| SetGroupFeature AGroupFeature GroupName GroupFeatureEnabled
| SetGroupFeature AGroupFeatureNoRole GroupName GroupFeatureEnabled
| SetGroupFeatureRole AGroupFeatureRole GroupName GroupFeatureEnabled (Maybe GroupMemberRole)
| SetUserTimedMessages Bool -- UserId (not used in UI)
| SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
| SetGroupTimedMessages GroupName (Maybe Int)
@@ -495,9 +498,9 @@ data ChatCommand
| GetAgentSubsDetails
| GetAgentWorkers
| GetAgentWorkersDetails
-- The parser will return this command for strings that start from "//".
-- This command should be processed in preCmdHook
| CustomChatCommand ByteString
| -- The parser will return this command for strings that start from "//".
-- This command should be processed in preCmdHook
CustomChatCommand ByteString
deriving (Show)
allowRemoteCommand :: ChatCommand -> Bool -- XXX: consider using Relay/Block/ForceLocal
@@ -735,7 +738,7 @@ data ChatResponse
| CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption}
| CRSQLResult {rows :: [Text]}
| CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
| CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
| CRDebugLocks {chatLockName :: Maybe String, chatEntityLocks :: Map String String, agentLocks :: AgentLocks}
| CRAgentStats {agentStats :: [[String]]}
| CRAgentWorkersDetails {agentWorkersDetails :: AgentWorkersDetails}
| CRAgentWorkersSummary {agentWorkersSummary :: AgentWorkersSummary}
@@ -1358,7 +1361,7 @@ handleDBErrors =
[ E.Handler $ \(e :: SQLError) ->
let se = SQL.sqlError e
busy = se == SQL.ErrorBusy || se == SQL.ErrorLocked
in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e,
in pure . Left . ChatErrorStore $ if busy then SEDBBusyError $ show se else SEDBException $ show e,
E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
]
src/Simplex/Chat/Markdown.hs
+9
View File
@@ -144,6 +144,15 @@ markdownToList (m1 :|: m2) = markdownToList m1 <> markdownToList m2
parseMarkdown :: Text -> Markdown
parseMarkdown s = fromRight (unmarked s) $ A.parseOnly (markdownP <* A.endOfInput) s
containsFormat :: (Format -> Bool) -> Markdown -> Bool
containsFormat p (Markdown f _) = maybe False p f
containsFormat p (m1 :|: m2) = containsFormat p m1 || containsFormat p m2
isSimplexLink :: Format -> Bool
isSimplexLink = \case
SimplexLink {} -> True;
_ -> False
markdownP :: Parser Markdown
markdownP = mconcat <$> A.many' fragmentP
where
src/Simplex/Chat/Messages.hs
+1 -1
View File
@@ -24,6 +24,7 @@ import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.TH as JQ
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (isSpace)
import Data.Int (Int64)
@@ -47,7 +48,6 @@ import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..))
import Simplex.Messaging.Crypto.File (CryptoFile (..))
import qualified Simplex.Messaging.Crypto.File as CF
import qualified Simplex.Messaging.Encoding.Base64 as B64
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON)
import Simplex.Messaging.Protocol (MsgBody)
src/Simplex/Chat/Messages/CIContent.hs
+17 -16
View File
@@ -28,6 +28,7 @@ import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.Util
import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), RatchetSyncState (..), SwitchPhase (..))
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOn, pattern PQEncOff)
@@ -134,8 +135,8 @@ data CIContent (d :: MsgDirection) where
CISndChatFeature :: ChatFeature -> PrefEnabled -> Maybe Int -> CIContent 'MDSnd
CIRcvChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDRcv
CISndChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDSnd
CIRcvGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDRcv
CISndGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDSnd
CIRcvGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent 'MDRcv
CISndGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> Maybe GroupMemberRole -> CIContent 'MDSnd
CIRcvChatFeatureRejected :: ChatFeature -> CIContent 'MDRcv
CIRcvGroupFeatureRejected :: GroupFeature -> CIContent 'MDRcv
CISndModerated :: CIContent 'MDSnd
@@ -255,8 +256,8 @@ ciContentToText = \case
CISndChatFeature feature enabled param -> featureStateText feature enabled param
CIRcvChatPreference feature allowed param -> prefStateText feature allowed param
CISndChatPreference feature allowed param -> "you " <> prefStateText feature allowed param
CIRcvGroupFeature feature pref param -> groupPrefStateText feature pref param
CISndGroupFeature feature pref param -> groupPrefStateText feature pref param
CIRcvGroupFeature feature pref param role -> groupPrefStateText feature pref param role
CISndGroupFeature feature pref param role -> groupPrefStateText feature pref param role
CIRcvChatFeatureRejected feature -> chatFeatureNameText feature <> ": received, prohibited"
CIRcvGroupFeatureRejected feature -> groupFeatureNameText feature <> ": received, prohibited"
CISndModerated -> ciModeratedText
@@ -413,8 +414,8 @@ data JSONCIContent
| JCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int}
| JCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
| JCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
| JCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
| JCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
| JCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int, memberRole_ :: Maybe GroupMemberRole}
| JCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int, memberRole_ :: Maybe GroupMemberRole}
| JCIRcvChatFeatureRejected {feature :: ChatFeature}
| JCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
| JCISndModerated
@@ -447,8 +448,8 @@ jsonCIContent = \case
CISndChatFeature feature enabled param -> JCISndChatFeature {feature, enabled, param}
CIRcvChatPreference feature allowed param -> JCIRcvChatPreference {feature, allowed, param}
CISndChatPreference feature allowed param -> JCISndChatPreference {feature, allowed, param}
CIRcvGroupFeature groupFeature preference param -> JCIRcvGroupFeature {groupFeature, preference, param}
CISndGroupFeature groupFeature preference param -> JCISndGroupFeature {groupFeature, preference, param}
CIRcvGroupFeature groupFeature preference param memberRole_ -> JCIRcvGroupFeature {groupFeature, preference, param, memberRole_}
CISndGroupFeature groupFeature preference param memberRole_ -> JCISndGroupFeature {groupFeature, preference, param, memberRole_}
CIRcvChatFeatureRejected feature -> JCIRcvChatFeatureRejected {feature}
CIRcvGroupFeatureRejected groupFeature -> JCIRcvGroupFeatureRejected {groupFeature}
CISndModerated -> JCISndModerated
@@ -481,8 +482,8 @@ aciContentJSON = \case
JCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param
JCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param
JCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param
JCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param
JCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param
JCIRcvGroupFeature {groupFeature, preference, param, memberRole_} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param memberRole_
JCISndGroupFeature {groupFeature, preference, param, memberRole_} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param memberRole_
JCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature
JCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
JCISndModerated -> ACIContent SMDSnd CISndModerated
@@ -516,8 +517,8 @@ data DBJSONCIContent
| DBJCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int}
| DBJCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
| DBJCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int}
| DBJCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
| DBJCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int}
| DBJCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int, memberRole_ :: Maybe GroupMemberRole}
| DBJCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int, memberRole_ :: Maybe GroupMemberRole}
| DBJCIRcvChatFeatureRejected {feature :: ChatFeature}
| DBJCIRcvGroupFeatureRejected {groupFeature :: GroupFeature}
| DBJCISndModerated
@@ -550,8 +551,8 @@ dbJsonCIContent = \case
CISndChatFeature feature enabled param -> DBJCISndChatFeature {feature, enabled, param}
CIRcvChatPreference feature allowed param -> DBJCIRcvChatPreference {feature, allowed, param}
CISndChatPreference feature allowed param -> DBJCISndChatPreference {feature, allowed, param}
CIRcvGroupFeature groupFeature preference param -> DBJCIRcvGroupFeature {groupFeature, preference, param}
CISndGroupFeature groupFeature preference param -> DBJCISndGroupFeature {groupFeature, preference, param}
CIRcvGroupFeature groupFeature preference param memberRole_ -> DBJCIRcvGroupFeature {groupFeature, preference, param, memberRole_}
CISndGroupFeature groupFeature preference param memberRole_ -> DBJCISndGroupFeature {groupFeature, preference, param, memberRole_}
CIRcvChatFeatureRejected feature -> DBJCIRcvChatFeatureRejected {feature}
CIRcvGroupFeatureRejected groupFeature -> DBJCIRcvGroupFeatureRejected {groupFeature}
CISndModerated -> DBJCISndModerated
@@ -584,8 +585,8 @@ aciContentDBJSON = \case
DBJCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param
DBJCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param
DBJCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param
DBJCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param
DBJCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param
DBJCIRcvGroupFeature {groupFeature, preference, param, memberRole_} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param memberRole_
DBJCISndGroupFeature {groupFeature, preference, param, memberRole_} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param memberRole_
DBJCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature
DBJCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature
DBJCISndModerated -> ACIContent SMDSnd CISndModerated
src/Simplex/Chat/Messages/CIContent/Events.hs
+1
View File
@@ -7,6 +7,7 @@ module Simplex.Chat.Messages.CIContent.Events where
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson.TH as J
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (RatchetSyncState (..), SwitchPhase (..))
import Simplex.Messaging.Parsers (dropPrefix, singleFieldJSON, sumTypeJSON)
import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
src/Simplex/Chat/Mobile.hs
+1 -1
View File
@@ -17,6 +17,7 @@ import qualified Data.Aeson.TH as JQ
import Data.Bifunctor (first)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
@@ -49,7 +50,6 @@ import Simplex.Messaging.Agent.Env.SQLite (createAgentStore)
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, closeSQLiteStore, reopenSQLiteStore)
import Simplex.Messaging.Client (defaultNetworkConfig)
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Encoding.Base64.URL as U
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), BasicAuth (..), CorrId (..), ProtoServerWithAuth (..), ProtocolServer (..))
src/Simplex/Chat/Mobile/WebRTC.hs
+1 -1
View File
@@ -17,6 +17,7 @@ import Data.Bifunctor (bimap)
import qualified Data.ByteArray as BA
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64.URL as U
import Data.Either (fromLeft)
import Data.Word (Word8)
import Foreign.C (CInt, CString, newCAString)
@@ -25,7 +26,6 @@ import Foreign.StablePtr
import Simplex.Chat.Controller (ChatController (..))
import Simplex.Chat.Mobile.Shared
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Encoding.Base64.URL as U
import UnliftIO (atomically)
cChatEncryptMedia :: StablePtr ChatController -> CString -> Ptr Word8 -> CInt -> IO CString
src/Simplex/Chat/Protocol.hs
+2 -1
View File
@@ -45,10 +45,11 @@ import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Chat.Call
import Simplex.Chat.Types
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.Util
import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
import Simplex.Messaging.Compression (compress1, decompressBatch)
import Simplex.Messaging.Crypto.Ratchet (PQSupport (..), pattern PQSupportOn, pattern PQSupportOff)
import Simplex.Messaging.Crypto.Ratchet (PQSupport (..), pattern PQSupportOff, pattern PQSupportOn)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
src/Simplex/Chat/Remote.hs
+1 -1
View File
@@ -22,6 +22,7 @@ import Crypto.Random (getRandomBytes)
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as JT
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64.URL as B64U
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
@@ -55,7 +56,6 @@ import Simplex.Messaging.Agent
import Simplex.Messaging.Agent.Protocol (AgentErrorType (RCP))
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import qualified Simplex.Messaging.Encoding.Base64.URL as B64U
import Simplex.Messaging.Encoding.String (StrEncoding (..))
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (TLS, closeConnection, tlsUniq)
src/Simplex/Chat/Store.hs
+1
View File
@@ -1,6 +1,7 @@
module Simplex.Chat.Store
( SQLiteStore,
StoreError (..),
ChatLockEntity (..),
UserMsgReceiptSettings (..),
UserContactLink (..),
AutoAccept (..),
src/Simplex/Chat/Store/Connections.hs
+28 -1
View File
@@ -3,11 +3,13 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Store.Connections
( getConnectionEntity,
( getChatLockEntity,
getConnectionEntity,
getConnectionEntityByConnReq,
getContactConnEntityByConnReqHash,
getConnectionsToSubscribe,
@@ -37,6 +39,31 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Util (eitherToMaybe)
getChatLockEntity :: DB.Connection -> AgentConnId -> ExceptT StoreError IO ChatLockEntity
getChatLockEntity db agentConnId = do
((connId, connType) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId)) <-
ExceptT . firstRow id (SEConnectionNotFound agentConnId) $
DB.query
db
[sql|
SELECT connection_id, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id
FROM connections
WHERE agent_conn_id = ?
|]
(Only agentConnId)
let err = throwError $ SEInternalError $ "connection " <> show connType <> " without entity"
case connType of
ConnMember -> maybe err (fmap CLGroup . getMemberGroupId) groupMemberId
ConnContact -> pure $ maybe (CLConnection connId) CLContact contactId
ConnSndFile -> maybe err (pure . CLFile) sndFileId
ConnRcvFile -> maybe err (pure . CLFile) rcvFileId
ConnUserContact -> maybe err (pure . CLUserContact) userContactLinkId
where
getMemberGroupId :: GroupMemberId -> ExceptT StoreError IO GroupId
getMemberGroupId groupMemberId =
ExceptT . firstRow fromOnly (SEInternalError "group member connection group_id not found") $
DB.query db "SELECT group_id FROM group_members WHERE group_member_id = ?" (Only groupMemberId)
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_
src/Simplex/Chat/Store/Files.hs
+3 -3
View File
@@ -336,10 +336,10 @@ setSndFTAgentDeleted db User {userId} fileId = do
"UPDATE files SET agent_snd_file_deleted = 1, updated_at = ? WHERE user_id = ? AND file_id = ?"
(currentTs, userId, fileId)
getXFTPSndFileDBId :: DB.Connection -> User -> AgentSndFileId -> ExceptT StoreError IO FileTransferId
getXFTPSndFileDBId db User {userId} aSndFileId =
getXFTPSndFileDBId :: DB.Connection -> AgentSndFileId -> ExceptT StoreError IO FileTransferId
getXFTPSndFileDBId db aSndFileId =
ExceptT . firstRow fromOnly (SESndFileNotFoundXFTP aSndFileId) $
DB.query db "SELECT file_id FROM files WHERE user_id = ? AND agent_snd_file_id = ?" (userId, aSndFileId)
DB.query db "SELECT file_id FROM files WHERE agent_snd_file_id = ?" (Only aSndFileId)
getXFTPRcvFileDBId :: DB.Connection -> AgentRcvFileId -> ExceptT StoreError IO FileTransferId
getXFTPRcvFileDBId db aRcvFileId =
src/Simplex/Chat/Store/Groups.hs
+5 -3
View File
@@ -124,6 +124,7 @@ import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (second)
import Data.Either (rights)
import Data.Int (Int64)
import Data.List (partition, sortOn)
@@ -139,6 +140,7 @@ import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
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
@@ -668,13 +670,13 @@ getGroupSummary db User {userId} groupId = do
(userId, groupId, GSMemRemoved, GSMemLeft, GSMemUnknown, GSMemInvited)
pure GroupSummary {currentMembers = fromMaybe 0 currentMembers_}
getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [FullGroupPreferences]
getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [(GroupMemberRole, FullGroupPreferences)]
getContactGroupPreferences db User {userId} Contact {contactId} = do
map (mergeGroupPreferences . fromOnly)
map (second mergeGroupPreferences)
<$> DB.query
db
[sql|
SELECT gp.preferences
SELECT m.member_role, gp.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members m USING (group_id)
src/Simplex/Chat/Store/Profiles.hs
+1
View File
@@ -81,6 +81,7 @@ import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
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
src/Simplex/Chat/Store/Shared.hs
+10 -1
View File
@@ -18,6 +18,7 @@ import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import qualified Data.Aeson.TH as J
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Maybe (fromMaybe, isJust, listToMaybe)
@@ -38,13 +39,21 @@ 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 qualified Simplex.Messaging.Encoding.Base64 as B64
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (allFinally)
import Simplex.Messaging.Version
import UnliftIO.STM
data ChatLockEntity
= CLInvitation ByteString
| CLConnection Int64
| CLContact ContactId
| CLGroup GroupId
| CLUserContact Int64
| CLFile Int64
deriving (Eq, Ord)
-- These error type constructors must be added to mobile apps
data StoreError
= SEDuplicateName
src/Simplex/Chat/Types.hs
+6 -37
View File
@@ -30,7 +30,6 @@ import qualified Data.Aeson.TH as JQ
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString, pack, unpack)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.Maybe (isJust)
import Data.Text (Text)
@@ -45,6 +44,7 @@ import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
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)
@@ -439,9 +439,13 @@ featureAllowed feature forWhom Contact {mergedPreferences} =
let ContactUserPreference {enabled} = getContactUserPreference feature mergedPreferences
in forWhom enabled
groupFeatureAllowed :: GroupFeatureI f => SGroupFeature f -> GroupInfo -> Bool
groupFeatureAllowed :: GroupFeatureNoRoleI f => SGroupFeature f -> GroupInfo -> Bool
groupFeatureAllowed feature gInfo = groupFeatureAllowed' feature $ fullGroupPreferences gInfo
groupFeatureMemberAllowed :: GroupFeatureRoleI f => SGroupFeature f -> GroupMember -> GroupInfo -> Bool
groupFeatureMemberAllowed feature GroupMember {memberRole} =
groupFeatureMemberAllowed' feature memberRole . fullGroupPreferences
mergeUserChatPrefs :: User -> Contact -> FullPreferences
mergeUserChatPrefs user ct = mergeUserChatPrefs' user (contactConnIncognito ct) (userPreferences ct)
@@ -796,41 +800,6 @@ fromInvitedBy userCtId = \case
IBContact ctId -> Just ctId
IBUser -> Just userCtId
data GroupMemberRole
= GRObserver -- connects to all group members and receives all messages, can't send messages
| GRAuthor -- reserved, unused
| GRMember -- + can send messages to all group members
| GRAdmin -- + add/remove members, change member role (excl. Owners)
| GROwner -- + delete and change group information, add/remove/change roles for Owners
deriving (Eq, Show, Ord)
instance FromField GroupMemberRole where fromField = fromBlobField_ strDecode
instance ToField GroupMemberRole where toField = toField . strEncode
instance StrEncoding GroupMemberRole where
strEncode = \case
GROwner -> "owner"
GRAdmin -> "admin"
GRMember -> "member"
GRAuthor -> "author"
GRObserver -> "observer"
strDecode = \case
"owner" -> Right GROwner
"admin" -> Right GRAdmin
"member" -> Right GRMember
"author" -> Right GRAuthor
"observer" -> Right GRObserver
r -> Left $ "bad GroupMemberRole " <> B.unpack r
strP = strDecode <$?> A.takeByteString
instance FromJSON GroupMemberRole where
parseJSON = strParseJSON "GroupMemberRole"
instance ToJSON GroupMemberRole where
toJSON = strToJSON
toEncoding = strToJEncoding
data GroupMemberSettings = GroupMemberSettings
{ showMessages :: Bool
}
src/Simplex/Chat/Types/Preferences.hs
+112 -19
View File
@@ -10,6 +10,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
@@ -31,6 +32,7 @@ import qualified Data.Text as T
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Records.Compat
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.Util
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
@@ -148,6 +150,7 @@ data GroupFeature
| GFReactions
| GFVoice
| GFFiles
| GFSimplexLinks
| GFHistory
deriving (Show)
@@ -158,14 +161,23 @@ data SGroupFeature (f :: GroupFeature) where
SGFReactions :: SGroupFeature 'GFReactions
SGFVoice :: SGroupFeature 'GFVoice
SGFFiles :: SGroupFeature 'GFFiles
SGFSimplexLinks :: SGroupFeature 'GFSimplexLinks
SGFHistory :: SGroupFeature 'GFHistory
deriving instance Show (SGroupFeature f)
data AGroupFeature = forall f. GroupFeatureI f => AGF (SGroupFeature f)
data AGroupFeatureNoRole = forall f. GroupFeatureNoRoleI f => AGFNR (SGroupFeature f)
data AGroupFeatureRole = forall f. GroupFeatureRoleI f => AGFR (SGroupFeature f)
deriving instance Show AGroupFeature
deriving instance Show AGroupFeatureNoRole
deriving instance Show AGroupFeatureRole
groupFeatureNameText :: GroupFeature -> Text
groupFeatureNameText = \case
GFTimedMessages -> "Disappearing messages"
@@ -174,15 +186,21 @@ groupFeatureNameText = \case
GFReactions -> "Message reactions"
GFVoice -> "Voice messages"
GFFiles -> "Files and media"
GFSimplexLinks -> "SimpleX links"
GFHistory -> "Recent history"
groupFeatureNameText' :: SGroupFeature f -> Text
groupFeatureNameText' = groupFeatureNameText . toGroupFeature
groupFeatureAllowed' :: GroupFeatureI f => SGroupFeature f -> FullGroupPreferences -> Bool
groupFeatureAllowed' :: GroupFeatureNoRoleI f => SGroupFeature f -> FullGroupPreferences -> Bool
groupFeatureAllowed' feature prefs =
getField @"enable" (getGroupPreference feature prefs) == FEOn
groupFeatureMemberAllowed' :: GroupFeatureRoleI f => SGroupFeature f -> GroupMemberRole -> FullGroupPreferences -> Bool
groupFeatureMemberAllowed' feature role prefs =
let pref = getGroupPreference feature prefs
in getField @"enable" pref == FEOn && maybe True (role >=) (getField @"role" pref)
allGroupFeatures :: [AGroupFeature]
allGroupFeatures =
[ AGF SGFTimedMessages,
@@ -191,17 +209,19 @@ allGroupFeatures =
AGF SGFReactions,
AGF SGFVoice,
AGF SGFFiles,
AGF SGFSimplexLinks,
AGF SGFHistory
]
groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, history} = case f of
groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, history} = case f of
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
SGFSimplexLinks -> simplexLinks
SGFHistory -> history
toGroupFeature :: SGroupFeature f -> GroupFeature
@@ -212,6 +232,7 @@ toGroupFeature = \case
SGFReactions -> GFReactions
SGFVoice -> GFVoice
SGFFiles -> GFFiles
SGFSimplexLinks -> GFSimplexLinks
SGFHistory -> GFHistory
class GroupPreferenceI p where
@@ -224,13 +245,14 @@ instance GroupPreferenceI (Maybe GroupPreferences) where
getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
instance GroupPreferenceI FullGroupPreferences where
getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, history} = case f of
getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, history} = case f of
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
SGFSimplexLinks -> simplexLinks
SGFHistory -> history
{-# INLINE getGroupPreference #-}
@@ -242,17 +264,25 @@ data GroupPreferences = GroupPreferences
reactions :: Maybe ReactionsGroupPreference,
voice :: Maybe VoiceGroupPreference,
files :: Maybe FilesGroupPreference,
simplexLinks :: Maybe SimplexLinksGroupPreference,
history :: Maybe HistoryGroupPreference
}
deriving (Eq, Show)
setGroupPreference :: forall f. GroupFeatureI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
setGroupPreference :: forall f. GroupFeatureNoRoleI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
setGroupPreference f enable prefs_ = setGroupPreference_ f pref prefs
where
prefs = mergeGroupPreferences prefs_
pref :: GroupFeaturePreference f
pref = setField @"enable" (getGroupPreference f prefs) enable
setGroupPreferenceRole :: forall f. GroupFeatureRoleI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupMemberRole -> Maybe GroupPreferences -> GroupPreferences
setGroupPreferenceRole f enable role prefs_ = setGroupPreference_ f pref prefs
where
prefs = mergeGroupPreferences prefs_
pref :: GroupFeaturePreference f
pref = setField @"role" (setField @"enable" (getGroupPreference f prefs) enable) role
setGroupPreference' :: SGroupFeature f -> GroupFeaturePreference f -> Maybe GroupPreferences -> GroupPreferences
setGroupPreference' f pref prefs_ = setGroupPreference_ f pref prefs
where
@@ -267,6 +297,7 @@ setGroupPreference_ f pref prefs =
SGFReactions -> prefs {reactions = pref}
SGFVoice -> prefs {voice = pref}
SGFFiles -> prefs {files = pref}
SGFSimplexLinks -> prefs {simplexLinks = pref}
SGFHistory -> prefs {history = pref}
setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
@@ -295,6 +326,7 @@ data FullGroupPreferences = FullGroupPreferences
reactions :: ReactionsGroupPreference,
voice :: VoiceGroupPreference,
files :: FilesGroupPreference,
simplexLinks :: SimplexLinksGroupPreference,
history :: HistoryGroupPreference
}
deriving (Eq, Show)
@@ -346,16 +378,17 @@ defaultGroupPrefs :: FullGroupPreferences
defaultGroupPrefs =
FullGroupPreferences
{ timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400},
directMessages = DirectMessagesGroupPreference {enable = FEOff},
directMessages = DirectMessagesGroupPreference {enable = FEOff, role = Nothing},
fullDelete = FullDeleteGroupPreference {enable = FEOff},
reactions = ReactionsGroupPreference {enable = FEOn},
voice = VoiceGroupPreference {enable = FEOn},
files = FilesGroupPreference {enable = FEOn},
voice = VoiceGroupPreference {enable = FEOn, role = Nothing},
files = FilesGroupPreference {enable = FEOn, role = Nothing},
simplexLinks = SimplexLinksGroupPreference {enable = FEOn, role = Nothing},
history = HistoryGroupPreference {enable = FEOff}
}
emptyGroupPrefs :: GroupPreferences
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data TimedMessagesPreference = TimedMessagesPreference
{ allow :: FeatureAllowed,
@@ -431,7 +464,7 @@ data TimedMessagesGroupPreference = TimedMessagesGroupPreference
deriving (Eq, Show)
data DirectMessagesGroupPreference = DirectMessagesGroupPreference
{enable :: GroupFeatureEnabled}
{enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole}
deriving (Eq, Show)
data FullDeleteGroupPreference = FullDeleteGroupPreference
@@ -443,11 +476,15 @@ data ReactionsGroupPreference = ReactionsGroupPreference
deriving (Eq, Show)
data VoiceGroupPreference = VoiceGroupPreference
{enable :: GroupFeatureEnabled}
{enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole}
deriving (Eq, Show)
data FilesGroupPreference = FilesGroupPreference
{enable :: GroupFeatureEnabled}
{enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole}
deriving (Eq, Show)
data SimplexLinksGroupPreference = SimplexLinksGroupPreference
{enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole}
deriving (Eq, Show)
data HistoryGroupPreference = HistoryGroupPreference
@@ -458,6 +495,11 @@ class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference
type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
sGroupFeature :: SGroupFeature f
groupPrefParam :: GroupFeaturePreference f -> Maybe Int
groupPrefRole :: GroupFeaturePreference f -> Maybe GroupMemberRole
class GroupFeatureI f => GroupFeatureNoRoleI f
class (GroupFeatureI f, HasField "role" (GroupFeaturePreference f) (Maybe GroupMemberRole)) => GroupFeatureRoleI f
instance HasField "enable" GroupPreference GroupFeatureEnabled where
hasField p@GroupPreference {enable} = (\e -> p {enable = e}, enable)
@@ -480,6 +522,9 @@ instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
hasField p@FilesGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" SimplexLinksGroupPreference GroupFeatureEnabled where
hasField p@SimplexLinksGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
hasField p@HistoryGroupPreference {enable} = (\e -> p {enable = e}, enable)
@@ -487,42 +532,84 @@ instance GroupFeatureI 'GFTimedMessages where
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
sGroupFeature = SGFTimedMessages
groupPrefParam TimedMessagesGroupPreference {ttl} = ttl
groupPrefRole _ = Nothing
instance GroupFeatureI 'GFDirectMessages where
type GroupFeaturePreference 'GFDirectMessages = DirectMessagesGroupPreference
sGroupFeature = SGFDirectMessages
groupPrefParam _ = Nothing
groupPrefRole DirectMessagesGroupPreference {role} = role
instance GroupFeatureI 'GFFullDelete where
type GroupFeaturePreference 'GFFullDelete = FullDeleteGroupPreference
sGroupFeature = SGFFullDelete
groupPrefParam _ = Nothing
groupPrefRole _ = Nothing
instance GroupFeatureI 'GFReactions where
type GroupFeaturePreference 'GFReactions = ReactionsGroupPreference
sGroupFeature = SGFReactions
groupPrefParam _ = Nothing
groupPrefRole _ = Nothing
instance GroupFeatureI 'GFVoice where
type GroupFeaturePreference 'GFVoice = VoiceGroupPreference
sGroupFeature = SGFVoice
groupPrefParam _ = Nothing
groupPrefRole VoiceGroupPreference {role} = role
instance GroupFeatureI 'GFFiles where
type GroupFeaturePreference 'GFFiles = FilesGroupPreference
sGroupFeature = SGFFiles
groupPrefParam _ = Nothing
groupPrefRole FilesGroupPreference {role} = role
instance GroupFeatureI 'GFSimplexLinks where
type GroupFeaturePreference 'GFSimplexLinks = SimplexLinksGroupPreference
sGroupFeature = SGFSimplexLinks
groupPrefParam _ = Nothing
groupPrefRole SimplexLinksGroupPreference {role} = role
instance GroupFeatureI 'GFHistory where
type GroupFeaturePreference 'GFHistory = HistoryGroupPreference
sGroupFeature = SGFHistory
groupPrefParam _ = Nothing
groupPrefRole _ = Nothing
groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
groupPrefStateText feature pref param =
instance GroupFeatureNoRoleI 'GFTimedMessages
instance GroupFeatureNoRoleI 'GFFullDelete
instance GroupFeatureNoRoleI 'GFReactions
instance GroupFeatureNoRoleI 'GFHistory
instance HasField "role" DirectMessagesGroupPreference (Maybe GroupMemberRole) where
hasField p@DirectMessagesGroupPreference {role} = (\r -> p {role = r}, role)
instance HasField "role" VoiceGroupPreference (Maybe GroupMemberRole) where
hasField p@VoiceGroupPreference {role} = (\r -> p {role = r}, role)
instance HasField "role" FilesGroupPreference (Maybe GroupMemberRole) where
hasField p@FilesGroupPreference {role} = (\r -> p {role = r}, role)
instance HasField "role" SimplexLinksGroupPreference (Maybe GroupMemberRole) where
hasField p@SimplexLinksGroupPreference {role} = (\r -> p {role = r}, role)
instance GroupFeatureRoleI 'GFDirectMessages
instance GroupFeatureRoleI 'GFVoice
instance GroupFeatureRoleI 'GFFiles
instance GroupFeatureRoleI 'GFSimplexLinks
groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Maybe GroupMemberRole -> Text
groupPrefStateText feature pref param role =
let enabled = getField @"enable" pref
paramText = if enabled == FEOn then groupParamText_ feature param else ""
in groupFeatureNameText feature <> ": " <> safeDecodeUtf8 (strEncode enabled) <> paramText
roleText = maybe "" (\r -> " for " <> safeDecodeUtf8 (strEncode r) <> "s") role
in groupFeatureNameText feature <> ": " <> safeDecodeUtf8 (strEncode enabled) <> paramText <> roleText
groupParamText_ :: GroupFeature -> Maybe Int -> Text
groupParamText_ feature param = case feature of
@@ -532,7 +619,7 @@ groupParamText_ feature param = case feature of
groupPreferenceText :: forall f. GroupFeatureI f => GroupFeaturePreference f -> Text
groupPreferenceText pref =
let feature = toGroupFeature $ sGroupFeature @f
in groupPrefStateText feature pref $ groupPrefParam pref
in groupPrefStateText feature pref (groupPrefParam pref) (groupPrefRole pref)
timedTTLText :: Int -> Text
timedTTLText 0 = "0 sec"
@@ -602,7 +689,7 @@ instance StrEncoding GroupFeatureEnabled where
"on" -> Right FEOn
"off" -> Right FEOff
r -> Left $ "bad GroupFeatureEnabled " <> B.unpack r
strP = strDecode <$?> A.takeByteString
strP = strDecode <$?> A.takeTill (== ' ')
instance FromJSON GroupFeatureEnabled where
parseJSON = strParseJSON "GroupFeatureEnabled"
@@ -611,11 +698,13 @@ instance ToJSON GroupFeatureEnabled where
toJSON = strToJSON
toEncoding = strToJEncoding
groupFeatureState :: GroupFeatureI f => GroupFeaturePreference f -> (GroupFeatureEnabled, Maybe Int)
groupFeatureState :: GroupFeatureI f => GroupFeaturePreference f -> (GroupFeatureEnabled, Maybe Int, Maybe GroupMemberRole)
groupFeatureState p =
let enable = getField @"enable" p
param = if enable == FEOn then groupPrefParam p else Nothing
in (enable, param)
(param, role)
| enable == FEOn = (groupPrefParam p, groupPrefRole p)
| otherwise = (Nothing, Nothing)
in (enable, param, role)
mergePreferences :: Maybe Preferences -> Maybe Preferences -> FullPreferences
mergePreferences contactPrefs userPreferences =
@@ -641,6 +730,7 @@ mergeGroupPreferences groupPreferences =
reactions = pref SGFReactions,
voice = pref SGFVoice,
files = pref SGFFiles,
simplexLinks = pref SGFSimplexLinks,
history = pref SGFHistory
}
where
@@ -656,6 +746,7 @@ toGroupPreferences groupPreferences =
reactions = pref SGFReactions,
voice = pref SGFVoice,
files = pref SGFFiles,
simplexLinks = pref SGFSimplexLinks,
history = pref SGFHistory
}
where
@@ -762,6 +853,8 @@ $(J.deriveJSON defaultJSON ''VoiceGroupPreference)
$(J.deriveJSON defaultJSON ''FilesGroupPreference)
$(J.deriveJSON defaultJSON ''SimplexLinksGroupPreference)
$(J.deriveJSON defaultJSON ''HistoryGroupPreference)
$(J.deriveJSON defaultJSON ''GroupPreferences)
src/Simplex/Chat/Types/Shared.hs
+48
View File
@@ -0,0 +1,48 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Types.Shared where
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Chat.Types.Util
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Util ((<$?>))
data GroupMemberRole
= GRObserver -- connects to all group members and receives all messages, can't send messages
| GRAuthor -- reserved, unused
| GRMember -- + can send messages to all group members
| GRAdmin -- + add/remove members, change member role (excl. Owners)
| GROwner -- + delete and change group information, add/remove/change roles for Owners
deriving (Eq, Show, Ord)
instance FromField GroupMemberRole where fromField = fromBlobField_ strDecode
instance ToField GroupMemberRole where toField = toField . strEncode
instance StrEncoding GroupMemberRole where
strEncode = \case
GROwner -> "owner"
GRAdmin -> "admin"
GRMember -> "member"
GRAuthor -> "author"
GRObserver -> "observer"
strDecode = \case
"owner" -> Right GROwner
"admin" -> Right GRAdmin
"member" -> Right GRMember
"author" -> Right GRAuthor
"observer" -> Right GRObserver
r -> Left $ "bad GroupMemberRole " <> B.unpack r
strP = strDecode <$?> A.takeByteString
instance FromJSON GroupMemberRole where
parseJSON = strParseJSON "GroupMemberRole"
instance ToJSON GroupMemberRole where
toJSON = strToJSON
toEncoding = strToJEncoding
src/Simplex/Chat/View.hs
+3 -1
View File
@@ -49,6 +49,7 @@ import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..
import Simplex.Chat.Styled
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import qualified Simplex.FileTransfer.Transport as XFTPTransport
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
@@ -351,8 +352,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
<> (" :: avg: " <> sShow timeAvg <> " ms")
<> (" :: " <> plain (T.unwords $ T.lines query))
in ("Chat queries" : map viewQuery chatQueries) <> [""] <> ("Agent queries" : map viewQuery agentQueries)
CRDebugLocks {chatLockName, agentLocks} ->
CRDebugLocks {chatLockName, chatEntityLocks, agentLocks} ->
[ maybe "no chat lock" (("chat lock: " <>) . plain) chatLockName,
plain $ "chat entity locks: " <> LB.unpack (J.encode chatEntityLocks),
plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)
]
CRAgentStats stats -> map (plain . intercalate ",") stats
tests/Bots/DirectoryTests.hs
+2 -1
View File
@@ -19,7 +19,8 @@ import Simplex.Chat.Bot.KnownContacts
import Simplex.Chat.Controller (ChatConfig (..))
import Simplex.Chat.Core
import Simplex.Chat.Options (CoreChatOpts (..))
import Simplex.Chat.Types (GroupMemberRole (..), Profile (..))
import Simplex.Chat.Types (Profile (..))
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
import System.FilePath ((</>))
import Test.Hspec hiding (it)
tests/ChatTests/Files.hs
+2 -1
View File
@@ -787,7 +787,8 @@ testXFTPCancelRcvRepeat =
bob ##> "/fr 1 ./tests/tmp"
bob
<### [ "saving file 1 from alice to ./tests/tmp/testfile_1",
"started receiving file 1 (testfile) from alice"
"started receiving file 1 (testfile) from alice",
StartsWith "chat db error: SERcvFileNotFoundXFTP"
]
bob <## "completed receiving file 1 (testfile) from alice"
tests/ChatTests/Groups.hs
+3 -1
View File
@@ -15,7 +15,8 @@ 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 (..), VersionRangeChat)
import Simplex.Chat.Types (VersionRangeChat)
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff)
import System.Directory (copyFile)
@@ -1509,6 +1510,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile
alice <## "Message reactions: on"
alice <## "Voice messages: on"
alice <## "Files and media: on"
alice <## "SimpleX links: on"
alice <## "Recent history: on"
bobAddedDan :: HasCallStack => TestCC -> IO ()
bobAddedDan cc = do
tests/ChatTests/Profiles.hs
+131 -5
View File
@@ -13,7 +13,8 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import Simplex.Chat.Store.Shared (createContact)
import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), Profile (..))
import Simplex.Chat.Types (ConnStatus (..), Profile (..))
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
import Simplex.Messaging.Encoding.String (StrEncoding (..))
import System.Directory (copyFile, createDirectoryIfMissing)
import Test.Hspec hiding (it)
@@ -68,6 +69,10 @@ chatProfileTests = do
it "enable timed messages in group" testEnableTimedMessagesGroup
xit'' "timed messages enabled globally, contact turns on" testTimedMessagesEnabledGlobally
it "update multiple user preferences for multiple contacts" testUpdateMultipleUserPrefs
describe "group preferences for specific member role" $ do
it "direct messages" testGroupPrefsDirectForRole
it "files & media" testGroupPrefsFilesForRole
it "SimpleX links" testGroupPrefsSimplexLinksForRole
testUpdateProfile :: HasCallStack => FilePath -> IO ()
testUpdateProfile =
@@ -179,10 +184,12 @@ testMultiWordProfileNames =
alice <# "#'Our Team' 'Bob James'> hi"
cath <# "#'Our Team' 'Bob James'> hi"
alice `send` "@'Cath Johnson' hello"
alice <## "member #'Our Team' 'Cath Johnson' does not have direct connection, creating"
alice <## "contact for member #'Our Team' 'Cath Johnson' is created"
alice <## "sent invitation to connect directly to member #'Our Team' 'Cath Johnson'"
alice <# "@'Cath Johnson' hello"
alice
<### [ "member #'Our Team' 'Cath Johnson' does not have direct connection, creating",
"contact for member #'Our Team' 'Cath Johnson' is created",
"sent invitation to connect directly to member #'Our Team' 'Cath Johnson'",
WithTime "@'Cath Johnson' hello"
]
cath <## "#'Our Team' 'Alice Jones' is creating direct contact 'Alice Jones' with you"
cath <# "'Alice Jones'> hello"
cath <## "'Alice Jones': contact is connected"
@@ -1901,3 +1908,122 @@ testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi bob"), (1, "Full deletion: enabled for contact"), (1, "Message reactions: off")])
alice #$> ("/_get chat @3 count=100", chat, chatFeatures <> [(1, "hi cath"), (1, "Full deletion: enabled for contact"), (1, "Message reactions: off")])
testGroupPrefsDirectForRole :: HasCallStack => FilePath -> IO ()
testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
createGroup3 "team" alice bob cath
threadDelay 1000000
alice ##> "/set direct #team on owner"
alice <## "updated group preferences:"
alice <## "Direct messages: on for owners"
directForOwners bob
directForOwners cath
threadDelay 1000000
bob ##> "@cath hello again"
bob <## "bad chat command: direct messages not allowed"
(cath </)
connectUsers cath dan
addMember "team" cath dan GRMember
dan ##> "/j #team"
concurrentlyN_
[ cath <## "#team: dan joined the group",
do
dan <## "#team: you joined the group"
dan
<### [ "#team: member alice (Alice) is connected",
"#team: member bob (Bob) is connected"
],
do
alice <## "#team: cath added dan (Daniel) to the group (connecting...)"
alice <## "#team: new member dan is connected",
do
bob <## "#team: cath added dan (Daniel) to the group (connecting...)"
bob <## "#team: new member dan is connected"
]
-- dan cannot send direct messages to alice (owner)
dan ##> "@alice hello alice"
dan <## "bad chat command: direct messages not allowed"
(alice </)
-- but alice can
alice `send` "@dan hello dan"
alice <## "member #team dan does not have direct connection, creating"
alice <## "contact for member #team dan is created"
alice <## "sent invitation to connect directly to member #team dan"
alice <# "@dan hello dan"
alice <## "dan (Daniel): contact is connected"
dan <## "#team alice is creating direct contact alice with you"
dan <# "alice> hello dan"
dan <## "alice (Alice): contact is connected"
-- and now dan can too
dan #> "@alice hi alice"
alice <# "dan> hi alice"
where
directForOwners :: HasCallStack => TestCC -> IO ()
directForOwners cc = do
cc <## "alice updated group #team:"
cc <## "updated group preferences:"
cc <## "Direct messages: on for owners"
testGroupPrefsFilesForRole :: HasCallStack => FilePath -> IO ()
testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok")
bob #$> ("/_files_folder ./tests/tmp/bob", id, "ok")
createDirectoryIfMissing True "./tests/tmp/alice"
createDirectoryIfMissing True "./tests/tmp/bob"
copyFile "./tests/fixtures/test.txt" "./tests/tmp/alice/test1.txt"
copyFile "./tests/fixtures/test.txt" "./tests/tmp/bob/test2.txt"
createGroup3 "team" alice bob cath
threadDelay 1000000
alice ##> "/set files #team on owner"
alice <## "updated group preferences:"
alice <## "Files and media: on for owners"
filesForOwners bob
filesForOwners cath
threadDelay 1000000
bob ##> "/f #team test2.txt"
bob <## "bad chat command: feature not allowed Files and media"
(alice </)
(cath </)
alice #> "/f #team test1.txt"
alice <## "use /fc 1 to cancel sending"
alice <## "completed uploading file 1 (test1.txt) for #team"
bob <# "#team alice> sends file test1.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
cath <# "#team alice> sends file test1.txt (11 bytes / 11 bytes)"
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
where
filesForOwners :: HasCallStack => TestCC -> IO ()
filesForOwners cc = do
cc <## "alice updated group #team:"
cc <## "updated group preferences:"
cc <## "Files and media: on for owners"
testGroupPrefsSimplexLinksForRole :: HasCallStack => FilePath -> IO ()
testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
createGroup3 "team" alice bob cath
threadDelay 1000000
alice ##> "/set links #team on owner"
alice <## "updated group preferences:"
alice <## "SimpleX links: on for owners"
linksForOwners bob
linksForOwners cath
threadDelay 1000000
bob ##> "/c"
inv <- getInvitation bob
bob ##> ("#team " <> inv)
bob <## "bad chat command: feature not allowed SimpleX links"
(alice </)
(cath </)
alice #> ("#team " <> inv)
bob <# ("#team alice> " <> inv)
cath <# ("#team alice> " <> inv)
where
linksForOwners :: HasCallStack => TestCC -> IO ()
linksForOwners cc = do
cc <## "alice updated group #team:"
cc <## "updated group preferences:"
cc <## "SimpleX links: on for owners"
tests/ChatTests/Utils.hs
+3 -1
View File
@@ -14,6 +14,7 @@ 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)
@@ -29,12 +30,12 @@ import Simplex.Chat.Store.NoteFolders (createNoteFolder)
import Simplex.Chat.Store.Profiles (getUserContactProfiles)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
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 qualified Simplex.Messaging.Encoding.Base64 as B64
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Version
import System.Directory (doesFileExist)
@@ -315,6 +316,7 @@ groupFeatures'' =
((0, "Message reactions: on"), Nothing, Nothing),
((0, "Voice messages: on"), Nothing, Nothing),
((0, "Files and media: on"), Nothing, Nothing),
((0, "SimpleX links: on"), Nothing, Nothing),
((0, "Recent history: on"), Nothing, Nothing)
]
tests/ProtocolTests.hs
+2 -1
View File
@@ -12,6 +12,7 @@ import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet
@@ -99,7 +100,7 @@ testChatPreferences :: Maybe Preferences
testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}}
testGroupPreferences :: Maybe GroupPreferences
testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, files = Nothing, fullDelete = Nothing, history = Nothing}
testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn, role = Nothing}, files = Nothing, fullDelete = Nothing, simplexLinks = Nothing, history = Nothing}
testProfile :: Profile
testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), contactLink = Nothing, preferences = testChatPreferences}
tests/WebRTCTests.hs
+3 -3
View File
@@ -4,12 +4,12 @@ module WebRTCTests where
import Control.Monad.Except
import Crypto.Random (getRandomBytes)
import qualified Data.ByteString.Base64.URL as U
import qualified Data.ByteString.Char8 as B
import Foreign.StablePtr
import Simplex.Chat.Mobile
import Simplex.Chat.Mobile.WebRTC
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Encoding.Base64.URL as U
import System.FilePath ((</>))
import Test.Hspec
@@ -36,8 +36,8 @@ webRTCTests = describe "WebRTC crypto" $ do
cc <- newStablePtr c
let key = B.replicate 32 '#'
frame <- (<> B.replicate reservedSize '\NUL') <$> getRandomBytes 100
runExceptT (chatEncryptMedia cc key frame) `shouldReturn` Left "invalid key: invalid base64 encoding near offset: 0"
runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "invalid key: invalid base64 encoding near offset: 0"
runExceptT (chatEncryptMedia cc key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0"
runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0"
it "should fail on invalid auth tag" $ \tmp -> do
Right c <- chatMigrateInit (tmp </> "1") "" "yesUp"
cc <- newStablePtr c
website/src/_includes/blog_previews/20240404.html
+8
View File
@@ -0,0 +1,8 @@
<em>By Esra'a al Shafei</em>
<p>Transitioning from a lifelong career dedicated to nonprofits,
including Board roles at organizations like the Wikimedia Foundation, Access Now and Tor,
my decision to join SimpleX Chat may come as a surprise to some.
But, as I step into this new chapter, I want to share the insights and convictions
that have guided me here, shedding light on what I think sets SimpleX Chat apart
and why this move feels like an essential learning opportunity.</p>