Merge branch 'ep/remove-mtl' into ab/ios-haskell-init

apps/ios/Shared/SimpleXApp.swift

@@ -22,8 +22,10 @@ struct SimpleXApp: App {
 
     init() {
         DispatchQueue.global(qos: .background).sync {
-            haskell_init()
-//            hs_init(0, nil)
+            // 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)
         }
         UserDefaults.standard.register(defaults: appDefaults)
         setGroupDefaults()

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

@@ -45,6 +45,11 @@ struct DeveloperView: View {
                 }
 
                 if developerTools {
+                    Section {
+                        exportDebugProfileButton()
+                        exportEventLogButton()
+                    }
+
                     Section {
                         settingsRow("key") {
                             Toggle("Post-quantum E2EE", isOn: $pqExperimentalEnabled)
@@ -62,6 +67,24 @@ 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,7 +415,8 @@ func startChat() -> DBMigrationResult? {
 
 func doStartChat() -> DBMigrationResult? {
     logger.debug("NotificationService: doStartChat")
-    haskell_init_nse()
+    haskell_init(1, nil, getAppDebugProfilePrefixPath().path)
+//    haskell_init(1, nil, nil)
     let (_, dbStatus) = chatMigrateInit(confirmMigrations: defaultMigrationConfirmation(), backgroundMode: true)
     logger.debug("NotificationService: doStartChat \(String(describing: dbStatus))")
     if dbStatus != .ok {

apps/ios/SimpleX.xcodeproj/project.pbxproj

@@ -18,6 +18,11 @@
 		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 */; };
@@ -36,11 +41,6 @@
 		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,6 +263,11 @@
 		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>"; };
@@ -290,11 +295,6 @@
 		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 */,
-				5C371E782BACC5D600100AD3 /* libHSsimplex-chat-5.6.0.4-E0iWSIg8fcR48og4na41Dv.a in Frameworks */,
-				5C371E762BACC5D600100AD3 /* libffi.a in Frameworks */,
-				5C371E772BACC5D600100AD3 /* libgmp.a in Frameworks */,
+				411D3A7E2BB9601D003D9A22 /* libgmpxx.a in Frameworks */,
+				411D3A7C2BB9601D003D9A22 /* libgmp.a in Frameworks */,
+				411D3A802BB9601D003D9A22 /* libHSsimplex-chat-5.6.0.4-FOF2McwHkk1EIlP5UNozOv.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 = (
-				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 */,
+				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 */,
 			);
 			path = Libraries;
 			sourceTree = "<group>";
@@ -1576,6 +1576,7 @@
 				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;
@@ -1689,6 +1690,7 @@
 				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;
@@ -1767,6 +1769,7 @@
 				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/FileUtils.swift

@@ -52,6 +52,10 @@ 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)
 }
@@ -62,6 +66,18 @@ 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,19 +7,53 @@
 //
 
 #include "hs_init.h"
+#include <string.h>
 
 extern void hs_init_with_rtsopts(int * argc, char **argv[]);
 
-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
-    };
+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
     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(void);
+void haskell_init(int nse, const char *eventlog, const char *heap_profile);
 
 void haskell_init_nse(void);
 

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: ee90ea6a69fe8283d37d9821cd83798fd0a76260
+    tag: 8b94264623eb8f32793a3b4129cb12770f54ef3a
 
 source-repository-package
     type: git

package.yaml

@@ -150,6 +150,7 @@ tests:
 
 ghc-options:
   # - -haddock
+  - -O2
   - -Wall
   - -Wcompat
   - -Werror=incomplete-patterns
@@ -157,3 +158,8 @@ 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"."ee90ea6a69fe8283d37d9821cd83798fd0a76260" = "0my9f4dlfa79yq73rys0m2zb61fd9bp65djvavk6jwy6qzl5vr40";
+  "https://github.com/simplex-chat/simplexmq.git"."8b94264623eb8f32793a3b4129cb12770f54ef3a" = "0n4wwpkj9dps7ansvlrdf4kiwjczij7y79i4cnr3gr0lmml8bpbs";
   "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,7 +181,9 @@ library
       Paths_simplex_chat
   hs-source-dirs:
       src
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  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
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -240,7 +242,9 @@ executable simplex-bot
       Paths_simplex_chat
   hs-source-dirs:
       apps/simplex-bot
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  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
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -300,7 +304,9 @@ executable simplex-bot-advanced
       Paths_simplex_chat
   hs-source-dirs:
       apps/simplex-bot-advanced
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  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
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -359,11 +365,13 @@ 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: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  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
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -424,7 +432,9 @@ executable simplex-chat
       Paths_simplex_chat
   hs-source-dirs:
       apps/simplex-chat
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  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
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -484,6 +494,8 @@ 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
@@ -491,7 +503,7 @@ executable simplex-directory-service
       Directory.Service
       Directory.Store
       Paths_simplex_chat
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  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
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12
@@ -582,7 +594,9 @@ test-suite simplex-chat-test
       tests
       apps/simplex-broadcast-bot/src
       apps/simplex-directory-service/src
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  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
   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 :: ChatMonad m => ArchiveConfig -> m ()
+exportArchive :: ArchiveConfig -> CM' ()
 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 :: ChatMonad m => ArchiveConfig -> m [ArchiveError]
+importArchive :: ArchiveConfig -> CM' [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 :: ChatMonad m => ArchiveConfig -> (String -> (FilePath -> m a) -> m a)
+withTempDir :: ArchiveConfig -> (String -> (FilePath -> CM' a) -> CM' a)
 withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
   Just tmpDir -> withTempDirectory tmpDir
   _ -> withSystemTempDirectory
 
-copyDirectoryFiles :: ChatMonad m => FilePath -> FilePath -> m [ArchiveError]
+copyDirectoryFiles :: FilePath -> FilePath -> CM' [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 :: ChatMonad m => m ()
+deleteStorage :: CM ()
 deleteStorage = do
-  fs <- storageFiles
+  fs <- lift storageFiles
   liftIO $ closeSQLiteStore `withStores` fs
   remove `withDBs` fs
   mapM_ removeDir $ filesPath fs
@@ -114,17 +114,17 @@ data StorageFiles = StorageFiles
     filesPath :: Maybe FilePath
   }
 
-storageFiles :: ChatMonad m => m StorageFiles
+storageFiles :: CM' StorageFiles
 storageFiles = do
   ChatController {chatStore, filesFolder, smpAgent} <- ask
   let agentStore = agentClientStore smpAgent
   filesPath <- readTVarIO filesFolder
   pure StorageFiles {chatStore, agentStore, filesPath}
 
-sqlCipherExport :: forall m. ChatMonad m => DBEncryptionConfig -> m ()
+sqlCipherExport :: DBEncryptionConfig -> CM ()
 sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = DBEncryptionKey key', keepKey} =
   when (key /= key') $ do
-    fs <- storageFiles
+    fs <- lift 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 :: forall a m. ChatMonad m => FilePath -> (SQL.Database -> IO a) -> (SQLiteError -> DatabaseError) -> m ()
+withDB :: FilePath -> (SQL.Database -> IO a) -> (SQLiteError -> DatabaseError) -> CM ()
 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 -> m (Maybe SQLiteError)
+    sqliteError' :: Show e => e -> CM (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 :: forall m. ChatMonad m => DBEncryptionKey -> m ()
+sqlCipherTestKey :: DBEncryptionKey -> CM ()
 sqlCipherTestKey (DBEncryptionKey key) = do
-  fs <- storageFiles
+  fs <- lift 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, liftIOEither, tryAllErrors, (<$$>))
+import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, 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 :: ChatMonad m => DatabaseError -> m ()
+throwDBError :: DatabaseError -> CM ()
 throwDBError = throwError . ChatErrorDatabase
 
 -- TODO review errors, some of it can be covered by HTTP2 errors
@@ -1244,39 +1244,59 @@ data RemoteCtrlInfo = RemoteCtrlInfo
   }
   deriving (Show)
 
-type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
+type CM' a = ReaderT ChatController IO a
 
-type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
+type CM a = ExceptT ChatError (ReaderT ChatController IO) a
 
-chatReadVar :: ChatMonad' m => (ChatController -> TVar a) -> m a
-chatReadVar f = asks f >>= readTVarIO
+chatReadVar :: (ChatController -> TVar a) -> CM a
+chatReadVar = lift . chatReadVar'
 {-# INLINE chatReadVar #-}
 
-chatWriteVar :: ChatMonad' m => (ChatController -> TVar a) -> a -> m ()
-chatWriteVar f value = asks f >>= atomically . (`writeTVar` value)
+chatReadVar' :: (ChatController -> TVar a) -> CM' a
+chatReadVar' f = asks f >>= readTVarIO
+{-# INLINE chatReadVar' #-}
+
+chatWriteVar :: (ChatController -> TVar a) -> a -> CM ()
+chatWriteVar f = lift . chatWriteVar' f
 {-# INLINE chatWriteVar #-}
 
-chatModifyVar :: ChatMonad' m => (ChatController -> TVar a) -> (a -> a) -> m ()
-chatModifyVar f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
+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
 {-# INLINE chatModifyVar #-}
 
-setContactNetworkStatus :: ChatMonad' m => Contact -> NetworkStatus -> m ()
-setContactNetworkStatus Contact {activeConn = Nothing} _ = pure ()
-setContactNetworkStatus Contact {activeConn = Just Connection {agentConnId}} status = chatModifyVar connNetworkStatuses $ M.insert agentConnId status
+chatModifyVar' :: (ChatController -> TVar a) -> (a -> a) -> CM' ()
+chatModifyVar' f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
+{-# INLINE chatModifyVar' #-}
 
-tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
+setContactNetworkStatus :: Contact -> NetworkStatus -> CM' ()
+setContactNetworkStatus Contact {activeConn = Nothing} _ = pure ()
+setContactNetworkStatus Contact {activeConn = Just Connection {agentConnId}} status = chatModifyVar' connNetworkStatuses $ M.insert agentConnId status
+
+tryChatError :: CM a -> CM (Either ChatError a)
 tryChatError = tryAllErrors mkChatError
 {-# INLINE tryChatError #-}
 
-catchChatError :: ChatMonad m => m a -> (ChatError -> m a) -> m a
+tryChatError' :: CM a -> CM' (Either ChatError a)
+tryChatError' = tryAllErrors' mkChatError
+{-# INLINE tryChatError' #-}
+
+catchChatError :: CM a -> (ChatError -> CM a) -> CM a
 catchChatError = catchAllErrors mkChatError
 {-# INLINE catchChatError #-}
 
-chatFinally :: ChatMonad m => m a -> m b -> m a
+catchChatError' :: CM a -> (ChatError -> CM' a) -> CM' a
+catchChatError' = catchAllErrors' mkChatError
+{-# INLINE catchChatError' #-}
+
+chatFinally :: CM a -> CM b -> CM a
 chatFinally = allFinally mkChatError
 {-# INLINE chatFinally #-}
 
-onChatError :: ChatMonad m => m a -> m b -> m a
+onChatError :: CM a -> CM b -> CM a
 a `onChatError` onErr = a `catchChatError` \e -> onErr >> throwError e
 {-# INLINE onChatError #-}
 
@@ -1295,12 +1315,16 @@ mkStoreError = SEInternalError . show
 chatCmdError :: Maybe User -> String -> ChatResponse
 chatCmdError user = CRChatCmdError user . ChatError . CECommandError
 
-throwChatError :: ChatMonad m => ChatErrorType -> m a
+throwChatError :: ChatErrorType -> CM a
 throwChatError = throwError . ChatError
 
 -- | Emit local events.
-toView :: ChatMonad' m => ChatResponse -> m ()
-toView ev = do
+toView :: ChatResponse -> CM ()
+toView = lift . toView'
+{-# INLINE toView #-}
+
+toView' :: ChatResponse -> CM' ()
+toView' ev = do
   cc@ChatController {outputQ = localQ, remoteCtrlSession = session, config = ChatConfig {chatHooks}} <- ask
   event <- liftIO $ eventHook chatHooks cc ev
   atomically $
@@ -1310,15 +1334,15 @@ toView ev = do
       -- TODO potentially, it should hold some events while connecting
       _ -> writeTBQueue localQ (Nothing, Nothing, event)
 
-withStore' :: ChatMonad m => (DB.Connection -> IO a) -> m a
+withStore' :: (DB.Connection -> IO a) -> CM a
 withStore' action = withStore $ liftIO . action
 
-withStore :: ChatMonad m => (DB.Connection -> ExceptT StoreError IO a) -> m a
+withStore :: (DB.Connection -> ExceptT StoreError IO a) -> CM a
 withStore action = do
   ChatController {chatStore} <- ask
-  liftIOEither $ withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
+  liftEither =<< liftIO (withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors)
 
-withStoreBatch :: (ChatMonad' m, Traversable t) => (DB.Connection -> t (IO (Either ChatError a))) -> m (t (Either ChatError a))
+withStoreBatch :: Traversable t => (DB.Connection -> t (IO (Either ChatError a))) -> CM' (t (Either ChatError a))
 withStoreBatch actions = do
   ChatController {chatStore} <- ask
   liftIO $ withTransaction chatStore $ mapM (`E.catches` handleDBErrors) . actions
@@ -1332,17 +1356,17 @@ handleDBErrors =
     E.Handler $ \(E.SomeException e) -> pure . Left . ChatErrorStore . SEDBException $ show e
   ]
 
-withStoreBatch' :: (ChatMonad' m, Traversable t) => (DB.Connection -> t (IO a)) -> m (t (Either ChatError a))
+withStoreBatch' :: Traversable t => (DB.Connection -> t (IO a)) -> CM' (t (Either ChatError a))
 withStoreBatch' actions = withStoreBatch $ fmap (fmap Right) . actions
 
-withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a
+withAgent :: (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
 withAgent action =
   asks smpAgent
-    >>= runExceptT . action
+    >>= liftIO . runExceptT . action
     >>= liftEither . first (`ChatErrorAgent` Nothing)
 
-withAgent' :: ChatMonad' m => (AgentClient -> m a) -> m a
-withAgent' action = asks smpAgent >>= action
+withAgent' :: (AgentClient -> IO a) -> CM' a
+withAgent' action = asks smpAgent >>= liftIO . action
 
 $(JQ.deriveJSON (enumJSON $ dropPrefix "HS") ''HelpSection)
 

src/Simplex/Chat/Files.hs

@@ -3,13 +3,12 @@
 
 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 :: MonadIO m => FilePath -> String -> m FilePath
+uniqueCombine :: FilePath -> String -> IO FilePath
 uniqueCombine fPath fName = tryCombine (0 :: Int)
   where
     tryCombine n =
@@ -18,10 +17,10 @@ uniqueCombine fPath fName = tryCombine (0 :: Int)
           f = fPath `combine` (name <> suffix <> ext)
        in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
 
-getChatTempDirectory :: ChatMonad m => m FilePath
-getChatTempDirectory = chatReadVar tempDirectory >>= maybe getTemporaryDirectory pure
+getChatTempDirectory :: CM' FilePath
+getChatTempDirectory = chatReadVar' tempDirectory >>= maybe getTemporaryDirectory pure
 
-getDefaultFilesFolder :: ChatMonad m => m FilePath
+getDefaultFilesFolder :: CM' 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 (encryptFile)
+import Simplex.Chat.Util (liftIOEither, 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 :: ChatMonad m => RemoteHostId -> m RemoteHostClient
+getRemoteHostClient :: RemoteHostId -> CM RemoteHostClient
 getRemoteHostClient rhId = do
   sessions <- asks remoteHostSessions
   liftIOEither . atomically $
@@ -106,7 +106,7 @@ getRemoteHostClient rhId = do
   where
     rhKey = RHId rhId
 
-withRemoteHostSession :: ChatMonad m => RHKey -> SessionSeq -> (RemoteHostSession -> Either ChatError (a, RemoteHostSession)) -> m a
+withRemoteHostSession :: RHKey -> SessionSeq -> (RemoteHostSession -> Either ChatError (a, RemoteHostSession)) -> CM 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 :: ChatMonad m => SessionSeq -> RemoteHostId -> m ()
+setNewRemoteHostId :: SessionSeq -> RemoteHostId -> CM ()
 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 :: ChatMonad m => Maybe (RemoteHostId, Bool) -> Maybe RCCtrlAddress -> Maybe Word16 -> m (NonEmpty RCCtrlAddress, Maybe RemoteHostInfo, RCSignedInvitation)
+startRemoteHost :: Maybe (RemoteHostId, Bool) -> Maybe RCCtrlAddress -> Maybe Word16 -> CM (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 -> withAgent $ \a -> (RHNew,False,Nothing,) <$> rcNewHostPairing a
+    Nothing -> lift . 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 :: ChatMonad m => RHKey -> SessionSeq -> m a -> m a
+    handleConnectError :: RHKey -> SessionSeq -> CM a -> CM a
     handleConnectError rhKey sessSeq action =
       action `catchChatError` \err -> do
         logError $ "startRemoteHost.rcConnectHost crashed: " <> tshow err
         cancelRemoteHostSession (Just (sessSeq, RHSRConnectionFailed err)) rhKey
         throwError err
-    handleHostError :: ChatMonad m => SessionSeq -> TVar RHKey -> m () -> m ()
+    handleHostError :: SessionSeq -> TVar RHKey -> CM () -> CM ()
     handleHostError sessSeq rhKeyVar action =
       action `catchChatError` \err -> do
         logError $ "startRemoteHost.waitForHostSession crashed: " <> tshow err
         readTVarIO rhKeyVar >>= cancelRemoteHostSession (Just (sessSeq, RHSRCrashed err))
-    waitForHostSession :: ChatMonad m => Maybe RemoteHostInfo -> RHKey -> SessionSeq -> Maybe RCCtrlAddress -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> m ()
+    waitForHostSession :: Maybe RemoteHostInfo -> RHKey -> SessionSeq -> Maybe RCCtrlAddress -> TVar RHKey -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> CM ()
     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 <- liftEitherError (httpError remoteHostId) $ attachRevHTTP2Client disconnected tls
+      httpClient <- liftError' (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 :: ChatMonad m => RCHostPairing -> Maybe RemoteHostInfo -> Maybe RCCtrlAddress -> Text -> SessionSeq -> RemoteHostSessionState -> m RemoteHostInfo
+    upsertRemoteHost :: RCHostPairing -> Maybe RemoteHostInfo -> Maybe RCCtrlAddress -> Text -> SessionSeq -> RemoteHostSessionState -> CM 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 :: ChatMonad m => RHKey -> SessionSeq -> m ()
+    onDisconnected :: RHKey -> SessionSeq -> CM ()
     onDisconnected rhKey sseq = do
       logDebug $ "HTTP2 client disconnected: " <> tshow (rhKey, sseq)
       cancelRemoteHostSession (Just (sseq, RHSRDisconnected)) rhKey
-    pollEvents :: ChatMonad m => RemoteHostId -> RemoteHostClient -> m ()
+    pollEvents :: RemoteHostId -> RemoteHostClient -> CM ()
     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 :: ChatMonad m => RHKey -> m SessionSeq
+startRemoteHostSession :: RHKey -> CM 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 :: ChatMonad m => RHKey -> m ()
+closeRemoteHost :: RHKey -> CM ()
 closeRemoteHost rhKey = do
   logNote $ "Closing remote host session for " <> tshow rhKey
   cancelRemoteHostSession Nothing rhKey
 
-cancelRemoteHostSession :: ChatMonad m => Maybe (SessionSeq, RemoteHostStopReason) -> RHKey -> m ()
+cancelRemoteHostSession :: Maybe (SessionSeq, RemoteHostStopReason) -> RHKey -> CM ()
 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 :: ChatMonad m => m [RemoteHostInfo]
+listRemoteHosts :: CM [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 :: ChatMonad m => Maybe RemoteHostId -> m (Maybe RemoteHostInfo)
+switchRemoteHost :: Maybe RemoteHostId -> CM (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 :: ChatMonad m => RemoteHostId -> m ()
+deleteRemoteHost :: RemoteHostId -> CM ()
 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 :: forall m. ChatMonad m => RemoteHostId -> Maybe Bool -> FilePath -> m CryptoFile
+storeRemoteFile :: RemoteHostId -> Maybe Bool -> FilePath -> CM 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 :: m CryptoFile
+    encryptLocalFile :: CM CryptoFile
     encryptLocalFile = do
-      tmpDir <- getChatTempDirectory
+      tmpDir <- lift getChatTempDirectory
       createDirectoryIfMissing True tmpDir
-      tmpFile <- tmpDir `uniqueCombine` takeFileName localPath
+      tmpFile <- liftIO $ tmpDir `uniqueCombine` takeFileName localPath
       cfArgs <- atomically . CF.randomArgs =<< asks random
-      liftError (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs
+      liftEither =<< liftIO (runExceptT $ withExceptT (ChatError . CEFileWrite tmpFile) $ encryptFile localPath tmpFile cfArgs)
       pure $ CryptoFile tmpFile $ Just cfArgs
 
-getRemoteFile :: ChatMonad m => RemoteHostId -> RemoteFile -> m ()
+getRemoteFile :: RemoteHostId -> RemoteFile -> CM ()
 getRemoteFile rhId rf = do
   c@RemoteHostClient {storePath} <- getRemoteHostClient rhId
-  dir <- (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar remoteHostsFolder)
+  dir <- lift $ (</> storePath </> archiveFilesFolder) <$> (maybe getDefaultFilesFolder pure =<< chatReadVar' remoteHostsFolder)
   createDirectoryIfMissing True dir
   liftRH rhId $ remoteGetFile c dir rf
 
-processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostClient -> ChatCommand -> ByteString -> m ChatResponse
+processRemoteCommand :: RemoteHostId -> RemoteHostClient -> ChatCommand -> ByteString -> CM 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 :: ChatMonad m => RemoteHostId -> ExceptT RemoteProtocolError IO a -> m a
+liftRH :: RemoteHostId -> ExceptT RemoteProtocolError IO a -> CM 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 :: ChatMonad m => RCSignedInvitation -> m (Maybe RemoteCtrlInfo, CtrlAppInfo)
+connectRemoteCtrlURI :: RCSignedInvitation -> CM (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 :: ChatMonad m => m ()
+findKnownRemoteCtrl :: CM ()
 findKnownRemoteCtrl = do
   knownCtrls <- withStore' getRemoteCtrls
   pairings <- case nonEmpty knownCtrls of
@@ -420,7 +420,7 @@ findKnownRemoteCtrl = do
     _ -> Left $ ChatErrorRemoteCtrl RCEBadState
   atomically $ putTMVar cmdOk ()
 
-confirmRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m (RemoteCtrlInfo, CtrlAppInfo)
+confirmRemoteCtrl :: RemoteCtrlId -> CM (RemoteCtrlInfo, CtrlAppInfo)
 confirmRemoteCtrl rcId = do
   session <- asks remoteCtrlSession
   (sseq, listener, found) <- liftIOEither $ atomically $ do
@@ -438,7 +438,7 @@ confirmRemoteCtrl rcId = do
 
 -- ** Common
 
-startRemoteCtrlSession :: ChatMonad m => m SessionSeq
+startRemoteCtrlSession :: CM 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 :: ChatMonad m => RCVerifiedInvitation -> SessionSeq -> m (Maybe RemoteCtrlInfo, CtrlAppInfo)
+connectRemoteCtrl :: RCVerifiedInvitation -> SessionSeq -> CM (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 :: ChatMonad m => Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> m ()
+    waitForCtrlSession :: Maybe RemoteCtrl -> Text -> RCCtrlClient -> RCStepTMVar (ByteString, TLS, RCStepTMVar (RCCtrlSession, RCCtrlPairing)) -> CM ()
     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 :: ChatMonad m => JT.Value -> m CtrlAppInfo
+parseCtrlAppInfo :: JT.Value -> CM CtrlAppInfo
 parseCtrlAppInfo ctrlAppInfo = do
   liftEitherWith (const $ ChatErrorRemoteCtrl RCEBadInvitation) $ JT.parseEither J.parseJSON ctrlAppInfo
 
-handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> m ()
+handleRemoteCommand :: (ByteString -> CM' ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> CM ()
 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 -> m ()
+    processCommand :: User -> GetChunk -> RemoteCommand -> CM ()
     processCommand user getNext = \case
-      RCSend {command} -> handleSend execChatCommand command >>= reply
-      RCRecv {wait = time} -> handleRecv time remoteOutputQ >>= reply
-      RCStoreFile {fileName, fileSize, fileDigest} -> handleStoreFile encryption fileName fileSize fileDigest getNext >>= reply
+      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
       RCGetFile {file} -> handleGetFile encryption user file replyWith
-    reply :: RemoteResponse -> m ()
+    reply :: RemoteResponse -> CM ()
     reply = (`replyWith` \_ -> pure ())
-    replyWith :: Respond m
+    replyWith :: Respond
     replyWith rr attach = do
       resp <- liftRC $ encryptEncodeHTTP2Body encryption $ J.encode rr
       liftIO . sendResponse . responseStreaming N.status200 [] $ \send flush -> do
@@ -524,51 +524,55 @@ handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {reque
         attach send
         flush
 
-takeRCStep :: ChatMonad m => RCStepTMVar a -> m a
-takeRCStep = liftEitherError (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar
+takeRCStep :: RCStepTMVar a -> CM a
+takeRCStep = liftError' (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar
 
 type GetChunk = Int -> IO ByteString
 
 type SendChunk = Builder -> IO ()
 
-type Respond m = RemoteResponse -> (SendChunk -> IO ()) -> m ()
+type Respond = RemoteResponse -> (SendChunk -> IO ()) -> CM ()
 
-liftRC :: ChatMonad m => ExceptT RemoteProtocolError IO a -> m a
+liftRC :: ExceptT RemoteProtocolError IO a -> CM a
 liftRC = liftError (ChatErrorRemoteCtrl . RCEProtocolError)
 
 tryRemoteError :: ExceptT RemoteProtocolError IO a -> ExceptT RemoteProtocolError IO (Either RemoteProtocolError a)
 tryRemoteError = tryAllErrors (RPEException . tshow)
 {-# INLINE tryRemoteError #-}
 
-handleSend :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteResponse
+tryRemoteError' :: ExceptT RemoteProtocolError IO a -> IO (Either RemoteProtocolError a)
+tryRemoteError' = tryAllErrors' (RPEException . tshow)
+{-# INLINE tryRemoteError' #-}
+
+handleSend :: (ByteString -> CM' ChatResponse) -> Text -> CM' RemoteResponse
 handleSend execChatCommand command = do
   logDebug $ "Send: " <> tshow command
   -- execChatCommand checks for remote-allowed commands
-  -- convert errors thrown in ChatMonad into error responses to prevent aborting the protocol wrapper
-  RRChatResponse <$> execChatCommand (encodeUtf8 command) `catchError` (pure . CRChatError Nothing)
+  -- convert errors thrown in execChatCommand into error responses to prevent aborting the protocol wrapper
+  RRChatResponse <$> lift (execChatCommand $ encodeUtf8 command) `catchChatError'` (pure . CRChatError Nothing)
 
-handleRecv :: MonadUnliftIO m => Int -> TBQueue ChatResponse -> m RemoteResponse
+handleRecv :: Int -> TBQueue ChatResponse -> IO 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 :: forall m. ChatMonad m => RemoteCrypto -> FilePath -> Word32 -> FileDigest -> GetChunk -> m RemoteResponse
+handleStoreFile :: RemoteCrypto -> FilePath -> Word32 -> FileDigest -> GetChunk -> CM' RemoteResponse
 handleStoreFile encryption fileName fileSize fileDigest getChunk =
-  either RRProtocolError RRFileStored <$> (chatReadVar filesFolder >>= storeFile)
+  either RRProtocolError RRFileStored <$> (chatReadVar' filesFolder >>= storeFile)
   where
-    storeFile :: Maybe FilePath -> m (Either RemoteProtocolError FilePath)
+    storeFile :: Maybe FilePath -> CM' (Either RemoteProtocolError FilePath)
     storeFile = \case
       Just ff -> takeFileName <$$> storeFileTo ff
       Nothing -> storeFileTo =<< getDefaultFilesFolder
-    storeFileTo :: FilePath -> m (Either RemoteProtocolError FilePath)
-    storeFileTo dir = liftRC . tryRemoteError $ do
-      filePath <- dir `uniqueCombine` fileName
+    storeFileTo :: FilePath -> CM' (Either RemoteProtocolError FilePath)
+    storeFileTo dir = liftIO . tryRemoteError' $ do
+      filePath <- liftIO $ dir `uniqueCombine` fileName
       receiveEncryptedFile encryption getChunk fileSize fileDigest filePath
       pure filePath
 
-handleGetFile :: ChatMonad m => RemoteCrypto -> User -> RemoteFile -> Respond m -> m ()
+handleGetFile :: RemoteCrypto -> User -> RemoteFile -> Respond -> CM ()
 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}
@@ -583,7 +587,7 @@ handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileI
         encFile <- liftRC $ prepareEncryptedFile encryption (h, fileSize)
         reply RRFile {fileSize, fileDigest} $ sendEncryptedFile encFile
 
-listRemoteCtrls :: ChatMonad m => m [RemoteCtrlInfo]
+listRemoteCtrls :: CM [RemoteCtrlInfo]
 listRemoteCtrls = do
   session <- snd <$$> chatReadVar remoteCtrlSession
   let rcId = sessionRcId =<< session
@@ -604,7 +608,7 @@ remoteCtrlInfo RemoteCtrl {remoteCtrlId, ctrlDeviceName} sessionState =
   RemoteCtrlInfo {remoteCtrlId, ctrlDeviceName, sessionState}
 
 -- | Take a look at emoji of tlsunique, commit pairing, and start session server
-verifyRemoteCtrlSession :: ChatMonad m => (ByteString -> m ChatResponse) -> Text -> m RemoteCtrlInfo
+verifyRemoteCtrlSession :: (ByteString -> CM' ChatResponse) -> Text -> CM RemoteCtrlInfo
 verifyRemoteCtrlSession execChatCommand sessCode' = do
   (sseq, client, ctrlName, sessionCode, vars) <-
     chatReadVar remoteCtrlSession >>= \case
@@ -626,7 +630,7 @@ verifyRemoteCtrlSession execChatCommand sessCode' = do
       _ -> Left $ ChatErrorRemoteCtrl RCEBadState
     pure $ remoteCtrlInfo rc $ Just RCSConnected {sessionCode = tlsSessionCode tls}
   where
-    upsertRemoteCtrl :: ChatMonad m => Text -> RCCtrlPairing -> m RemoteCtrl
+    upsertRemoteCtrl :: Text -> RCCtrlPairing -> CM RemoteCtrl
     upsertRemoteCtrl ctrlName rcCtrlPairing = withStore $ \db -> do
       rc_ <- liftIO $ getRemoteCtrlByFingerprint db (ctrlFingerprint rcCtrlPairing)
       case rc_ of
@@ -635,16 +639,16 @@ verifyRemoteCtrlSession execChatCommand sessCode' = do
           let dhPrivKey' = dhPrivKey rcCtrlPairing
           liftIO $ updateRemoteCtrl db rc ctrlName dhPrivKey'
           pure rc {ctrlDeviceName = ctrlName, ctrlPairing = ctrlPairing {dhPrivKey = dhPrivKey'}}
-    monitor :: ChatMonad m => SessionSeq -> Async () -> m ()
+    monitor :: SessionSeq -> Async () -> CM ()
     monitor sseq server = do
       res <- waitCatch server
       logInfo $ "HTTP2 server stopped: " <> tshow res
       cancelActiveRemoteCtrl $ Just (sseq, RCSRDisconnected)
 
-stopRemoteCtrl :: ChatMonad m => m ()
+stopRemoteCtrl :: CM ()
 stopRemoteCtrl = cancelActiveRemoteCtrl Nothing
 
-handleCtrlError :: ChatMonad m => SessionSeq -> (ChatError -> RemoteCtrlStopReason) -> Text -> m a -> m a
+handleCtrlError :: SessionSeq -> (ChatError -> RemoteCtrlStopReason) -> Text -> CM a -> CM a
 handleCtrlError sseq mkReason name action =
   action `catchChatError` \e -> do
     logError $ name <> " remote ctrl error: " <> tshow e
@@ -652,7 +656,7 @@ handleCtrlError sseq mkReason name action =
     throwError e
 
 -- | Stop session controller, unless session update key is present but stale
-cancelActiveRemoteCtrl :: ChatMonad m => Maybe (SessionSeq, RemoteCtrlStopReason) -> m ()
+cancelActiveRemoteCtrl :: Maybe (SessionSeq, RemoteCtrlStopReason) -> CM ()
 cancelActiveRemoteCtrl handlerInfo_ = handleAny (logError . tshow) $ do
   var <- asks remoteCtrlSession
   session_ <-
@@ -685,18 +689,18 @@ cancelRemoteCtrl handlingError = \case
     cancelCtrlClient rcsClient
     closeConnection tls
 
-deleteRemoteCtrl :: ChatMonad m => RemoteCtrlId -> m ()
+deleteRemoteCtrl :: RemoteCtrlId -> CM ()
 deleteRemoteCtrl rcId = do
   checkNoRemoteCtrlSession
   -- TODO check it exists
   withStore' (`deleteRemoteCtrlRecord` rcId)
 
-checkNoRemoteCtrlSession :: ChatMonad m => m ()
+checkNoRemoteCtrlSession :: CM ()
 checkNoRemoteCtrlSession =
   chatReadVar remoteCtrlSession >>= maybe (pure ()) (\_ -> throwError $ ChatErrorRemoteCtrl RCEBusy)
 
 -- | Transition controller to a new state, unless session update key is stale
-updateRemoteCtrlSession :: ChatMonad m => SessionSeq -> (RemoteCtrlSession -> Either ChatError RemoteCtrlSession) -> m ()
+updateRemoteCtrlSession :: SessionSeq -> (RemoteCtrlSession -> Either ChatError RemoteCtrlSession) -> CM ()
 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 (liftEitherError, liftEitherWith, liftError, tshow)
+import Simplex.Messaging.Util (liftError', 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 :: ChatMonad m => HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> m RemoteHostClient
+mkRemoteHostClient :: HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> CM 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 :: ChatMonad m => CtrlSessKeys -> SessionCode -> m RemoteCrypto
+mkCtrlRemoteCrypto :: CtrlSessKeys -> SessionCode -> CM 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 :: MonadIO m => RemoteHostClient -> m ()
-closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client httpClient
+closeRemoteHostClient :: RemoteHostClient -> IO ()
+closeRemoteHostClient RemoteHostClient {httpClient} = 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} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
+  HTTP2Response {response, respBody} <- liftError' (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
-          liftEitherError RPEInvalidBody $ C.decodeSignature <$> getNext (fromIntegral len)
+          liftError' 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 (liftEitherError, liftEitherWith)
+import Simplex.Messaging.Util (liftError', 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 <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 24
-  size <- liftEitherError RPEInvalidBody $ smpDecode <$> getChunk 4
+  nonce <- liftError' RPEInvalidBody $ smpDecode <$> getChunk 24
+  size <- liftError' RPEInvalidBody $ smpDecode <$> getChunk 4
   unless (size == fileSize + fromIntegral C.authTagSize) $ throwError RPEFileSize
   sbState <- liftEitherWith (const $ PRERemoteControl RCEDecrypt) $ LC.kcbInit hybridKey nonce
-  liftEitherError fErr $ withFile toPath WriteMode $ \h -> receiveSbFile getChunk h sbState fileSize
+  liftError' 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/Util.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE TupleSections #-}
 
-module Simplex.Chat.Util (week, encryptFile, chunkSize, shuffle) where
+module Simplex.Chat.Util (week, encryptFile, chunkSize, liftIOEither, shuffle) where
 
 import Control.Monad
 import Control.Monad.Except
@@ -42,3 +42,7 @@ 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 = undefined,
+    { dbFilePrefix = "./simplex_v1",
       dbKey = "",
       -- dbKey = "this is a pass-phrase to encrypt the database",
       smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],