WIP: stream db results for subscribeUserConnections

apps/ios/Shared/Model/SimpleXAPI.swift

@@ -21,8 +21,6 @@ public let CURRENT_CHAT_VERSION: Int = 2
 // version range that supports establishing direct connection with a group member (xGrpDirectInvVRange in core)
 public let CREATE_MEMBER_CONTACT_VRANGE = VersionRange(minVersion: 2, maxVersion: CURRENT_CHAT_VERSION)
 
-private let networkStatusesLock = DispatchQueue(label: "chat.simplex.app.network-statuses.lock")
-
 enum TerminalItem: Identifiable {
     case cmd(Date, ChatCommand)
     case resp(Date, ChatResponse)
@@ -1568,30 +1566,34 @@ func processReceivedMsg(_ res: ChatResponse) async {
                 m.removeChat(mergedContact.id)
             }
         }
-    case let .networkStatus(status, connections):
-        // dispatch queue to synchronize access
-        networkStatusesLock.sync {
-            var ns = m.networkStatuses
-            // slow loop is on the background thread
-            for cId in connections {
-                ns[cId] = status
+    case let .contactsSubscribed(_, contactRefs):
+        await updateContactsStatus(contactRefs, status: .connected)
+    case let .contactsDisconnected(_, contactRefs):
+        await updateContactsStatus(contactRefs, status: .disconnected)
+    case let .contactSubSummary(_, contactSubscriptions):
+        await MainActor.run {
+            for sub in contactSubscriptions {
+// no need to update contact here, and it is slow
+//                if active(user) {
+//                    m.updateContact(sub.contact)
+//                }
+                if let err = sub.contactError {
+                    processContactSubError(sub.contact, err)
+                } else {
+                    m.setContactNetworkStatus(sub.contact, .connected)
+                }
             }
-            // fast model update is on the main thread
-            DispatchQueue.main.sync {
-                m.networkStatuses = ns
+        }
+    case let .networkStatus(status, connections):
+        await MainActor.run {
+            for cId in connections {
+                m.networkStatuses[cId] = status
             }
         }
     case let .networkStatuses(_, statuses): ()
-        // dispatch queue to synchronize access
-        networkStatusesLock.sync {
-            var ns = m.networkStatuses
-            // slow loop is on the background thread
+        await MainActor.run {
             for s in statuses {
-                ns[s.agentConnId] = s.networkStatus
-            }
-            // fast model update is on the main thread
-            DispatchQueue.main.sync {
-                m.networkStatuses = ns
+                m.networkStatuses[s.agentConnId] = s.networkStatus
             }
         }
     case let .newChatItem(user, aChatItem):
@@ -1942,6 +1944,26 @@ func chatItemSimpleUpdate(_ user: any UserLike, _ aChatItem: AChatItem) async {
     }
 }
 
+func updateContactsStatus(_ contactRefs: [ContactRef], status: NetworkStatus) async {
+    let m = ChatModel.shared
+    await MainActor.run {
+        for c in contactRefs {
+            m.networkStatuses[c.agentConnId] = status
+        }
+    }
+}
+
+func processContactSubError(_ contact: Contact, _ chatError: ChatError) {
+    let m = ChatModel.shared
+    var err: String
+    switch chatError {
+    case .errorAgent(agentError: .BROKER(_, .NETWORK)): err = "network"
+    case .errorAgent(agentError: .SMP(smpErr: .AUTH)): err = "contact deleted"
+    default: err = String(describing: chatError)
+    }
+    m.setContactNetworkStatus(contact, .error(connectionError: err))
+}
+
 func refreshCallInvitations() throws {
     let m = ChatModel.shared
     let callInvitations = try justRefreshCallInvitations()

apps/ios/Shared/SimpleXApp.swift

@@ -22,10 +22,8 @@ struct SimpleXApp: App {
 
     init() {
         DispatchQueue.global(qos: .background).sync {
-            // we have to use debug profile file name without extension here because .hp extension is added by profiler
-//          haskell_init(0, nil, nil)
-          let dummyHpPath = getAppDebugProfilePrefixPath().path + "_dummy" // not used, but required to populate eventlog
-          haskell_init(0, getAppEventLogPath().path, dummyHpPath)
+            haskell_init()
+//            hs_init(0, nil)
         }
         UserDefaults.standard.register(defaults: appDefaults)
         setGroupDefaults()

apps/ios/Shared/Views/Chat/ChatView.swift

@@ -17,7 +17,6 @@ struct ChatView: View {
     @Environment(\.colorScheme) var colorScheme
     @Environment(\.dismiss) var dismiss
     @Environment(\.presentationMode) var presentationMode
-    @Environment(\.scenePhase) var scenePhase
     @State @ObservedObject var chat: Chat
     @State private var showChatInfoSheet: Bool = false
     @State private var showAddMembersSheet: Bool = false
@@ -235,9 +234,7 @@ struct ChatView: View {
 
     private func initChatView() {
         let cInfo = chat.chatInfo
-        // This check prevents the call to apiContactInfo after the app is suspended, and the database is closed.
-        if case .active = scenePhase,
-           case let .direct(contact) = cInfo {
+        if case let .direct(contact) = cInfo {
             Task {
                 do {
                     let (stats, _) = try await apiContactInfo(chat.chatInfo.apiId)

apps/ios/Shared/Views/ChatList/UserPicker.swift

@@ -12,7 +12,6 @@ private let fillColorLight = Color(uiColor: UIColor(red: 0.99, green: 0.99, blue
 struct UserPicker: View {
     @EnvironmentObject var m: ChatModel
     @Environment(\.colorScheme) var colorScheme
-    @Environment(\.scenePhase) var scenePhase
     @Binding var showSettings: Bool
     @Binding var showConnectDesktop: Bool
     @Binding var userPickerVisible: Bool
@@ -92,10 +91,7 @@ struct UserPicker: View {
         .opacity(userPickerVisible ? 1.0 : 0.0)
         .onAppear {
             do {
-                // This check prevents the call of listUsers after the app is suspended, and the database is closed.
-                if case .active = scenePhase {
-                    m.users = try listUsers()
-                }
+                m.users = try listUsers()
             } catch let error {
                 logger.error("Error loading users \(responseError(error))")
             }

apps/ios/Shared/Views/UserSettings/DeveloperView.swift

@@ -45,11 +45,6 @@ struct DeveloperView: View {
                 }
 
                 if developerTools {
-                    Section {
-                        exportDebugProfileButton()
-                        exportEventLogButton()
-                    }
-
                     Section {
                         settingsRow("key") {
                             Toggle("Post-quantum E2EE", isOn: $pqExperimentalEnabled)
@@ -67,24 +62,6 @@ struct DeveloperView: View {
         }
     }
 
-    @ViewBuilder private func exportDebugProfileButton() -> some View {
-        let url = getAppDebugProfilePath()
-        settingsRow("square.and.arrow.up") {
-            Button("Export debugging profile") {
-                showShareSheet(items: [url])
-            }
-        }.disabled(!FileManager.default.fileExists(atPath: url.path))
-    }
-
-    @ViewBuilder private func exportEventLogButton() -> some View {
-        let url = getAppEventLogPath()
-        settingsRow("square.and.arrow.up") {
-            Button("Export event log") {
-                showShareSheet(items: [url])
-            }
-        }.disabled(!FileManager.default.fileExists(atPath: url.path))
-    }
-
     private func setPQExperimentalEnabled(_ enable: Bool) {
         do {
             try apiSetPQEncryption(enable)

apps/ios/SimpleX NSE/NotificationService.swift

@@ -396,7 +396,7 @@ func startChat() -> DBMigrationResult? {
 
     startLock.wait()
     defer { startLock.signal() }
-
+    
     if hasChatCtrl() {
         return switch NSEChatState.shared.value {
         case .created: doStartChat()
@@ -415,8 +415,7 @@ func startChat() -> DBMigrationResult? {
 
 func doStartChat() -> DBMigrationResult? {
     logger.debug("NotificationService: doStartChat")
-    haskell_init(1, nil, getAppDebugProfilePrefixPath().path)
-//    haskell_init(1, nil, nil)
+    haskell_init_nse()
     let (_, dbStatus) = chatMigrateInit(confirmMigrations: defaultMigrationConfirmation(), backgroundMode: true)
     logger.debug("NotificationService: doStartChat \(String(describing: dbStatus))")
     if dbStatus != .ok {

apps/ios/SimpleX.xcodeproj/project.pbxproj

@@ -18,11 +18,6 @@
 		18415FEFE153C5920BFB7828 /* GroupWelcomeView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 1841516F0CE5992B0EDFB377 /* GroupWelcomeView.swift */; };
 		3CDBCF4227FAE51000354CDD /* ComposeLinkView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 3CDBCF4127FAE51000354CDD /* ComposeLinkView.swift */; };
 		3CDBCF4827FF621E00354CDD /* CILinkView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 3CDBCF4727FF621E00354CDD /* CILinkView.swift */; };
-		411D3A7C2BB9601D003D9A22 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 411D3A772BB9601D003D9A22 /* libgmp.a */; };
-		411D3A7D2BB9601D003D9A22 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 411D3A782BB9601D003D9A22 /* libffi.a */; };
-		411D3A7E2BB9601D003D9A22 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 411D3A792BB9601D003D9A22 /* libgmpxx.a */; };
-		411D3A7F2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 411D3A7A2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a */; };
-		411D3A802BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 411D3A7B2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a */; };
 		5C00164428A26FBC0094D739 /* ContextMenu.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C00164328A26FBC0094D739 /* ContextMenu.swift */; };
 		5C00168128C4FE760094D739 /* KeyChain.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C00168028C4FE760094D739 /* KeyChain.swift */; };
 		5C029EA82837DBB3004A9677 /* CICallItemView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C029EA72837DBB3004A9677 /* CICallItemView.swift */; };
@@ -41,6 +36,11 @@
 		5C35CFC827B2782E00FB6C6D /* BGManager.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C35CFC727B2782E00FB6C6D /* BGManager.swift */; };
 		5C35CFCB27B2E91D00FB6C6D /* NtfManager.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C35CFCA27B2E91D00FB6C6D /* NtfManager.swift */; };
 		5C36027327F47AD5009F19D9 /* AppDelegate.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C36027227F47AD5009F19D9 /* AppDelegate.swift */; };
+		5C371E742BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C371E6F2BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv-ghc9.6.3.a */; };
+		5C371E752BACC5D600100AD3 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C371E702BACC5D600100AD3 /* libgmpxx.a */; };
+		5C371E762BACC5D600100AD3 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C371E712BACC5D600100AD3 /* libffi.a */; };
+		5C371E772BACC5D600100AD3 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C371E722BACC5D600100AD3 /* libgmp.a */; };
+		5C371E782BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5C371E732BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv.a */; };
 		5C3A88CE27DF50170060F1C2 /* DetermineWidth.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3A88CD27DF50170060F1C2 /* DetermineWidth.swift */; };
 		5C3A88D127DF57800060F1C2 /* FramedItemView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3A88D027DF57800060F1C2 /* FramedItemView.swift */; };
 		5C3CCFCC2AE6BD3100C3F0C3 /* ConnectDesktopView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5C3CCFCB2AE6BD3100C3F0C3 /* ConnectDesktopView.swift */; };
@@ -263,11 +263,6 @@
 		18415FD2E36F13F596A45BB4 /* CIVideoView.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = CIVideoView.swift; sourceTree = "<group>"; };
 		3CDBCF4127FAE51000354CDD /* ComposeLinkView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeLinkView.swift; sourceTree = "<group>"; };
 		3CDBCF4727FF621E00354CDD /* CILinkView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CILinkView.swift; sourceTree = "<group>"; };
-		411D3A772BB9601D003D9A22 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = libgmp.a; path = ios/libgmp.a; sourceTree = "<group>"; };
-		411D3A782BB9601D003D9A22 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = libffi.a; path = ios/libffi.a; sourceTree = "<group>"; };
-		411D3A792BB9601D003D9A22 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = libgmpxx.a; path = ios/libgmpxx.a; sourceTree = "<group>"; };
-		411D3A7A2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = "libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a"; path = "ios/libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a"; sourceTree = "<group>"; };
-		411D3A7B2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = "libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a"; path = "ios/libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a"; sourceTree = "<group>"; };
 		5C00164328A26FBC0094D739 /* ContextMenu.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ContextMenu.swift; sourceTree = "<group>"; };
 		5C00168028C4FE760094D739 /* KeyChain.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = KeyChain.swift; sourceTree = "<group>"; };
 		5C029EA72837DBB3004A9677 /* CICallItemView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CICallItemView.swift; sourceTree = "<group>"; };
@@ -295,6 +290,11 @@
 		5C371E4E2BA9AAA200100AD3 /* hu */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = hu; path = hu.lproj/Localizable.strings; sourceTree = "<group>"; };
 		5C371E4F2BA9AB6400100AD3 /* hu */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = hu; path = "hu.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = "<group>"; };
 		5C371E502BA9AB6400100AD3 /* hu */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = hu; path = hu.lproj/InfoPlist.strings; sourceTree = "<group>"; };
+		5C371E6F2BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv-ghc9.6.3.a"; sourceTree = "<group>"; };
+		5C371E702BACC5D600100AD3 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
+		5C371E712BACC5D600100AD3 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
+		5C371E722BACC5D600100AD3 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
+		5C371E732BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv.a"; sourceTree = "<group>"; };
 		5C3A88CD27DF50170060F1C2 /* DetermineWidth.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = DetermineWidth.swift; sourceTree = "<group>"; };
 		5C3A88D027DF57800060F1C2 /* FramedItemView.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = FramedItemView.swift; sourceTree = "<group>"; };
 		5C3CCFCB2AE6BD3100C3F0C3 /* ConnectDesktopView.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = ConnectDesktopView.swift; sourceTree = "<group>"; };
@@ -521,13 +521,13 @@
 			isa = PBXFrameworksBuildPhase;
 			buildActionMask = 2147483647;
 			files = (
+				5C371E752BACC5D600100AD3 /* libgmpxx.a in Frameworks */,
+				5C371E742BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv-ghc9.6.3.a in Frameworks */,
 				5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */,
-				411D3A7E2BB9601D003D9A22 /* libgmpxx.a in Frameworks */,
-				411D3A7C2BB9601D003D9A22 /* libgmp.a in Frameworks */,
-				411D3A802BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a in Frameworks */,
+				5C371E782BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv.a in Frameworks */,
+				5C371E762BACC5D600100AD3 /* libffi.a in Frameworks */,
+				5C371E772BACC5D600100AD3 /* libgmp.a in Frameworks */,
 				5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */,
-				411D3A7F2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a in Frameworks */,
-				411D3A7D2BB9601D003D9A22 /* libffi.a in Frameworks */,
 			);
 			runOnlyForDeploymentPostprocessing = 0;
 		};
@@ -590,11 +590,11 @@
 		5C764E5C279C70B7000C6508 /* Libraries */ = {
 			isa = PBXGroup;
 			children = (
-				411D3A782BB9601D003D9A22 /* libffi.a */,
-				411D3A772BB9601D003D9A22 /* libgmp.a */,
-				411D3A792BB9601D003D9A22 /* libgmpxx.a */,
-				411D3A7A2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv-ghc9.6.3.a */,
-				411D3A7B2BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.a */,
+				5C371E712BACC5D600100AD3 /* libffi.a */,
+				5C371E722BACC5D600100AD3 /* libgmp.a */,
+				5C371E702BACC5D600100AD3 /* libgmpxx.a */,
+				5C371E6F2BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv-ghc9.6.3.a */,
+				5C371E732BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv.a */,
 			);
 			path = Libraries;
 			sourceTree = "<group>";
@@ -1576,7 +1576,6 @@
 				CODE_SIGN_ENTITLEMENTS = "SimpleX (iOS).entitlements";
 				CODE_SIGN_STYLE = Automatic;
 				CURRENT_PROJECT_VERSION = 204;
-				DEBUG_INFORMATION_FORMAT = dwarf;
 				DEVELOPMENT_TEAM = 5NN7GUYB6T;
 				ENABLE_BITCODE = NO;
 				ENABLE_PREVIEWS = YES;
@@ -1690,7 +1689,6 @@
 				CODE_SIGN_IDENTITY = "Apple Development";
 				CODE_SIGN_STYLE = Automatic;
 				CURRENT_PROJECT_VERSION = 204;
-				DEBUG_INFORMATION_FORMAT = dwarf;
 				DEVELOPMENT_TEAM = 5NN7GUYB6T;
 				ENABLE_BITCODE = NO;
 				GENERATE_INFOPLIST_FILE = YES;
@@ -1769,7 +1767,6 @@
 				CLANG_ENABLE_MODULES = YES;
 				CODE_SIGN_STYLE = Automatic;
 				CURRENT_PROJECT_VERSION = 204;
-				DEBUG_INFORMATION_FORMAT = dwarf;
 				DEFINES_MODULE = YES;
 				DEVELOPMENT_TEAM = 5NN7GUYB6T;
 				DYLIB_COMPATIBILITY_VERSION = 1;

apps/ios/SimpleXChat/APITypes.swift

@@ -557,6 +557,11 @@ public enum ChatResponse: Decodable, Error {
     case contactRequestRejected(user: UserRef)
     case contactUpdated(user: UserRef, toContact: Contact)
     case groupMemberUpdated(user: UserRef, groupInfo: GroupInfo, fromMember: GroupMember, toMember: GroupMember)
+    // TODO remove events below
+    case contactsSubscribed(server: String, contactRefs: [ContactRef])
+    case contactsDisconnected(server: String, contactRefs: [ContactRef])
+    case contactSubSummary(user: UserRef, contactSubscriptions: [ContactSubStatus])
+    // TODO remove events above
     case networkStatus(networkStatus: NetworkStatus, connections: [String])
     case networkStatuses(user_: UserRef?, networkStatuses: [ConnNetworkStatus])
     case groupSubscribed(user: UserRef, groupInfo: GroupRef)
@@ -719,6 +724,9 @@ public enum ChatResponse: Decodable, Error {
             case .contactRequestRejected: return "contactRequestRejected"
             case .contactUpdated: return "contactUpdated"
             case .groupMemberUpdated: return "groupMemberUpdated"
+            case .contactsSubscribed: return "contactsSubscribed"
+            case .contactsDisconnected: return "contactsDisconnected"
+            case .contactSubSummary: return "contactSubSummary"
             case .networkStatus: return "networkStatus"
             case .networkStatuses: return "networkStatuses"
             case .groupSubscribed: return "groupSubscribed"
@@ -877,6 +885,9 @@ public enum ChatResponse: Decodable, Error {
             case .contactRequestRejected: return noDetails
             case let .contactUpdated(u, toContact): return withUser(u, String(describing: toContact))
             case let .groupMemberUpdated(u, groupInfo, fromMember, toMember): return withUser(u, "groupInfo: \(groupInfo)\nfromMember: \(fromMember)\ntoMember: \(toMember)")
+            case let .contactsSubscribed(server, contactRefs): return "server: \(server)\ncontacts:\n\(String(describing: contactRefs))"
+            case let .contactsDisconnected(server, contactRefs): return "server: \(server)\ncontacts:\n\(String(describing: contactRefs))"
+            case let .contactSubSummary(u, contactSubscriptions): return withUser(u, String(describing: contactSubscriptions))
             case let .networkStatus(status, conns): return "networkStatus: \(String(describing: status))\nconnections: \(String(describing: conns))"
             case let .networkStatuses(u, statuses): return withUser(u, String(describing: statuses))
             case let .groupSubscribed(u, groupInfo): return withUser(u, String(describing: groupInfo))

apps/ios/SimpleXChat/FileUtils.swift

@@ -52,10 +52,6 @@ func getAppDirectory() -> URL {
 
 let DB_FILE_PREFIX = "simplex_v1"
 
-let DEBUG_PROFILE_PREFIX = "simplex_debug"
-
-let DEBUG_PROFILE_EXTENSION = ".hp"
-
 func getLegacyDatabasePath() -> URL {
     getDocumentsDirectory().appendingPathComponent("mobile_v1", isDirectory: false)
 }
@@ -66,18 +62,6 @@ public func getAppDatabasePath() -> URL {
     : getLegacyDatabasePath()
 }
 
-public func getAppDebugProfilePrefixPath() -> URL {
-    getAppDirectory().appendingPathComponent(DEBUG_PROFILE_PREFIX, isDirectory: false)
-}
-
-public func getAppDebugProfilePath() -> URL {
-    getAppDirectory().appendingPathComponent(DEBUG_PROFILE_PREFIX + DEBUG_PROFILE_EXTENSION, isDirectory: false)
-}
-
-public func getAppEventLogPath() -> URL {
-    getAppDirectory().appendingPathComponent("simplex.eventlog", isDirectory: false)
-}
-
 func fileModificationDate(_ path: String) -> Date? {
     do {
         let attr = try FileManager.default.attributesOfItem(atPath: path)

apps/ios/SimpleXChat/hs_init.c

@@ -7,53 +7,19 @@
 //
 
 #include "hs_init.h"
-#include <string.h>
 
 extern void hs_init_with_rtsopts(int * argc, char **argv[]);
 
-void haskell_init(int nse, const char *eventlog, const char *heap_profile) {
-    // setup static arena for bump allocation and passing to RTS
-    char *argv[32] = {0,};
-    int argc = 0; // number of arguments used so far, always stands at the first NULL in argv
-    // common args
-    if (nse) {
-      argv[argc++] = "simplex-nse"; // fake program name
-    } else {
-      argv[argc++] = "simplex";
-    }
-    argv[argc++] = "+RTS"; // start adding RTS options
-    if (nse) {
-      argv[argc++] = "-S"; // spam stdout with GC stats
-      argv[argc++] = "-A1m"; // chunk size for new allocations (less frequent GC)
-      argv[argc++] = "-H2m"; // larger heap size on start (faster boot)
-      argv[argc++] = "-M12m"; // hard limit on heap
-      argv[argc++] = "-F0.5"; // heap growth triggering GC
-      argv[argc++] = "-Fd1"; // memory return
-    } else {
-      argv[argc++] = "-T"; // make GC counters available from inside the program
-      argv[argc++] = "-A64m"; // chunk size for new allocations (less frequent GC)
-      argv[argc++] = "-H64m"; // larger heap size on start (faster boot)
-    }
-    // argv[argc++] = "-M8G"; // keep memory usage under 8G, collecting more aggressively when approaching it (and crashing sooner rather than taking down the whole system)
-    if (eventlog) {
-        static char ol[1024] = "-ol";
-        (void)strncpy(&ol[3], eventlog, sizeof(ol) - 3);
-        argv[argc++] = ol;
-        argv[argc++] = "-l-agu"; // collect GC and user events
-    }
-    if (heap_profile) {
-        static char po[1024] = "-po";
-        (void)strncpy(&po[3], heap_profile, sizeof(po) - 3);
-        argv[argc++] = po; // adds ".hp" extension
-        argv[argc++] = "-hT"; // emit heap profile by closure type
-    }
-    if (nse) {
-      argv[argc++] = "-c"; // compacting garbage collector
-    } else {
-      int non_moving_gc = !heap_profile; // not compatible with heap profile
-      if (non_moving_gc) argv[argc++] = "-xn";
-    }
-    // wrap args as expected by RTS
+void haskell_init(void) {
+    int argc = 5;
+    char *argv[] = {
+        "simplex",
+        "+RTS", // requires `hs_init_with_rtsopts`
+        "-A64m", // chunk size for new allocations
+        "-H64m", // initial heap size
+        "-xn", // non-moving GC
+        0
+    };
     char **pargv = argv;
     hs_init_with_rtsopts(&argc, &pargv);
 }

apps/ios/SimpleXChat/hs_init.h

@@ -9,7 +9,7 @@
 #ifndef hs_init_h
 #define hs_init_h
 
-void haskell_init(int nse, const char *eventlog, const char *heap_profile);
+void haskell_init(void);
 
 void haskell_init_nse(void);
 

apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt

@@ -1753,8 +1753,6 @@ object ChatController {
           chatModel.removeChat(rhId, r.mergedContact.id)
         }
       }
-      // ContactsSubscribed, ContactsDisconnected and ContactSubSummary are only used in CLI,
-      // They have to be used here for remote desktop to process these status updates.
       is CR.ContactsSubscribed -> updateContactsStatus(r.contactRefs, NetworkStatus.Connected())
       is CR.ContactsDisconnected -> updateContactsStatus(r.contactRefs, NetworkStatus.Disconnected())
       is CR.ContactSubSummary -> {

cabal.project

@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 8b94264623eb8f32793a3b4129cb12770f54ef3a
+    tag: 8f12555be5054a04cca88acf443f307af4ee84d8
 
 source-repository-package
     type: git

package.yaml

@@ -150,7 +150,6 @@ tests:
 
 ghc-options:
   # - -haddock
-  - -O2
   - -Wall
   - -Wcompat
   - -Werror=incomplete-patterns
@@ -158,8 +157,3 @@ ghc-options:
   - -Wincomplete-record-updates
   - -Wincomplete-uni-patterns
   - -Wunused-type-patterns
-  - -finfo-table-map
-  - -fdistinct-constructor-tables
-
-default-extensions:
-  - StrictData

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."8b94264623eb8f32793a3b4129cb12770f54ef3a" = "0n4wwpkj9dps7ansvlrdf4kiwjczij7y79i4cnr3gr0lmml8bpbs";
+  "https://github.com/simplex-chat/simplexmq.git"."ee90ea6a69fe8283d37d9821cd83798fd0a76260" = "0my9f4dlfa79yq73rys0m2zb61fd9bp65djvavk6jwy6qzl5vr40";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
   "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

simplex-chat.cabal

@@ -181,9 +181,7 @@ library
       Paths_simplex_chat
   hs-source-dirs:
       src
-  default-extensions:
-      StrictData
-  ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -finfo-table-map -fdistinct-constructor-tables
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -242,9 +240,7 @@ executable simplex-bot
       Paths_simplex_chat
   hs-source-dirs:
       apps/simplex-bot
-  default-extensions:
-      StrictData
-  ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -finfo-table-map -fdistinct-constructor-tables -threaded
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -304,9 +300,7 @@ executable simplex-bot-advanced
       Paths_simplex_chat
   hs-source-dirs:
       apps/simplex-bot-advanced
-  default-extensions:
-      StrictData
-  ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -finfo-table-map -fdistinct-constructor-tables -threaded
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -365,13 +359,11 @@ executable simplex-broadcast-bot
   hs-source-dirs:
       apps/simplex-broadcast-bot
       apps/simplex-broadcast-bot/src
-  default-extensions:
-      StrictData
   other-modules:
       Broadcast.Bot
       Broadcast.Options
       Paths_simplex_chat
-  ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -finfo-table-map -fdistinct-constructor-tables -threaded
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -432,9 +424,7 @@ executable simplex-chat
       Paths_simplex_chat
   hs-source-dirs:
       apps/simplex-chat
-  default-extensions:
-      StrictData
-  ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -finfo-table-map -fdistinct-constructor-tables -threaded
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -494,8 +484,6 @@ executable simplex-directory-service
   hs-source-dirs:
       apps/simplex-directory-service
       apps/simplex-directory-service/src
-  default-extensions:
-      StrictData
   other-modules:
       Directory.Events
       Directory.Options
@@ -503,7 +491,7 @@ executable simplex-directory-service
       Directory.Service
       Directory.Store
       Paths_simplex_chat
-  ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -finfo-table-map -fdistinct-constructor-tables -threaded
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -594,9 +582,7 @@ test-suite simplex-chat-test
       tests
       apps/simplex-broadcast-bot/src
       apps/simplex-directory-service/src
-  default-extensions:
-      StrictData
-  ghc-options: -O2 -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -finfo-table-map -fdistinct-constructor-tables -threaded
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       QuickCheck ==2.14.*
     , aeson ==2.2.*

src/Simplex/Chat/Archive.hs

@@ -44,7 +44,7 @@ archiveChatDbFile = "simplex_v1_chat.db"
 archiveFilesFolder :: String
 archiveFilesFolder = "simplex_v1_files"
 
-exportArchive :: ArchiveConfig -> CM' ()
+exportArchive :: ChatMonad m => ArchiveConfig -> m ()
 exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
   withTempDir cfg "simplex-chat." $ \dir -> do
     StorageFiles {chatStore, agentStore, filesPath} <- storageFiles
@@ -55,7 +55,7 @@ exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
     let method = if disableCompression == Just True then Z.Store else Z.Deflate
     Z.createArchive archivePath $ Z.packDirRecur method Z.mkEntrySelector dir
 
-importArchive :: ArchiveConfig -> CM' [ArchiveError]
+importArchive :: ChatMonad m => ArchiveConfig -> m [ArchiveError]
 importArchive cfg@ArchiveConfig {archivePath} =
   withTempDir cfg "simplex-chat." $ \dir -> do
     Z.withArchive archivePath $ Z.unpackInto dir
@@ -78,12 +78,12 @@ importArchive cfg@ArchiveConfig {archivePath} =
             (pure [])
         _ -> pure []
 
-withTempDir :: ArchiveConfig -> (String -> (FilePath -> CM' a) -> CM' a)
+withTempDir :: ChatMonad m => ArchiveConfig -> (String -> (FilePath -> m a) -> m a)
 withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
   Just tmpDir -> withTempDirectory tmpDir
   _ -> withSystemTempDirectory
 
-copyDirectoryFiles :: FilePath -> FilePath -> CM' [ArchiveError]
+copyDirectoryFiles :: ChatMonad m => FilePath -> FilePath -> m [ArchiveError]
 copyDirectoryFiles fromDir toDir = do
   createDirectoryIfMissing False toDir
   fs <- listDirectory fromDir
@@ -97,9 +97,9 @@ copyDirectoryFiles fromDir toDir = do
           f' = fromDir </> fn
       whenM (doesFileExist f') $ copyFile f' $ toDir </> fn
 
-deleteStorage :: CM ()
+deleteStorage :: ChatMonad m => m ()
 deleteStorage = do
-  fs <- lift storageFiles
+  fs <- storageFiles
   liftIO $ closeSQLiteStore `withStores` fs
   remove `withDBs` fs
   mapM_ removeDir $ filesPath fs
@@ -114,17 +114,17 @@ data StorageFiles = StorageFiles
     filesPath :: Maybe FilePath
   }
 
-storageFiles :: CM' StorageFiles
+storageFiles :: ChatMonad m => m StorageFiles
 storageFiles = do
   ChatController {chatStore, filesFolder, smpAgent} <- ask
   let agentStore = agentClientStore smpAgent
   filesPath <- readTVarIO filesFolder
   pure StorageFiles {chatStore, agentStore, filesPath}
 
-sqlCipherExport :: DBEncryptionConfig -> CM ()
+sqlCipherExport :: forall m. ChatMonad m => DBEncryptionConfig -> m ()
 sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = DBEncryptionKey key', keepKey} =
   when (key /= key') $ do
-    fs <- lift storageFiles
+    fs <- storageFiles
     checkFile `withDBs` fs
     backup `withDBs` fs
     checkEncryption `withStores` fs
@@ -159,7 +159,7 @@ sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = D
                    "DETACH DATABASE exported;"
                  ]
 
-withDB :: FilePath -> (SQL.Database -> IO a) -> (SQLiteError -> DatabaseError) -> CM ()
+withDB :: forall a m. ChatMonad m => FilePath -> (SQL.Database -> IO a) -> (SQLiteError -> DatabaseError) -> m ()
 withDB f' a err =
   liftIO (bracket (SQL.open $ T.pack f') SQL.close a $> Nothing)
     `catch` checkSQLError
@@ -169,7 +169,7 @@ withDB f' a err =
     checkSQLError e = case SQL.sqlError e of
       SQL.ErrorNotADatabase -> pure $ Just SQLiteErrorNotADatabase
       _ -> sqliteError' e
-    sqliteError' :: Show e => e -> CM (Maybe SQLiteError)
+    sqliteError' :: Show e => e -> m (Maybe SQLiteError)
     sqliteError' = pure . Just . SQLiteError . show
 
 testSQL :: BA.ScrubbedBytes -> Text
@@ -184,9 +184,9 @@ testSQL k =
 keySQL :: BA.ScrubbedBytes -> [Text]
 keySQL k = ["PRAGMA key = " <> keyString k <> ";" | not (BA.null k)]
 
-sqlCipherTestKey :: DBEncryptionKey -> CM ()
+sqlCipherTestKey :: forall m. ChatMonad m => DBEncryptionKey -> m ()
 sqlCipherTestKey (DBEncryptionKey key) = do
-  fs <- lift storageFiles
+  fs <- storageFiles
   testKey `withDBs` fs
   where
     testKey f = withDB f (`SQL.exec` testSQL key) DBErrorOpen

src/Simplex/Chat/Controller.hs

@@ -82,7 +82,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), Cor
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (TLS, simplexMQVersion)
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors', (<$$>))
+import Simplex.Messaging.Util (allFinally, catchAllErrors, liftIOEither, tryAllErrors, (<$$>))
 import Simplex.RemoteControl.Client
 import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitation)
 import Simplex.RemoteControl.Types
@@ -1140,7 +1140,7 @@ data DatabaseError
 data SQLiteError = SQLiteErrorNotADatabase | SQLiteError String
   deriving (Show, Exception)
 
-throwDBError :: DatabaseError -> CM ()
+throwDBError :: ChatMonad m => DatabaseError -> m ()
 throwDBError = throwError . ChatErrorDatabase
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
@@ -1244,59 +1244,39 @@ data RemoteCtrlInfo = RemoteCtrlInfo
   }
   deriving (Show)
 
-type CM' a = ReaderT ChatController IO a
+type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
 
-type CM a = ExceptT ChatError (ReaderT ChatController IO) a
+type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
 
-chatReadVar :: (ChatController -> TVar a) -> CM a
-chatReadVar = lift . chatReadVar'
+chatReadVar :: ChatMonad' m => (ChatController -> TVar a) -> m a
+chatReadVar f = asks f >>= readTVarIO
 {-# INLINE chatReadVar #-}
 
-chatReadVar' :: (ChatController -> TVar a) -> CM' a
-chatReadVar' f = asks f >>= readTVarIO
-{-# INLINE chatReadVar' #-}
-
-chatWriteVar :: (ChatController -> TVar a) -> a -> CM ()
-chatWriteVar f = lift . chatWriteVar' f
+chatWriteVar :: ChatMonad' m => (ChatController -> TVar a) -> a -> m ()
+chatWriteVar f value = asks f >>= atomically . (`writeTVar` value)
 {-# INLINE chatWriteVar #-}
 
-chatWriteVar' :: (ChatController -> TVar a) -> a -> CM' ()
-chatWriteVar' f value = asks f >>= atomically . (`writeTVar` value)
-{-# INLINE chatWriteVar' #-}
-
-chatModifyVar :: (ChatController -> TVar a) -> (a -> a) -> CM ()
-chatModifyVar f = lift . chatModifyVar' f
+chatModifyVar :: ChatMonad' m => (ChatController -> TVar a) -> (a -> a) -> m ()
+chatModifyVar f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
 {-# INLINE chatModifyVar #-}
 
-chatModifyVar' :: (ChatController -> TVar a) -> (a -> a) -> CM' ()
-chatModifyVar' f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
-{-# INLINE chatModifyVar' #-}
-
-setContactNetworkStatus :: Contact -> NetworkStatus -> CM' ()
+setContactNetworkStatus :: ChatMonad' m => Contact -> NetworkStatus -> m ()
 setContactNetworkStatus Contact {activeConn = Nothing} _ = pure ()
-setContactNetworkStatus Contact {activeConn = Just Connection {agentConnId}} status = chatModifyVar' connNetworkStatuses $ M.insert agentConnId status
+setContactNetworkStatus Contact {activeConn = Just Connection {agentConnId}} status = chatModifyVar connNetworkStatuses $ M.insert agentConnId status
 
-tryChatError :: CM a -> CM (Either ChatError a)
+tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
 tryChatError = tryAllErrors mkChatError
 {-# INLINE tryChatError #-}
 
-tryChatError' :: CM a -> CM' (Either ChatError a)
-tryChatError' = tryAllErrors' mkChatError
-{-# INLINE tryChatError' #-}
-
-catchChatError :: CM a -> (ChatError -> CM a) -> CM a
+catchChatError :: ChatMonad m => m a -> (ChatError -> m a) -> m a
 catchChatError = catchAllErrors mkChatError
 {-# INLINE catchChatError #-}
 
-catchChatError' :: CM a -> (ChatError -> CM' a) -> CM' a
-catchChatError' = catchAllErrors' mkChatError
-{-# INLINE catchChatError' #-}
-
-chatFinally :: CM a -> CM b -> CM a
+chatFinally :: ChatMonad m => m a -> m b -> m a
 chatFinally = allFinally mkChatError
 {-# INLINE chatFinally #-}
 
-onChatError :: CM a -> CM b -> CM a
+onChatError :: ChatMonad m => m a -> m b -> m a
 a `onChatError` onErr = a `catchChatError` \e -> onErr >> throwError e
 {-# INLINE onChatError #-}
 
@@ -1315,16 +1295,12 @@ mkStoreError = SEInternalError . show
 chatCmdError :: Maybe User -> String -> ChatResponse
 chatCmdError user = CRChatCmdError user . ChatError . CECommandError
 
-throwChatError :: ChatErrorType -> CM a
+throwChatError :: ChatMonad m => ChatErrorType -> m a
 throwChatError = throwError . ChatError
 
 -- | Emit local events.
-toView :: ChatResponse -> CM ()
-toView = lift . toView'
-{-# INLINE toView #-}
-
-toView' :: ChatResponse -> CM' ()
-toView' ev = do
+toView :: ChatMonad' m => ChatResponse -> m ()
+toView ev = do
   cc@ChatController {outputQ = localQ, remoteCtrlSession = session, config = ChatConfig {chatHooks}} <- ask
   event <- liftIO $ eventHook chatHooks cc ev
   atomically $
@@ -1334,15 +1310,15 @@ toView' ev = do
       -- TODO potentially, it should hold some events while connecting
       _ -> writeTBQueue localQ (Nothing, Nothing, event)
 
-withStore' :: (DB.Connection -> IO a) -> CM a
+withStore' :: ChatMonad m => (DB.Connection -> IO a) -> m a
 withStore' action = withStore $ liftIO . action
 
-withStore :: (DB.Connection -> ExceptT StoreError IO a) -> CM a
+withStore :: ChatMonad m => (DB.Connection -> ExceptT StoreError IO a) -> m a
 withStore action = do
   ChatController {chatStore} <- ask
-  liftEither =<< liftIO (withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors)
+  liftIOEither $ withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
 
-withStoreBatch :: Traversable t => (DB.Connection -> t (IO (Either ChatError a))) -> CM' (t (Either ChatError a))
+withStoreBatch :: (ChatMonad' m, Traversable t) => (DB.Connection -> t (IO (Either ChatError a))) -> m (t (Either ChatError a))
 withStoreBatch actions = do
   ChatController {chatStore} <- ask
   liftIO $ withTransaction chatStore $ mapM (`E.catches` handleDBErrors) . actions
@@ -1356,17 +1332,17 @@ handleDBErrors =
     E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
   ]
 
-withStoreBatch' :: Traversable t => (DB.Connection -> t (IO a)) -> CM' (t (Either ChatError a))
+withStoreBatch' :: (ChatMonad' m, Traversable t) => (DB.Connection -> t (IO a)) -> m (t (Either ChatError a))
 withStoreBatch' actions = withStoreBatch $ fmap (fmap Right) . actions
 
-withAgent :: (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
+withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a
 withAgent action =
   asks smpAgent
-    >>= liftIO . runExceptT . action
+    >>= runExceptT . action
     >>= liftEither . first (`ChatErrorAgent` Nothing)
 
-withAgent' :: (AgentClient -> IO a) -> CM' a
-withAgent' action = asks smpAgent >>= liftIO . action
+withAgent' :: ChatMonad' m => (AgentClient -> m a) -> m a
+withAgent' action = asks smpAgent >>= action
 
 $(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
 

src/Simplex/Chat/Files.hs

@@ -3,12 +3,13 @@
 
 module Simplex.Chat.Files where
 
+import Control.Monad.IO.Class
 import Simplex.Chat.Controller
 import Simplex.Messaging.Util (ifM)
 import System.FilePath (combine, splitExtensions)
 import UnliftIO.Directory (doesDirectoryExist, doesFileExist, getHomeDirectory, getTemporaryDirectory)
 
-uniqueCombine :: FilePath -> String -> IO FilePath
+uniqueCombine :: MonadIO m => FilePath -> String -> m FilePath
 uniqueCombine fPath fName = tryCombine (0 :: Int)
   where
     tryCombine n =
@@ -17,10 +18,10 @@ uniqueCombine fPath fName = tryCombine (0 :: Int)
           f = fPath `combine` (name <> suffix <> ext)
        in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
 
-getChatTempDirectory :: CM' FilePath
-getChatTempDirectory = chatReadVar' tempDirectory >>= maybe getTemporaryDirectory pure
+getChatTempDirectory :: ChatMonad m => m FilePath
+getChatTempDirectory = chatReadVar tempDirectory >>= maybe getTemporaryDirectory pure
 
-getDefaultFilesFolder :: CM' FilePath
+getDefaultFilesFolder :: ChatMonad m => m FilePath
 getDefaultFilesFolder = do
   dir <- (`combine` "Downloads") <$> getHomeDirectory
   ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory

src/Simplex/Chat/Remote.hs

@@ -49,7 +49,7 @@ import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Remote
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
-import Simplex.Chat.Util (liftIOEither, encryptFile)
+import Simplex.Chat.Util (encryptFile)
 import Simplex.FileTransfer.Description (FileDigest (..))
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Protocol (AgentErrorType (RCP))
@@ -95,7 +95,7 @@ discoveryTimeout = 60000000
 
 -- * Desktop side
 
-getRemoteHostClient :: RemoteHostId -> CM RemoteHostClient
+getRemoteHostClient :: ChatMonad m => RemoteHostId -> m RemoteHostClient
 getRemoteHostClient rhId = do
   sessions <- asks remoteHostSessions
   liftIOEither . atomically $
@@ -106,7 +106,7 @@ getRemoteHostClient rhId = do
   where
     rhKey = RHId rhId
 
-withRemoteHostSession :: RHKey -> SessionSeq -> (RemoteHostSession -> Either ChatError (a, RemoteHostSession)) -> CM a
+withRemoteHostSession :: ChatMonad m => RHKey -> SessionSeq -> (RemoteHostSession -> Either ChatError (a, RemoteHostSession)) -> m a
 withRemoteHostSession rhKey sseq f = do
   sessions <- asks remoteHostSessions
   r <-
@@ -121,7 +121,7 @@ withRemoteHostSession rhKey sseq f = do
   liftEither r
 
 -- | Transition session state with a 'RHNew' ID to an assigned 'RemoteHostId'
-setNewRemoteHostId :: SessionSeq -> RemoteHostId -> CM ()
+setNewRemoteHostId :: ChatMonad m => SessionSeq -> RemoteHostId -> m ()
 setNewRemoteHostId sseq rhId = do
   sessions <- asks remoteHostSessions
   liftIOEither . atomically $ do
@@ -136,13 +136,13 @@ setNewRemoteHostId sseq rhId = do
   where
     err = pure . Left . ChatErrorRemoteHost RHNew
 
-startRemoteHost :: Maybe (RemoteHostId, Bool) -> Maybe RCCtrlAddress -> Maybe Word16 -> CM (NonEmpty RCCtrlAddress, Maybe RemoteHostInfo, RCSignedInvitation)
+startRemoteHost :: ChatMonad m => Maybe (RemoteHostId, Bool) -> Maybe RCCtrlAddress -> Maybe Word16 -> m (NonEmpty RCCtrlAddress, Maybe RemoteHostInfo, RCSignedInvitation)
 startRemoteHost rh_ rcAddrPrefs_ port_ = do
   (rhKey, multicast, remoteHost_, pairing) <- case rh_ of
     Just (rhId, multicast) -> do
       rh@RemoteHost {hostPairing} <- withStore $ \db -> getRemoteHost db rhId
       pure (RHId rhId, multicast, Just $ remoteHostInfo rh $ Just RHSStarting, hostPairing) -- get from the database, start multicast if requested
-    Nothing -> lift . withAgent' $ \a -> (RHNew,False,Nothing,) <$> rcNewHostPairing a
+    Nothing -> withAgent $ \a -> (RHNew,False,Nothing,) <$> rcNewHostPairing a
   sseq <- startRemoteHostSession rhKey
   ctrlAppInfo <- mkCtrlAppInfo
   (localAddrs, invitation, rchClient, vars) <- handleConnectError rhKey sseq . withAgent $ \a -> rcConnectHost a pairing (J.toJSON ctrlAppInfo) multicast rcAddrPrefs_ port_
@@ -170,18 +170,18 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
       unless (isAppCompatible appVersion ctrlAppVersionRange) $ throwError $ RHEBadVersion appVersion
       when (encoding == PEKotlin && localEncoding == PESwift) $ throwError $ RHEProtocolError RPEIncompatibleEncoding
       pure hostInfo
-    handleConnectError :: RHKey -> SessionSeq -> CM a -> CM a
+    handleConnectError :: ChatMonad m => RHKey -> SessionSeq -> m a -> m a
     handleConnectError rhKey sessSeq action =
       action `catchChatError` \err -> do
         logError $ "startRemoteHost.rcConnectHost crashed: " <> tshow err
         cancelRemoteHostSession (Just (sessSeq, RHSRConnectionFailed err)) rhKey
         throwError err
-    handleHostError :: SessionSeq -> TVar RHKey -> CM () -> CM ()
+    handleHostError :: ChatMonad m => SessionSeq -> TVar RHKey -> m () -> m ()
     handleHostError sessSeq rhKeyVar action =
       action `catchChatError` \err -> do
         logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
         readTVarIO rhKeyVar >>= cancelRemoteHostSession (Just (sessSeq, RHSRCrashed err))
-    waitForHostSession :: Maybe RemoteHostInfo -> RHKey -> SessionSeq -> Maybe RCCtrlAddress -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> CM ()
+    waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> SessionSeq -> Maybe RCCtrlAddress -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
     waitForHostSession remoteHost_ rhKey sseq rcAddr_ rhKeyVar vars = do
       (sessId, tls, vars') <- timeoutThrow (ChatErrorRemoteHost rhKey RHETimeout) 60000000 $ takeRCStep vars
       let sessionCode = verificationCode sessId
@@ -203,7 +203,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
         toView $ CRNewRemoteHost rhi
       -- set up HTTP transport and remote profile protocol
       disconnected <- toIO $ onDisconnected rhKey' sseq
-      httpClient <- liftError' (httpError remoteHostId) $ attachRevHTTP2Client disconnected tls
+      httpClient <- liftEitherError (httpError remoteHostId) $ attachRevHTTP2Client disconnected tls
       rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
       pollAction <- async $ pollEvents remoteHostId rhClient
       withRemoteHostSession rhKey' sseq $ \case
@@ -211,7 +211,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
         _ -> Left $ ChatErrorRemoteHost rhKey RHEBadState
       chatWriteVar currentRemoteHost $ Just remoteHostId -- this is required for commands to be passed to remote host
       toView $ CRRemoteHostConnected rhi {sessionState = Just RHSConnected {sessionCode}}
-    upsertRemoteHost :: RCHostPairing -> Maybe RemoteHostInfo -> Maybe RCCtrlAddress -> Text -> SessionSeq -> RemoteHostSessionState -> CM RemoteHostInfo
+    upsertRemoteHost :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Maybe RCCtrlAddress -> Text -> SessionSeq -> RemoteHostSessionState -> m RemoteHostInfo
     upsertRemoteHost pairing'@RCHostPairing {knownHost = kh_} rhi_ rcAddr_ hostDeviceName sseq state = do
       KnownHostPairing {hostDhPubKey = hostDhPubKey'} <- maybe (throwError . ChatError $ CEInternalError "KnownHost is known after verification") pure kh_
       case rhi_ of
@@ -223,11 +223,11 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
         Just rhi@RemoteHostInfo {remoteHostId} -> do
           withStore' $ \db -> updateHostPairing db remoteHostId hostDeviceName hostDhPubKey' rcAddr_ port_
           pure (rhi :: RemoteHostInfo) {sessionState = Just state}
-    onDisconnected :: RHKey -> SessionSeq -> CM ()
+    onDisconnected :: ChatMonad m => RHKey -> SessionSeq -> m ()
     onDisconnected rhKey sseq = do
       logDebug $ "HTTP2 client disconnected: " <> tshow (rhKey, sseq)
       cancelRemoteHostSession (Just (sseq, RHSRDisconnected)) rhKey
-    pollEvents :: RemoteHostId -> RemoteHostClient -> CM ()
+    pollEvents :: ChatMonad m => RemoteHostId -> RemoteHostClient -> m ()
     pollEvents rhId rhClient = do
       oq <- asks outputQ
       forever $ do
@@ -236,7 +236,7 @@ startRemoteHost rh_ rcAddrPrefs_ port_ = do
     httpError :: RemoteHostId -> HTTP2ClientError -> ChatError
     httpError rhId = ChatErrorRemoteHost (RHId rhId) . RHEProtocolError . RPEHTTP2 . tshow
 
-startRemoteHostSession :: RHKey -> CM SessionSeq
+startRemoteHostSession :: ChatMonad m => RHKey -> m SessionSeq
 startRemoteHostSession rhKey = do
   sessions <- asks remoteHostSessions
   nextSessionSeq <- asks remoteSessionSeq
@@ -247,12 +247,12 @@ startRemoteHostSession rhKey = do
         sessionSeq <- stateTVar nextSessionSeq $ \s -> (s, s + 1)
         Right sessionSeq <$ TM.insert rhKey (sessionSeq, RHSessionStarting) sessions
 
-closeRemoteHost :: RHKey -> CM ()
+closeRemoteHost :: ChatMonad m => RHKey -> m ()
 closeRemoteHost rhKey = do
   logNote $ "Closing remote host session for " <> tshow rhKey
   cancelRemoteHostSession Nothing rhKey
 
-cancelRemoteHostSession :: Maybe (SessionSeq, RemoteHostStopReason) -> RHKey -> CM ()
+cancelRemoteHostSession :: ChatMonad m => Maybe (SessionSeq, RemoteHostStopReason) -> RHKey -> m ()
 cancelRemoteHostSession handlerInfo_ rhKey = do
   sessions <- asks remoteHostSessions
   crh <- asks currentRemoteHost
@@ -299,7 +299,7 @@ cancelRemoteHost handlingError = \case
 randomStorePath :: IO FilePath
 randomStorePath = B.unpack . B64U.encode <$> getRandomBytes 12
 
-listRemoteHosts :: CM [RemoteHostInfo]
+listRemoteHosts :: ChatMonad m => m [RemoteHostInfo]
 listRemoteHosts = do
   sessions <- chatReadVar remoteHostSessions
   map (rhInfo sessions) <$> withStore' getRemoteHosts
@@ -307,7 +307,7 @@ listRemoteHosts = do
     rhInfo sessions rh@RemoteHost {remoteHostId} =
       remoteHostInfo rh $ rhsSessionState . snd <$> M.lookup (RHId remoteHostId) sessions
 
-switchRemoteHost :: Maybe RemoteHostId -> CM (Maybe RemoteHostInfo)
+switchRemoteHost :: ChatMonad m => Maybe RemoteHostId -> m (Maybe RemoteHostInfo)
 switchRemoteHost rhId_ = do
   rhi_ <- forM rhId_ $ \rhId -> do
     let rhKey = RHId rhId
@@ -322,7 +322,7 @@ remoteHostInfo :: RemoteHost -> Maybe RemoteHostSessionState -> RemoteHostInfo
 remoteHostInfo RemoteHost {remoteHostId, storePath, hostDeviceName, bindAddress_, bindPort_} sessionState =
   RemoteHostInfo {remoteHostId, storePath, hostDeviceName, bindAddress_, bindPort_, sessionState}
 
-deleteRemoteHost :: RemoteHostId -> CM ()
+deleteRemoteHost :: ChatMonad m => RemoteHostId -> m ()
 deleteRemoteHost rhId = do
   RemoteHost {storePath} <- withStore (`getRemoteHost` rhId)
   chatReadVar remoteHostsFolder >>= \case
@@ -333,7 +333,7 @@ deleteRemoteHost rhId = do
     Nothing -> logWarn "Local file store not available while deleting remote host"
   withStore' (`deleteRemoteHostRecord` rhId)
 
-storeRemoteFile :: RemoteHostId -> Maybe Bool -> FilePath -> CM CryptoFile
+storeRemoteFile :: forall m. ChatMonad m => RemoteHostId -> Maybe Bool -> FilePath -> m CryptoFile
 storeRemoteFile rhId encrypted_ localPath = do
   c@RemoteHostClient {encryptHostFiles, storePath} <- getRemoteHostClient rhId
   let encrypt = fromMaybe encryptHostFiles encrypted_
@@ -347,23 +347,23 @@ storeRemoteFile rhId encrypted_ localPath = do
     (if encrypt then renameFile else copyFile) filePath hPath
   pure (cf :: CryptoFile) {filePath = filePath'}
   where
-    encryptLocalFile :: CM CryptoFile
+    encryptLocalFile :: m CryptoFile
     encryptLocalFile = do
-      tmpDir <- lift getChatTempDirectory
+      tmpDir <- getChatTempDirectory
       createDirectoryIfMissing True tmpDir
-      tmpFile <- liftIO $ tmpDir `uniqueCombine` takeFileName localPath
+      tmpFile <- tmpDir `uniqueCombine` takeFileName localPath
       cfArgs <- atomically . CF.randomArgs =<< asks random
-      liftEither =<< liftIO (runExceptT $ withExceptT (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs)
+      liftError (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs
       pure $ CryptoFile tmpFile $ Just cfArgs
 
-getRemoteFile :: RemoteHostId -> RemoteFile -> CM ()
+getRemoteFile :: ChatMonad m => RemoteHostId -> RemoteFile -> m ()
 getRemoteFile rhId rf = do
   c@RemoteHostClient {storePath} <- getRemoteHostClient rhId
-  dir <- lift $ (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar' remoteHostsFolder)
+  dir <- (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar remoteHostsFolder)
   createDirectoryIfMissing True dir
   liftRH rhId $ remoteGetFile c dir rf
 
-processRemoteCommand :: RemoteHostId -> RemoteHostClient -> ChatCommand -> ByteString -> CM ChatResponse
+processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostClient -> ChatCommand -> ByteString -> m ChatResponse
 processRemoteCommand remoteHostId c cmd s = case cmd of
   SendFile chatName f -> sendFile "/f" chatName f
   SendImage chatName f -> sendFile "/img" chatName f
@@ -378,7 +378,7 @@ processRemoteCommand remoteHostId c cmd s = case cmd of
       maybe "" (\(CFArgs key nonce) -> "key=" <> strEncode key <> " nonce=" <> strEncode nonce <> " ") cryptoArgs
         <> encodeUtf8 (T.pack filePath)
 
-liftRH :: RemoteHostId -> ExceptT RemoteProtocolError IO a -> CM a
+liftRH :: ChatMonad m => RemoteHostId -> ExceptT RemoteProtocolError IO a -> m a
 liftRH rhId = liftError (ChatErrorRemoteHost (RHId rhId) . RHEProtocolError)
 
 -- * Mobile side
@@ -386,7 +386,7 @@ liftRH rhId = liftError (ChatErrorRemoteHost (RHId rhId) . RHEProtocolError)
 -- ** QR/link
 
 -- | Use provided OOB link as an annouce
-connectRemoteCtrlURI :: RCSignedInvitation -> CM (Maybe RemoteCtrlInfo, CtrlAppInfo)
+connectRemoteCtrlURI :: ChatMonad m => RCSignedInvitation -> m (Maybe RemoteCtrlInfo, CtrlAppInfo)
 connectRemoteCtrlURI signedInv = do
   verifiedInv <- maybe (throwError $ ChatErrorRemoteCtrl RCEBadInvitation) pure $ verifySignedInvitation signedInv
   sseq <- startRemoteCtrlSession
@@ -394,7 +394,7 @@ connectRemoteCtrlURI signedInv = do
 
 -- ** Multicast
 
-findKnownRemoteCtrl :: CM ()
+findKnownRemoteCtrl :: ChatMonad m => m ()
 findKnownRemoteCtrl = do
   knownCtrls <- withStore' getRemoteCtrls
   pairings <- case nonEmpty knownCtrls of
@@ -420,7 +420,7 @@ findKnownRemoteCtrl = do
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
   atomically $ putTMVar cmdOk ()
 
-confirmRemoteCtrl :: RemoteCtrlId -> CM (RemoteCtrlInfo, CtrlAppInfo)
+confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m (RemoteCtrlInfo, CtrlAppInfo)
 confirmRemoteCtrl rcId = do
   session <- asks remoteCtrlSession
   (sseq, listener, found) <- liftIOEither $ atomically $ do
@@ -438,7 +438,7 @@ confirmRemoteCtrl rcId = do
 
 -- ** Common
 
-startRemoteCtrlSession :: CM SessionSeq
+startRemoteCtrlSession :: ChatMonad m => m SessionSeq
 startRemoteCtrlSession = do
   session <- asks remoteCtrlSession
   nextSessionSeq <- asks remoteSessionSeq
@@ -449,7 +449,7 @@ startRemoteCtrlSession = do
         sseq <- stateTVar nextSessionSeq $ \s -> (s, s + 1)
         Right sseq <$ writeTVar session (Just (sseq, RCSessionStarting))
 
-connectRemoteCtrl :: RCVerifiedInvitation -> SessionSeq -> CM (Maybe RemoteCtrlInfo, CtrlAppInfo)
+connectRemoteCtrl :: ChatMonad m => RCVerifiedInvitation -> SessionSeq -> m (Maybe RemoteCtrlInfo, CtrlAppInfo)
 connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app}) sseq = handleCtrlError sseq RCSRConnectionFailed "connectRemoteCtrl" $ do
   ctrlInfo@CtrlAppInfo {deviceName = ctrlDeviceName} <- parseCtrlAppInfo app
   v <- checkAppVersion ctrlInfo
@@ -470,7 +470,7 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
   where
     validateRemoteCtrl RCInvitation {idkey} RemoteCtrl {ctrlPairing = RCCtrlPairing {idPubKey}} =
       unless (idkey == idPubKey) $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError $ PRERemoteControl RCEIdentity
-    waitForCtrlSession :: Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> CM ()
+    waitForCtrlSession :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m ()
     waitForCtrlSession rc_ ctrlName rcsClient vars = do
       (uniq, tls, rcsWaitConfirmation) <- timeoutThrow (ChatErrorRemoteCtrl RCETimeout) networkIOTimeout $ takeRCStep vars
       let sessionCode = verificationCode uniq
@@ -489,11 +489,11 @@ connectRemoteCtrl verifiedInv@(RCVerifiedInvitation inv@RCInvitation {ca, app})
       encryptFiles <- chatReadVar encryptLocalFiles
       pure HostAppInfo {appVersion, deviceName = hostDeviceName, encoding = localEncoding, encryptFiles}
 
-parseCtrlAppInfo :: JT.Value -> CM CtrlAppInfo
+parseCtrlAppInfo :: ChatMonad m => JT.Value -> m CtrlAppInfo
 parseCtrlAppInfo ctrlAppInfo = do
   liftEitherWith (const $ ChatErrorRemoteCtrl RCEBadInvitation) $ JT.parseEither J.parseJSON ctrlAppInfo
 
-handleRemoteCommand :: (ByteString -> CM' ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> CM ()
+handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> m ()
 handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
   logDebug "handleRemoteCommand"
   liftRC (tryRemoteError parseRequest) >>= \case
@@ -508,15 +508,15 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
       (header, getNext) <- parseDecryptHTTP2Body encryption request reqBody
       (getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecode header)
     replyError = reply . RRChatResponse . CRChatCmdError Nothing
-    processCommand :: User -> GetChunk -> RemoteCommand -> CM ()
+    processCommand :: User -> GetChunk -> RemoteCommand -> m ()
     processCommand user getNext = \case
-      RCSend {command} -> lift (handleSend execChatCommand command) >>= reply
-      RCRecv {wait = time} -> liftIO (handleRecv time remoteOutputQ) >>= reply
-      RCStoreFile {fileName, fileSize, fileDigest} -> lift (handleStoreFile encryption fileName fileSize fileDigest getNext) >>= reply
+      RCSend {command} -> handleSend execChatCommand command >>= reply
+      RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
+      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile encryption fileName fileSize fileDigest getNext >>= reply
       RCGetFile {file} -> handleGetFile encryption user file replyWith
-    reply :: RemoteResponse -> CM ()
+    reply :: RemoteResponse -> m ()
     reply = (`replyWith` \_ -> pure ())
-    replyWith :: Respond
+    replyWith :: Respond m
     replyWith rr attach = do
       resp <- liftRC $ encryptEncodeHTTP2Body encryption $ J.encode rr
       liftIO . sendResponse . responseStreaming N.status200 [] $ \send flush -> do
@@ -524,55 +524,51 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
         attach send
         flush
 
-takeRCStep :: RCStepTMVar a -> CM a
-takeRCStep = liftError' (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar
+takeRCStep :: ChatMonad m => RCStepTMVar a -> m a
+takeRCStep = liftEitherError (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar
 
 type GetChunk = Int -> IO ByteString
 
 type SendChunk = Builder -> IO ()
 
-type Respond = RemoteResponse -> (SendChunk -> IO ()) -> CM ()
+type Respond m = RemoteResponse -> (SendChunk -> IO ()) -> m ()
 
-liftRC :: ExceptT RemoteProtocolError IO a -> CM a
+liftRC :: ChatMonad m => ExceptT RemoteProtocolError IO a -> m a
 liftRC = liftError (ChatErrorRemoteCtrl . RCEProtocolError)
 
 tryRemoteError :: ExceptT RemoteProtocolError IO a -> ExceptT RemoteProtocolError IO (Either RemoteProtocolError a)
 tryRemoteError = tryAllErrors (RPEException . tshow)
 {-# INLINE tryRemoteError #-}
 
-tryRemoteError' :: ExceptT RemoteProtocolError IO a -> IO (Either RemoteProtocolError a)
-tryRemoteError' = tryAllErrors' (RPEException . tshow)
-{-# INLINE tryRemoteError' #-}
-
-handleSend :: (ByteString -> CM' ChatResponse) -> Text -> CM' RemoteResponse
+handleSend :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteResponse
 handleSend execChatCommand command = do
   logDebug $ "Send: " <> tshow command
   -- execChatCommand checks for remote-allowed commands
-  -- convert errors thrown in execChatCommand into error responses to prevent aborting the protocol wrapper
-  RRChatResponse <$> lift (execChatCommand $ encodeUtf8 command) `catchChatError'` (pure . CRChatError Nothing)
+  -- convert errors thrown in ChatMonad into error responses to prevent aborting the protocol wrapper
+  RRChatResponse <$> execChatCommand (encodeUtf8 command) `catchError` (pure . CRChatError Nothing)
 
-handleRecv :: Int -> TBQueue ChatResponse -> IO RemoteResponse
+handleRecv :: MonadUnliftIO m => Int -> TBQueue ChatResponse -> m RemoteResponse
 handleRecv time events = do
   logDebug $ "Recv: " <> tshow time
   RRChatEvent <$> (timeout time . atomically $ readTBQueue events)
 
 -- TODO this command could remember stored files and return IDs to allow removing files that are not needed.
 -- Also, there should be some process removing unused files uploaded to remote host (possibly, all unused files).
-handleStoreFile :: RemoteCrypto -> FilePath -> Word32 -> FileDigest -> GetChunk -> CM' RemoteResponse
+handleStoreFile :: forall m. ChatMonad m => RemoteCrypto -> FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
 handleStoreFile encryption fileName fileSize fileDigest getChunk =
-  either RRProtocolError RRFileStored <$> (chatReadVar' filesFolder >>= storeFile)
+  either RRProtocolError RRFileStored <$> (chatReadVar filesFolder >>= storeFile)
   where
-    storeFile :: Maybe FilePath -> CM' (Either RemoteProtocolError FilePath)
+    storeFile :: Maybe FilePath -> m (Either RemoteProtocolError FilePath)
     storeFile = \case
       Just ff -> takeFileName <$$> storeFileTo ff
       Nothing -> storeFileTo =<< getDefaultFilesFolder
-    storeFileTo :: FilePath -> CM' (Either RemoteProtocolError FilePath)
-    storeFileTo dir = liftIO . tryRemoteError' $ do
-      filePath <- liftIO $ dir `uniqueCombine` fileName
+    storeFileTo :: FilePath -> m (Either RemoteProtocolError FilePath)
+    storeFileTo dir = liftRC . tryRemoteError $ do
+      filePath <- dir `uniqueCombine` fileName
       receiveEncryptedFile encryption getChunk fileSize fileDigest filePath
       pure filePath
 
-handleGetFile :: RemoteCrypto -> User -> RemoteFile -> Respond -> CM ()
+handleGetFile :: ChatMonad m => RemoteCrypto -> User -> RemoteFile -> Respond m -> m ()
 handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do
   logDebug $ "GetFile: " <> tshow filePath
   unless (userId == commandUserId) $ throwChatError $ CEDifferentActiveUser {commandUserId, activeUserId = userId}
@@ -587,7 +583,7 @@ handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileI
         encFile <- liftRC $ prepareEncryptedFile encryption (h, fileSize)
         reply RRFile {fileSize, fileDigest} $ sendEncryptedFile encFile
 
-listRemoteCtrls :: CM [RemoteCtrlInfo]
+listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo]
 listRemoteCtrls = do
   session <- snd <$$> chatReadVar remoteCtrlSession
   let rcId = sessionRcId =<< session
@@ -608,7 +604,7 @@ remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionState =
   RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionState}
 
 -- | Take a look at emoji of tlsunique, commit pairing, and start session server
-verifyRemoteCtrlSession :: (ByteString -> CM' ChatResponse) -> Text -> CM RemoteCtrlInfo
+verifyRemoteCtrlSession :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteCtrlInfo
 verifyRemoteCtrlSession execChatCommand sessCode' = do
   (sseq, client, ctrlName, sessionCode, vars) <-
     chatReadVar remoteCtrlSession >>= \case
@@ -630,7 +626,7 @@ verifyRemoteCtrlSession execChatCommand sessCode' = do
       _ -> Left $ ChatErrorRemoteCtrl RCEBadState
     pure $ remoteCtrlInfo rc $ Just RCSConnected {sessionCode = tlsSessionCode tls}
   where
-    upsertRemoteCtrl :: Text -> RCCtrlPairing -> CM RemoteCtrl
+    upsertRemoteCtrl :: ChatMonad m => Text -> RCCtrlPairing -> m RemoteCtrl
     upsertRemoteCtrl ctrlName rcCtrlPairing = withStore $ \db -> do
       rc_ <- liftIO $ getRemoteCtrlByFingerprint db (ctrlFingerprint rcCtrlPairing)
       case rc_ of
@@ -639,16 +635,16 @@ verifyRemoteCtrlSession execChatCommand sessCode' = do
           let dhPrivKey' = dhPrivKey rcCtrlPairing
           liftIO $ updateRemoteCtrl db rc ctrlName dhPrivKey'
           pure rc {ctrlDeviceName = ctrlName, ctrlPairing = ctrlPairing {dhPrivKey = dhPrivKey'}}
-    monitor :: SessionSeq -> Async () -> CM ()
+    monitor :: ChatMonad m => SessionSeq -> Async () -> m ()
     monitor sseq server = do
       res <- waitCatch server
       logInfo $ "HTTP2 server stopped: " <> tshow res
       cancelActiveRemoteCtrl $ Just (sseq, RCSRDisconnected)
 
-stopRemoteCtrl :: CM ()
+stopRemoteCtrl :: ChatMonad m => m ()
 stopRemoteCtrl = cancelActiveRemoteCtrl Nothing
 
-handleCtrlError :: SessionSeq -> (ChatError -> RemoteCtrlStopReason) -> Text -> CM a -> CM a
+handleCtrlError :: ChatMonad m => SessionSeq -> (ChatError -> RemoteCtrlStopReason) -> Text -> m a -> m a
 handleCtrlError sseq mkReason name action =
   action `catchChatError` \e -> do
     logError $ name <> " remote ctrl error: " <> tshow e
@@ -656,7 +652,7 @@ handleCtrlError sseq mkReason name action =
     throwError e
 
 -- | Stop session controller, unless session update key is present but stale
-cancelActiveRemoteCtrl :: Maybe (SessionSeq, RemoteCtrlStopReason) -> CM ()
+cancelActiveRemoteCtrl :: ChatMonad m => Maybe (SessionSeq, RemoteCtrlStopReason) -> m ()
 cancelActiveRemoteCtrl handlerInfo_ = handleAny (logError . tshow) $ do
   var <- asks remoteCtrlSession
   session_ <-
@@ -689,18 +685,18 @@ cancelRemoteCtrl handlingError = \case
     cancelCtrlClient rcsClient
     closeConnection tls
 
-deleteRemoteCtrl :: RemoteCtrlId -> CM ()
+deleteRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
 deleteRemoteCtrl rcId = do
   checkNoRemoteCtrlSession
   -- TODO check it exists
   withStore' (`deleteRemoteCtrlRecord` rcId)
 
-checkNoRemoteCtrlSession :: CM ()
+checkNoRemoteCtrlSession :: ChatMonad m => m ()
 checkNoRemoteCtrlSession =
   chatReadVar remoteCtrlSession >>= maybe (pure ()) (\_ -> throwError $ ChatErrorRemoteCtrl RCEBusy)
 
 -- | Transition controller to a new state, unless session update key is stale
-updateRemoteCtrlSession :: SessionSeq -> (RemoteCtrlSession -> Either ChatError RemoteCtrlSession) -> CM ()
+updateRemoteCtrlSession :: ChatMonad m => SessionSeq -> (RemoteCtrlSession -> Either ChatError RemoteCtrlSession) -> m ()
 updateRemoteCtrlSession sseq state = do
   session <- asks remoteCtrlSession
   r <- atomically $ do

src/Simplex/Chat/Remote/Protocol.hs

@@ -46,7 +46,7 @@ import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFi
 import Simplex.Messaging.Transport.Buffer (getBuffered)
 import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk)
 import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect)
-import Simplex.Messaging.Util (liftError', liftEitherWith, liftError, tshow)
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith, liftError, tshow)
 import Simplex.RemoteControl.Client (xrcpBlockSize)
 import qualified Simplex.RemoteControl.Client as RC
 import Simplex.RemoteControl.Types (CtrlSessKeys (..), HostSessKeys (..), RCErrorType (..), SessionCode)
@@ -75,7 +75,7 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse)
 
 -- * Client side / desktop
 
-mkRemoteHostClient :: HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> CM RemoteHostClient
+mkRemoteHostClient :: ChatMonad m => HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> m RemoteHostClient
 mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {encoding, deviceName, encryptFiles} = do
   drg <- asks random
   counter <- newTVarIO 1
@@ -92,15 +92,15 @@ mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {enc
         storePath
       }
 
-mkCtrlRemoteCrypto :: CtrlSessKeys -> SessionCode -> CM RemoteCrypto
+mkCtrlRemoteCrypto :: ChatMonad m => CtrlSessKeys -> SessionCode -> m RemoteCrypto
 mkCtrlRemoteCrypto CtrlSessKeys {hybridKey, idPubKey, sessPubKey} sessionCode = do
   drg <- asks random
   counter <- newTVarIO 1
   let signatures = RSVerify {idPubKey, sessPubKey}
   pure RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures}
 
-closeRemoteHostClient :: RemoteHostClient -> IO ()
-closeRemoteHostClient RemoteHostClient {httpClient} = closeHTTP2Client httpClient
+closeRemoteHostClient :: MonadIO m => RemoteHostClient -> m ()
+closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client httpClient
 
 -- ** Commands
 
@@ -141,7 +141,7 @@ sendRemoteCommand :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand
 sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_ cmd = do
   encFile_ <- mapM (prepareEncryptedFile encryption) file_
   req <- httpRequest encFile_ <$> encryptEncodeHTTP2Body encryption (J.encode cmd)
-  HTTP2Response {response, respBody} <- liftError' (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
+  HTTP2Response {response, respBody} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
   (header, getNext) <- parseDecryptHTTP2Body encryption response respBody
   rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecode header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding
   pure (getNext, rr)
@@ -271,7 +271,7 @@ parseDecryptHTTP2Body RemoteCrypto {hybridKey, sessionCode, signatures} hr HTTP2
       where
         getSig = do
           len <- liftIO $ B.head <$> getNext 1
-          liftError' RPEInvalidBody $ C.decodeSignature <$> getNext (fromIntegral len)
+          liftEitherError RPEInvalidBody $ C.decodeSignature <$> getNext (fromIntegral len)
         verifySig key sig hc' = do
           let signed = BA.convert $ CH.hashFinalize hc'
           unless (C.verify' key sig signed) $ throwError $ PRERemoteControl RCECtrlAuth

src/Simplex/Chat/Remote/Transport.hs

@@ -15,7 +15,7 @@ import Simplex.FileTransfer.Transport (ReceiveFileError (..), receiveSbFile, sen
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Util (liftError', liftEitherWith)
+import Simplex.Messaging.Util (liftEitherError, liftEitherWith)
 import Simplex.RemoteControl.Types (RCErrorType (..))
 import UnliftIO
 import UnliftIO.Directory (getFileSize)
@@ -37,11 +37,11 @@ receiveEncryptedFile :: RemoteCrypto -> (Int -> IO ByteString) -> Word32 -> File
 receiveEncryptedFile RemoteCrypto {hybridKey} getChunk fileSize fileDigest toPath = do
   c <- liftIO $ getChunk 1
   unless (c == "\x01") $ throwError RPENoFile
-  nonce <- liftError' RPEInvalidBody $ smpDecode <$> getChunk 24
-  size <- liftError' RPEInvalidBody $ smpDecode <$> getChunk 4
+  nonce <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 24
+  size <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 4
   unless (size == fileSize + fromIntegral C.authTagSize) $ throwError RPEFileSize
   sbState <- liftEitherWith (const $ PRERemoteControl RCEDecrypt) $ LC.kcbInit hybridKey nonce
-  liftError' fErr $ withFile toPath WriteMode $ \h -> receiveSbFile getChunk h sbState fileSize
+  liftEitherError fErr $ withFile toPath WriteMode $ \h -> receiveSbFile getChunk h sbState fileSize
   digest <- liftIO $ LC.sha512Hash <$> LB.readFile toPath
   unless (FileDigest digest == fileDigest) $ throwError RPEFileDigest
   where

src/Simplex/Chat/Store/Connections.hs

@@ -189,16 +189,18 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2
         (userId, cReqHash1, cReqHash2, ConnDeleted)
   maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
 
-getConnectionsToSubscribe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> IO ([ConnId], [ConnectionEntity])
-getConnectionsToSubscribe db vr = do
-  aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"
-  entities <- forM aConnIds $ \acId -> do
-    getUserByAConnId db acId >>= \case
-      Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId)
-      Nothing -> pure Nothing
-  unsetConnectionToSubscribe db
-  let connIds = map (\(AgentConnId connId) -> connId) aConnIds
-  pure (connIds, catMaybes entities)
+getConnectionsToSubscribe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> es -> (es -> ConnectionEntity -> es) -> IO ([ConnId], es)
+getConnectionsToSubscribe db vr initialES addEntity = do
+  r <- DB.fold_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1" ([], initialES) collect
+  r <$ unsetConnectionToSubscribe db
+  where
+    collect (cids, es) (Only acId@(AgentConnId connId)) = do
+      es' <- getUserByAConnId db acId >>= \case
+        Just user -> runExceptT (getConnectionEntity db vr user acId) >>= \case
+          Right ce -> pure $! addEntity es ce
+          Left _err -> pure es
+        Nothing -> pure es
+      pure (connId : cids, es')
 
 unsetConnectionToSubscribe :: DB.Connection -> IO ()
 unsetConnectionToSubscribe db = DB.execute_ db "UPDATE connections SET to_subscribe = 0 WHERE to_subscribe = 1"

src/Simplex/Chat/Util.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE TupleSections #-}
 
-module Simplex.Chat.Util (week, encryptFile, chunkSize, liftIOEither, shuffle) where
+module Simplex.Chat.Util (week, encryptFile, chunkSize, shuffle) where
 
 import Control.Monad
 import Control.Monad.Except
@@ -42,7 +42,3 @@ shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) x
   where
     random :: IO Word16
     random = randomRIO (0, 65535)
-
-liftIOEither :: (MonadIO m, MonadError e m) => IO (Either e a) -> m a
-liftIOEither a = liftIO a >>= liftEither
-{-# INLINE liftIOEither #-}

tests/ChatClient.hs

@@ -87,7 +87,7 @@ testOpts =
 testCoreOpts :: CoreChatOpts
 testCoreOpts =
   CoreChatOpts
-    { dbFilePrefix = "./simplex_v1",
+    { dbFilePrefix = undefined,
       dbKey = "",
       -- dbKey = "this is a pass-phrase to encrypt the database",
       smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],