Merge branch 'ep/operators-preset-servers' into ep/operators-preset-servers-android

* Revert "raise lower bound on mtl to a real version (#3499)"

This reverts commit f94c0311c1.

* Revert "core: expand ranges to fit ghc 8.10 & 9.6 (#3496)"

This reverts commit 9a1c7f41f7.

* update simplexmq

* remove netword-transport fork

* compatibility with GHC 8.10.7

* simplexmq

* fix test

* simplexmq, deps

* update sqlcipher deps in sha256nix

* fix index-state in cabal.project

* index-state

* remove import

* add cabal.project.freeze

* simplexmq

* remove freeze

* simplexmq

* bytestring,simplexmq

* template-haskell, simplexmq

* simplexmq

* simplexmq

* simplexmq

* mtl

* simplexmq

* remove duplicate index-state

apps/ios/SimpleX.xcodeproj/project.pbxproj

@@ -160,6 +160,11 @@
 		64466DC829FC2B3B00E3D48D /* CreateSimpleXAddress.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */; };
 		64466DCC29FFE3E800E3D48D /* MailView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 64466DCB29FFE3E800E3D48D /* MailView.swift */; };
 		6448BBB628FA9D56000D2AB9 /* GroupLinkView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 6448BBB528FA9D56000D2AB9 /* GroupLinkView.swift */; };
+		6449333A2AF8E51000AC506E /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933352AF8E51000AC506E /* libgmpxx.a */; };
+		6449333B2AF8E51000AC506E /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933362AF8E51000AC506E /* libgmp.a */; };
+		6449333C2AF8E51000AC506E /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933372AF8E51000AC506E /* libffi.a */; };
+		6449333D2AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933382AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a */; };
+		6449333E2AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 644933392AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */; };
 		644EFFDE292BCD9D00525D5B /* ComposeVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFDD292BCD9D00525D5B /* ComposeVoiceView.swift */; };
 		644EFFE0292CFD7F00525D5B /* CIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */; };
 		644EFFE2292D089800525D5B /* FramedCIVoiceView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */; };
@@ -503,6 +508,11 @@
 		64466DC729FC2B3B00E3D48D /* CreateSimpleXAddress.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CreateSimpleXAddress.swift; sourceTree = "<group>"; };
 		64466DCB29FFE3E800E3D48D /* MailView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MailView.swift; sourceTree = "<group>"; };
 		6448BBB528FA9D56000D2AB9 /* GroupLinkView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = GroupLinkView.swift; sourceTree = "<group>"; };
+		644933352AF8E51000AC506E /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
+		644933362AF8E51000AC506E /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
+		644933372AF8E51000AC506E /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
+		644933382AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8-ghc9.6.3.a"; sourceTree = "<group>"; };
+		644933392AF8E51000AC506E /* libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.3-EnhmkSQK6HvJ11g1uZERg8.a"; sourceTree = "<group>"; };
 		644EFFDD292BCD9D00525D5B /* ComposeVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeVoiceView.swift; sourceTree = "<group>"; };
 		644EFFDF292CFD7F00525D5B /* CIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIVoiceView.swift; sourceTree = "<group>"; };
 		644EFFE1292D089800525D5B /* FramedCIVoiceView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = FramedCIVoiceView.swift; sourceTree = "<group>"; };

apps/multiplatform/common/src/commonMain/cpp/desktop/CMakeLists.txt

@@ -71,7 +71,7 @@ if(NOT APPLE)
 else()
 	# Without direct linking it can't find hs_init in linking step
 	add_library( rts SHARED IMPORTED )
-	FILE(GLOB RTSLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/libHSrts*_thr-*.${OS_LIB_EXT})
+	FILE(GLOB RTSLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/deps/libHSrts*_thr-*.${OS_LIB_EXT})
 	set_target_properties( rts PROPERTIES IMPORTED_LOCATION ${RTSLIB})
 
 	target_link_libraries(app-lib rts simplex)

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: ff05a465ee15ac7ae2c14a9fb703a18564950631
+    tag: 93f30c8edf9243ad2291dd6427d87328e282560a
 
 source-repository-package
     type: git

flake.lock

@@ -16,6 +16,21 @@
         "type": "github"
       }
     },
+    "blank": {
+      "locked": {
+        "lastModified": 1625557891,
+        "narHash": "sha256-O8/MWsPBGhhyPoPLHZAuoZiiHo9q6FLlEeIDEXuj6T4=",
+        "owner": "divnix",
+        "repo": "blank",
+        "rev": "5a5d2684073d9f563072ed07c871d577a6c614a8",
+        "type": "github"
+      },
+      "original": {
+        "owner": "divnix",
+        "repo": "blank",
+        "type": "github"
+      }
+    },
     "cabal-32": {
       "flake": false,
       "locked": {
@@ -83,6 +98,64 @@
         "type": "github"
       }
     },
+    "devshell": {
+      "inputs": {
+        "flake-utils": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "flake-utils"
+        ],
+        "nixpkgs": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1663445644,
+        "narHash": "sha256-+xVlcK60x7VY1vRJbNUEAHi17ZuoQxAIH4S4iUFUGBA=",
+        "owner": "numtide",
+        "repo": "devshell",
+        "rev": "e3dc3e21594fe07bdb24bdf1c8657acaa4cb8f66",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "devshell",
+        "type": "github"
+      }
+    },
+    "dmerge": {
+      "inputs": {
+        "nixlib": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "nixpkgs"
+        ],
+        "yants": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "yants"
+        ]
+      },
+      "locked": {
+        "lastModified": 1659548052,
+        "narHash": "sha256-fzI2gp1skGA8mQo/FBFrUAtY0GQkAIAaV/V127TJPyY=",
+        "owner": "divnix",
+        "repo": "data-merge",
+        "rev": "d160d18ce7b1a45b88344aa3f13ed1163954b497",
+        "type": "github"
+      },
+      "original": {
+        "owner": "divnix",
+        "repo": "data-merge",
+        "type": "github"
+      }
+    },
     "flake-compat": {
       "flake": false,
       "locked": {
@@ -100,34 +173,74 @@
         "type": "github"
       }
     },
-    "flake-parts": {
-      "inputs": {
-        "nixpkgs-lib": "nixpkgs-lib"
-      },
+    "flake-compat_2": {
+      "flake": false,
       "locked": {
-        "lastModified": 1698579227,
-        "narHash": "sha256-KVWjFZky+gRuWennKsbo6cWyo7c/z/VgCte5pR9pEKg=",
-        "owner": "hercules-ci",
-        "repo": "flake-parts",
-        "rev": "f76e870d64779109e41370848074ac4eaa1606ec",
+        "lastModified": 1650374568,
+        "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=",
+        "owner": "edolstra",
+        "repo": "flake-compat",
+        "rev": "b4a34015c698c7793d592d66adbab377907a2be8",
         "type": "github"
       },
       "original": {
-        "owner": "hercules-ci",
-        "repo": "flake-parts",
+        "owner": "edolstra",
+        "repo": "flake-compat",
         "type": "github"
       }
     },
     "flake-utils": {
-      "inputs": {
-        "systems": "systems"
-      },
       "locked": {
-        "lastModified": 1701680307,
-        "narHash": "sha256-kAuep2h5ajznlPMD9rnQyffWG8EM/C73lejGofXvdM8=",
+        "lastModified": 1676283394,
+        "narHash": "sha256-XX2f9c3iySLCw54rJ/CZs+ZK6IQy7GXNY4nSOyu2QG4=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "4022d587cbbfd70fe950c1e2083a02621806a725",
+        "rev": "3db36a8b464d0c4532ba1c7dda728f4576d6d073",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_2": {
+      "locked": {
+        "lastModified": 1667395993,
+        "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_3": {
+      "locked": {
+        "lastModified": 1653893745,
+        "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_4": {
+      "locked": {
+        "lastModified": 1659877975,
+        "narHash": "sha256-zllb8aq3YO3h8B/U0/J1WBgAL8EX5yWf5pMj3G0NAmc=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "c0e246b9b83f637f4681389ecabcb2681b4f3af0",
         "type": "github"
       },
       "original": {
@@ -153,51 +266,33 @@
         "type": "github"
       }
     },
-    "ghc98X": {
-      "flake": false,
+    "gomod2nix": {
+      "inputs": {
+        "nixpkgs": "nixpkgs_2",
+        "utils": "utils"
+      },
       "locked": {
-        "lastModified": 1715066704,
-        "narHash": "sha256-F0EVR8x/fcpj1st+hz96Wdsz5uwVIOziGKAwRxLOYJw=",
-        "ref": "ghc-9.8",
-        "rev": "78a253543d466ac511a1664a3e6aff032ca684d5",
-        "revCount": 61757,
-        "submodules": true,
-        "type": "git",
-        "url": "https://gitlab.haskell.org/ghc/ghc"
+        "lastModified": 1655245309,
+        "narHash": "sha256-d/YPoQ/vFn1+GTmSdvbSBSTOai61FONxB4+Lt6w/IVI=",
+        "owner": "tweag",
+        "repo": "gomod2nix",
+        "rev": "40d32f82fc60d66402eb0972e6e368aeab3faf58",
+        "type": "github"
       },
       "original": {
-        "ref": "ghc-9.8",
-        "submodules": true,
-        "type": "git",
-        "url": "https://gitlab.haskell.org/ghc/ghc"
-      }
-    },
-    "ghc99": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1726585445,
-        "narHash": "sha256-IdwQBex4boY6s0Plj5+ixf36rfYSUyMdTWrztKvZH30=",
-        "ref": "refs/heads/master",
-        "rev": "7fd9e5e29ab54eb406880077463e8552e2ddd39a",
-        "revCount": 67238,
-        "submodules": true,
-        "type": "git",
-        "url": "https://gitlab.haskell.org/ghc/ghc"
-      },
-      "original": {
-        "submodules": true,
-        "type": "git",
-        "url": "https://gitlab.haskell.org/ghc/ghc"
+        "owner": "tweag",
+        "repo": "gomod2nix",
+        "type": "github"
       }
     },
     "hackage": {
       "flake": false,
       "locked": {
-        "lastModified": 1702513363,
-        "narHash": "sha256-kloro9uEe8aYhPMoMjVNq2rfrXNgMOZhOPwVH5DH2K0=",
+        "lastModified": 1702340598,
+        "narHash": "sha256-CC0HI+6iKPtH+8r/ZfcpW5v/OYvL7zMwpr0xfkXV1zU=",
         "owner": "input-output-hk",
         "repo": "hackage.nix",
-        "rev": "a9d931d0398da67846fa257922a924829233cb91",
+        "rev": "24617c569995e38bf3b83b48eec6628a50fdb4fb",
         "type": "github"
       },
       "original": {
@@ -214,43 +309,33 @@
         "cabal-36": "cabal-36",
         "cardano-shell": "cardano-shell",
         "flake-compat": "flake-compat",
+        "flake-utils": "flake-utils_2",
         "ghc-8.6.5-iohk": "ghc-8.6.5-iohk",
-        "ghc98X": "ghc98X",
-        "ghc99": "ghc99",
         "hackage": [
           "hackage"
         ],
-        "hls-1.10": "hls-1.10",
-        "hls-2.0": "hls-2.0",
-        "hls-2.2": "hls-2.2",
-        "hls-2.3": "hls-2.3",
-        "hls-2.4": "hls-2.4",
-        "hls-2.5": "hls-2.5",
-        "hls-2.6": "hls-2.6",
         "hpc-coveralls": "hpc-coveralls",
         "hydra": "hydra",
         "iserv-proxy": "iserv-proxy",
         "nixpkgs": [
-          "haskellNix",
-          "nixpkgs-unstable"
+          "nixpkgs"
         ],
         "nixpkgs-2003": "nixpkgs-2003",
         "nixpkgs-2105": "nixpkgs-2105",
         "nixpkgs-2111": "nixpkgs-2111",
         "nixpkgs-2205": "nixpkgs-2205",
         "nixpkgs-2211": "nixpkgs-2211",
-        "nixpkgs-2305": "nixpkgs-2305",
-        "nixpkgs-2311": "nixpkgs-2311",
         "nixpkgs-unstable": "nixpkgs-unstable",
         "old-ghc-nix": "old-ghc-nix",
-        "stackage": "stackage"
+        "stackage": "stackage",
+        "tullia": "tullia"
       },
       "locked": {
-        "lastModified": 1705833500,
-        "narHash": "sha256-rUIr6JNbCedt1g4gVYVvE9t0oFU6FUspCA0DS5cA8Bg=",
+        "lastModified": 1677975916,
+        "narHash": "sha256-dbe8lEEPyfzjdRwpePClv7J9p9lQg7BwbBqAMCw4RLw=",
         "owner": "input-output-hk",
         "repo": "haskell.nix",
-        "rev": "d0c35e75cbbc6858770af42ac32b0b85495fbd71",
+        "rev": "ab5efd87ce3fd8ade38a01d97693d29a4f1ae7e4",
         "type": "github"
       },
       "original": {
@@ -260,125 +345,6 @@
         "type": "github"
       }
     },
-    "hls-1.10": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1680000865,
-        "narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=",
-        "owner": "haskell",
-        "repo": "haskell-language-server",
-        "rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9",
-        "type": "github"
-      },
-      "original": {
-        "owner": "haskell",
-        "ref": "1.10.0.0",
-        "repo": "haskell-language-server",
-        "type": "github"
-      }
-    },
-    "hls-2.0": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1687698105,
-        "narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=",
-        "owner": "haskell",
-        "repo": "haskell-language-server",
-        "rev": "783905f211ac63edf982dd1889c671653327e441",
-        "type": "github"
-      },
-      "original": {
-        "owner": "haskell",
-        "ref": "2.0.0.1",
-        "repo": "haskell-language-server",
-        "type": "github"
-      }
-    },
-    "hls-2.2": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1693064058,
-        "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=",
-        "owner": "haskell",
-        "repo": "haskell-language-server",
-        "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85",
-        "type": "github"
-      },
-      "original": {
-        "owner": "haskell",
-        "ref": "2.2.0.0",
-        "repo": "haskell-language-server",
-        "type": "github"
-      }
-    },
-    "hls-2.3": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1695910642,
-        "narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=",
-        "owner": "haskell",
-        "repo": "haskell-language-server",
-        "rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be",
-        "type": "github"
-      },
-      "original": {
-        "owner": "haskell",
-        "ref": "2.3.0.0",
-        "repo": "haskell-language-server",
-        "type": "github"
-      }
-    },
-    "hls-2.4": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1699862708,
-        "narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=",
-        "owner": "haskell",
-        "repo": "haskell-language-server",
-        "rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57",
-        "type": "github"
-      },
-      "original": {
-        "owner": "haskell",
-        "ref": "2.4.0.1",
-        "repo": "haskell-language-server",
-        "type": "github"
-      }
-    },
-    "hls-2.5": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1701080174,
-        "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=",
-        "owner": "haskell",
-        "repo": "haskell-language-server",
-        "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c",
-        "type": "github"
-      },
-      "original": {
-        "owner": "haskell",
-        "ref": "2.5.0.0",
-        "repo": "haskell-language-server",
-        "type": "github"
-      }
-    },
-    "hls-2.6": {
-      "flake": false,
-      "locked": {
-        "lastModified": 1705325287,
-        "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=",
-        "owner": "haskell",
-        "repo": "haskell-language-server",
-        "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e",
-        "type": "github"
-      },
-      "original": {
-        "owner": "haskell",
-        "ref": "2.6.0.0",
-        "repo": "haskell-language-server",
-        "type": "github"
-      }
-    },
     "hpc-coveralls": {
       "flake": false,
       "locked": {
@@ -418,14 +384,37 @@
         "type": "indirect"
       }
     },
+    "incl": {
+      "inputs": {
+        "nixlib": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1669263024,
+        "narHash": "sha256-E/+23NKtxAqYG/0ydYgxlgarKnxmDbg6rCMWnOBqn9Q=",
+        "owner": "divnix",
+        "repo": "incl",
+        "rev": "ce7bebaee048e4cd7ebdb4cee7885e00c4e2abca",
+        "type": "github"
+      },
+      "original": {
+        "owner": "divnix",
+        "repo": "incl",
+        "type": "github"
+      }
+    },
     "iserv-proxy": {
       "flake": false,
       "locked": {
-        "lastModified": 1707968597,
-        "narHash": "sha256-C53NqToxl+n9s1pQ0iLtiH6P5vX3rM+NW/mFt4Ykpsk=",
+        "lastModified": 1670983692,
+        "narHash": "sha256-avLo34JnI9HNyOuauK5R69usJm+GfW3MlyGlYxZhTgY=",
         "ref": "hkm/remote-iserv",
-        "rev": "1b7f8aeb37bbc7c00f04e44d9379aa15a4409e8b",
-        "revCount": 18,
+        "rev": "50d0abb3317ac439a4e7495b185a64af9b7b9300",
+        "revCount": 10,
         "type": "git",
         "url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git"
       },
@@ -451,22 +440,32 @@
         "type": "github"
       }
     },
-    "mac2ios": {
+    "n2c": {
       "inputs": {
-        "flake-parts": "flake-parts",
-        "nixpkgs": "nixpkgs_2"
+        "flake-utils": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "flake-utils"
+        ],
+        "nixpkgs": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "nixpkgs"
+        ]
       },
       "locked": {
-        "lastModified": 1699767871,
-        "narHash": "sha256-kxeCUfwC/Vgh2FvVMlBUq0eVx1JvfHyN+5MPKUik9mE=",
-        "owner": "zw3rk",
-        "repo": "mobile-core-tools",
-        "rev": "4dcb77d5ea896d749381806dfab5358851b08951",
+        "lastModified": 1665039323,
+        "narHash": "sha256-SAh3ZjFGsaCI8FRzXQyp56qcGdAqgKEfJWPCQ0Sr7tQ=",
+        "owner": "nlewo",
+        "repo": "nix2container",
+        "rev": "b008fe329ffb59b67bf9e7b08ede6ee792f2741a",
         "type": "github"
       },
       "original": {
-        "owner": "zw3rk",
-        "repo": "mobile-core-tools",
+        "owner": "nlewo",
+        "repo": "nix2container",
         "type": "github"
       }
     },
@@ -491,6 +490,95 @@
         "type": "github"
       }
     },
+    "nix-nomad": {
+      "inputs": {
+        "flake-compat": "flake-compat_2",
+        "flake-utils": [
+          "haskellNix",
+          "tullia",
+          "nix2container",
+          "flake-utils"
+        ],
+        "gomod2nix": "gomod2nix",
+        "nixpkgs": [
+          "haskellNix",
+          "tullia",
+          "nixpkgs"
+        ],
+        "nixpkgs-lib": [
+          "haskellNix",
+          "tullia",
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1658277770,
+        "narHash": "sha256-T/PgG3wUn8Z2rnzfxf2VqlR1CBjInPE0l1yVzXxPnt0=",
+        "owner": "tristanpemble",
+        "repo": "nix-nomad",
+        "rev": "054adcbdd0a836ae1c20951b67ed549131fd2d70",
+        "type": "github"
+      },
+      "original": {
+        "owner": "tristanpemble",
+        "repo": "nix-nomad",
+        "type": "github"
+      }
+    },
+    "nix2container": {
+      "inputs": {
+        "flake-utils": "flake-utils_3",
+        "nixpkgs": "nixpkgs_3"
+      },
+      "locked": {
+        "lastModified": 1658567952,
+        "narHash": "sha256-XZ4ETYAMU7XcpEeAFP3NOl9yDXNuZAen/aIJ84G+VgA=",
+        "owner": "nlewo",
+        "repo": "nix2container",
+        "rev": "60bb43d405991c1378baf15a40b5811a53e32ffa",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nlewo",
+        "repo": "nix2container",
+        "type": "github"
+      }
+    },
+    "nixago": {
+      "inputs": {
+        "flake-utils": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "flake-utils"
+        ],
+        "nixago-exts": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "blank"
+        ],
+        "nixpkgs": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1661824785,
+        "narHash": "sha256-/PnwdWoO/JugJZHtDUioQp3uRiWeXHUdgvoyNbXesz8=",
+        "owner": "nix-community",
+        "repo": "nixago",
+        "rev": "8c1f9e5f1578d4b2ea989f618588d62a335083c3",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-community",
+        "repo": "nixago",
+        "type": "github"
+      }
+    },
     "nixpkgs": {
       "locked": {
         "lastModified": 1657693803,
@@ -557,11 +645,11 @@
     },
     "nixpkgs-2205": {
       "locked": {
-        "lastModified": 1685573264,
-        "narHash": "sha256-Zffu01pONhs/pqH07cjlF10NnMDLok8ix5Uk4rhOnZQ=",
+        "lastModified": 1672580127,
+        "narHash": "sha256-3lW3xZslREhJogoOkjeZtlBtvFMyxHku7I/9IVehhT8=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "380be19fbd2d9079f677978361792cb25e8a3635",
+        "rev": "0874168639713f547c05947c76124f78441ea46c",
         "type": "github"
       },
       "original": {
@@ -573,11 +661,11 @@
     },
     "nixpkgs-2211": {
       "locked": {
-        "lastModified": 1688392541,
-        "narHash": "sha256-lHrKvEkCPTUO+7tPfjIcb7Trk6k31rz18vkyqmkeJfY=",
+        "lastModified": 1675730325,
+        "narHash": "sha256-uNvD7fzO5hNlltNQUAFBPlcEjNG5Gkbhl/ROiX+GZU4=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "ea4c80b39be4c09702b0cb3b42eab59e2ba4f24b",
+        "rev": "b7ce17b1ebf600a72178f6302c77b6382d09323f",
         "type": "github"
       },
       "original": {
@@ -587,56 +675,6 @@
         "type": "github"
       }
     },
-    "nixpkgs-2305": {
-      "locked": {
-        "lastModified": 1705033721,
-        "narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea",
-        "type": "github"
-      },
-      "original": {
-        "owner": "NixOS",
-        "ref": "nixpkgs-23.05-darwin",
-        "repo": "nixpkgs",
-        "type": "github"
-      }
-    },
-    "nixpkgs-2311": {
-      "locked": {
-        "lastModified": 1719957072,
-        "narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "7144d6241f02d171d25fba3edeaf15e0f2592105",
-        "type": "github"
-      },
-      "original": {
-        "owner": "NixOS",
-        "ref": "nixpkgs-23.11-darwin",
-        "repo": "nixpkgs",
-        "type": "github"
-      }
-    },
-    "nixpkgs-lib": {
-      "locked": {
-        "dir": "lib",
-        "lastModified": 1696019113,
-        "narHash": "sha256-X3+DKYWJm93DRSdC5M6K5hLqzSya9BjibtBsuARoPco=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "f5892ddac112a1e9b3612c39af1b72987ee5783a",
-        "type": "github"
-      },
-      "original": {
-        "dir": "lib",
-        "owner": "NixOS",
-        "ref": "nixos-unstable",
-        "repo": "nixpkgs",
-        "type": "github"
-      }
-    },
     "nixpkgs-regression": {
       "locked": {
         "lastModified": 1643052045,
@@ -655,36 +693,98 @@
     },
     "nixpkgs-unstable": {
       "locked": {
-        "lastModified": 1694822471,
-        "narHash": "sha256-6fSDCj++lZVMZlyqOe9SIOL8tYSBz1bI8acwovRwoX8=",
+        "lastModified": 1675758091,
+        "narHash": "sha256-7gFSQbSVAFUHtGCNHPF7mPc5CcqDk9M2+inlVPZSneg=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "47585496bcb13fb72e4a90daeea2f434e2501998",
+        "rev": "747927516efcb5e31ba03b7ff32f61f6d47e7d87",
         "type": "github"
       },
       "original": {
         "owner": "NixOS",
+        "ref": "nixpkgs-unstable",
         "repo": "nixpkgs",
-        "rev": "47585496bcb13fb72e4a90daeea2f434e2501998",
         "type": "github"
       }
     },
     "nixpkgs_2": {
       "locked": {
-        "lastModified": 1698434055,
-        "narHash": "sha256-Phxi5mUKSoL7A0IYUiYtkI9e8NcGaaV5PJEaJApU1Ko=",
+        "lastModified": 1653581809,
+        "narHash": "sha256-Uvka0V5MTGbeOfWte25+tfRL3moECDh1VwokWSZUdoY=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "1a3c95e3b23b3cdb26750621c08cc2f1560cb883",
+        "rev": "83658b28fe638a170a19b8933aa008b30640fbd1",
         "type": "github"
       },
       "original": {
         "owner": "NixOS",
-        "ref": "nixos-23.05",
+        "ref": "nixos-unstable",
         "repo": "nixpkgs",
         "type": "github"
       }
     },
+    "nixpkgs_3": {
+      "locked": {
+        "lastModified": 1654807842,
+        "narHash": "sha256-ADymZpr6LuTEBXcy6RtFHcUZdjKTBRTMYwu19WOx17E=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "fc909087cc3386955f21b4665731dbdaceefb1d8",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "nixpkgs_4": {
+      "locked": {
+        "lastModified": 1665087388,
+        "narHash": "sha256-FZFPuW9NWHJteATOf79rZfwfRn5fE0wi9kRzvGfDHPA=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "95fda953f6db2e9496d2682c4fc7b82f959878f7",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "nixpkgs_5": {
+      "locked": {
+        "lastModified": 1676726892,
+        "narHash": "sha256-M7OYVR6dKmzmlebIjybFf3l18S2uur8lMyWWnHQooLY=",
+        "owner": "angerman",
+        "repo": "nixpkgs",
+        "rev": "729469087592bdea58b360de59dadf6d58714c42",
+        "type": "github"
+      },
+      "original": {
+        "owner": "angerman",
+        "ref": "release-22.11",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "nosys": {
+      "locked": {
+        "lastModified": 1667881534,
+        "narHash": "sha256-FhwJ15uPLRsvaxtt/bNuqE/ykMpNAPF0upozFKhTtXM=",
+        "owner": "divnix",
+        "repo": "nosys",
+        "rev": "2d0d5207f6a230e9d0f660903f8db9807b54814f",
+        "type": "github"
+      },
+      "original": {
+        "owner": "divnix",
+        "repo": "nosys",
+        "type": "github"
+      }
+    },
     "old-ghc-nix": {
       "flake": false,
       "locked": {
@@ -707,21 +807,17 @@
         "flake-utils": "flake-utils",
         "hackage": "hackage",
         "haskellNix": "haskellNix",
-        "mac2ios": "mac2ios",
-        "nixpkgs": [
-          "haskellNix",
-          "nixpkgs-2305"
-        ]
+        "nixpkgs": "nixpkgs_5"
       }
     },
     "stackage": {
       "flake": false,
       "locked": {
-        "lastModified": 1726532152,
-        "narHash": "sha256-LRXbVY3M2S8uQWdwd2zZrsnVPEvt2GxaHGoy8EFFdJA=",
+        "lastModified": 1677888571,
+        "narHash": "sha256-YkhRNOaN6QVagZo1cfykYV8KqkI8/q6r2F5+jypOma4=",
         "owner": "input-output-hk",
         "repo": "stackage.nix",
-        "rev": "c77b3530cebad603812cb111c6f64968c2d2337d",
+        "rev": "cb50e6fabdfb2d7e655059039012ad0623f06a27",
         "type": "github"
       },
       "original": {
@@ -730,18 +826,110 @@
         "type": "github"
       }
     },
-    "systems": {
+    "std": {
+      "inputs": {
+        "arion": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "blank"
+        ],
+        "blank": "blank",
+        "devshell": "devshell",
+        "dmerge": "dmerge",
+        "flake-utils": "flake-utils_4",
+        "incl": "incl",
+        "makes": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "blank"
+        ],
+        "microvm": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "blank"
+        ],
+        "n2c": "n2c",
+        "nixago": "nixago",
+        "nixpkgs": "nixpkgs_4",
+        "nosys": "nosys",
+        "yants": "yants"
+      },
       "locked": {
-        "lastModified": 1681028828,
-        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
-        "owner": "nix-systems",
-        "repo": "default",
-        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "lastModified": 1674526466,
+        "narHash": "sha256-tMTaS0bqLx6VJ+K+ZT6xqsXNpzvSXJTmogkraBGzymg=",
+        "owner": "divnix",
+        "repo": "std",
+        "rev": "516387e3d8d059b50e742a2ff1909ed3c8f82826",
         "type": "github"
       },
       "original": {
-        "owner": "nix-systems",
-        "repo": "default",
+        "owner": "divnix",
+        "repo": "std",
+        "type": "github"
+      }
+    },
+    "tullia": {
+      "inputs": {
+        "nix-nomad": "nix-nomad",
+        "nix2container": "nix2container",
+        "nixpkgs": [
+          "haskellNix",
+          "nixpkgs"
+        ],
+        "std": "std"
+      },
+      "locked": {
+        "lastModified": 1675695930,
+        "narHash": "sha256-B7rEZ/DBUMlK1AcJ9ajnAPPxqXY6zW2SBX+51bZV0Ac=",
+        "owner": "input-output-hk",
+        "repo": "tullia",
+        "rev": "621365f2c725608f381b3ad5b57afef389fd4c31",
+        "type": "github"
+      },
+      "original": {
+        "owner": "input-output-hk",
+        "repo": "tullia",
+        "type": "github"
+      }
+    },
+    "utils": {
+      "locked": {
+        "lastModified": 1653893745,
+        "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "yants": {
+      "inputs": {
+        "nixpkgs": [
+          "haskellNix",
+          "tullia",
+          "std",
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1667096281,
+        "narHash": "sha256-wRRec6ze0gJHmGn6m57/zhz/Kdvp9HS4Nl5fkQ+uIuA=",
+        "owner": "divnix",
+        "repo": "yants",
+        "rev": "d18f356ec25cb94dc9c275870c3a7927a10f8c3c",
+        "type": "github"
+      },
+      "original": {
+        "owner": "divnix",
+        "repo": "yants",
         "type": "github"
       }
     }

flake.nix

@@ -1,15 +1,15 @@
 {
   description = "nix flake for simplex-chat";
+  inputs.nixpkgs.url = "github:angerman/nixpkgs/release-22.11";
   inputs.haskellNix.url = "github:input-output-hk/haskell.nix/armv7a";
-  inputs.nixpkgs.follows = "haskellNix/nixpkgs-2305";
-  inputs.mac2ios.url = "github:zw3rk/mobile-core-tools";
+  inputs.haskellNix.inputs.nixpkgs.follows = "nixpkgs";
   inputs.hackage = {
     url = "github:input-output-hk/hackage.nix";
     flake = false;
   };
   inputs.haskellNix.inputs.hackage.follows = "hackage";
   inputs.flake-utils.url = "github:numtide/flake-utils";
-  outputs = { self, haskellNix, nixpkgs, flake-utils, mac2ios, ... }:
+  outputs = { self, haskellNix, nixpkgs, flake-utils, ... }:
     let systems = [ "x86_64-linux" "x86_64-darwin" "aarch64-linux" "aarch64-darwin" ]; in
     flake-utils.lib.eachSystem systems (system:
       # this android26 overlay makes the pkgsCross.{aarch64-android,armv7a-android-prebuilt} to set stdVer to 26 (Android 8).
@@ -30,7 +30,7 @@
       # `appendOverlays` with a singleton is identical to `extend`.
       let pkgs = haskellNix.legacyPackages.${system}.appendOverlays [android26]; in
       let drv' = { extra-modules, pkgs', ... }: pkgs'.haskell-nix.project {
-        compiler-nix-name = "ghc963";
+        compiler-nix-name = "ghc8107";
         index-state = "2023-12-12T00:00:00Z";
         # We need this, to specify we want the cabal project.
         # If the stack.yaml was dropped, this would not be necessary.
@@ -40,12 +40,9 @@
           src = ./.;
         };
         sha256map = import ./scripts/nix/sha256map.nix;
-        modules = [
-        ({ pkgs, lib, ...}: lib.mkIf (!pkgs.stdenv.hostPlatform.isWindows) {
-          # This patch adds `dl` as an extra-library to direct-sqlciper, which is needed
-          # on pretty much all unix platforms, but then blows up on windows m(
+        modules = [{
           packages.direct-sqlcipher.patches = [ ./scripts/nix/direct-sqlcipher-2.3.27.patch ];
-        })
+        }
         ({ pkgs,lib, ... }: lib.mkIf (pkgs.stdenv.hostPlatform.isAndroid) {
           packages.simplex-chat.components.library.ghcOptions = [ "-pie" ];
         })] ++ extra-modules;
@@ -67,9 +64,6 @@
       }); in
       let iosPostInstall = bundleName: ''
         ${pkgs.tree}/bin/tree $out
-        mkdir tmp
-        find ./dist -name "libHS*-ghc*.a" -exec cp {} tmp \;
-        (cd tmp; ${pkgs.tree}/bin/tree .; ar x libHS*.a; for o in *.o; do if /usr/bin/otool -xv $o|grep ldadd ; then echo $o; fi; done; cd ..; rm -fR tmp)
         mkdir -p $out/_pkg
         # copy over includes, we might want those, but maybe not.
         # cp -r $out/lib/*/*/include $out/_pkg/
@@ -80,18 +74,6 @@
         find ${pkgs.gmp6.override { withStatic = true; }}/lib -name "*.a" -exec cp {} $out/_pkg \;
         # There is no static libc
         ${pkgs.tree}/bin/tree $out/_pkg
-        for pkg in $out/_pkg/*.a; do
-          chmod +w $pkg
-          ${mac2ios.packages.${system}.mac2ios}/bin/mac2ios $pkg
-          chmod -w $pkg
-        done
-
-        mkdir tmp
-        find $out/_pkg -name "libHS*-ghc*.a" -exec cp {} tmp \;
-        (cd tmp; ${pkgs.tree}/bin/tree .; ar x libHS*.a; for o in *.o; do if /usr/bin/otool -xv $o|grep ldadd ; then echo $o; fi; done; cd ..; rm -fR tmp)
-
-        sha256sum $out/_pkg/*.a
-
         (cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/${bundleName}.zip *)
         rm -fR $out/_pkg
         mkdir -p $out/nix-support
@@ -137,150 +119,13 @@
                       hardeningDisable = [ "fortify" ];
                   }
               );in {
-              # STATIC x86_64-linux
               "${pkgs.pkgsCross.musl64.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.musl64).simplex-chat.components.exes.simplex-chat;
-              # STATIC i686-linux
-              "${pkgs.pkgsCross.musl32.hostPlatform.system}-static:exe:simplex-chat" = (drv' {
-                pkgs' = pkgs.pkgsCross.musl32;
-                extra-modules = [{
-                  # 32 bit patches
-                  packages.basement.patches = [
-                    ./scripts/nix/basement-pr-573.patch
-                  ];
-                  packages.memory.patches = [
-                    ./scripts/nix/memory-pr-99.patch
-                  ];
-                }];
-              }).simplex-chat.components.exes.simplex-chat;
-              # WINDOWS x86_64-mingwW64
-              "${pkgs.pkgsCross.mingwW64.hostPlatform.system}:exe:simplex-chat" = (drv' {
-                pkgs' = pkgs.pkgsCross.mingwW64;
-                extra-modules = [{
-                  packages.direct-sqlcipher.flags.openssl = true;
-                  packages.bitvec.flags.simd = false;
-                  packages.direct-sqlcipher.patches = [
-                    ./scripts/nix/direct-sqlcipher-2.3.27-win.patch
-                  ];
-                  packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
-                    (pkgs.pkgsCross.mingwW64.openssl) #.override) # { static = true; enableKTLS = false; })
-                  ];
-                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
-                    (pkgs.pkgsCross.mingwW64.openssl) #.override) # { static = true; enableKTLS = false; })
-                  ];
-                  packages.unix-time.postPatch = ''
-                    sed -i 's/mingwex//g' unix-time.cabal
-                  '';
-                 }];
-                }).simplex-chat.components.exes.simplex-chat.override {
-                postInstall = ''
-                  set -x
-                  ${pkgs.tree}/bin/tree $out
-                  mkdir -p $out/_pkg
-                  cp $out/bin/* $out/_pkg
-                  ${pkgs.tree}/bin/tree $out/_pkg
-                  (cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/${pkgs.pkgsCross.mingwW64.hostPlatform.system}-simplex-chat.zip *)
-                  rm -fR $out/_pkg
-                  mkdir -p $out/nix-support
-                  echo "file binary-dist \"$(echo $out/*.zip)\"" \
-                      > $out/nix-support/hydra-build-products
-                '';
-              };
-              "${pkgs.pkgsCross.mingwW64.hostPlatform.system}:lib:simplex-chat" = (drv' rec {
-                pkgs' = pkgs.pkgsCross.mingwW64;
-                extra-modules = [{
-                  packages.direct-sqlcipher.flags.openssl = true;
-                  # simd will try to read __cpu_model, which we don't expose
-                  # from the rts (yet!).
-                  packages.bitvec.flags.simd = false;
-                  packages.direct-sqlcipher.patches = [
-                    ./scripts/nix/direct-sqlcipher-2.3.27-win.patch
-                  ];
-                  packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
-                    pkgs.pkgsCross.mingwW64.openssl
-                  ];
-                  packages.simplexmq.flags.client_library = true;
-                  packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
-                    pkgs.pkgsCross.mingwW64.openssl
-                  ];
-                  packages.unix-time.postPatch = ''
-                    sed -i 's/mingwex//g' unix-time.cabal
-                  '';
-                }];
-              }).simplex-chat.components.library
-              .override (p: {
-                # enableShared = false;
-                setupBuildFlags = p.component.setupBuildFlags ++ map (x: "--ghc-option=${x}") [
-                  "-shared"
-                  "-threaded"
-                  "-o" "libsimplex.dll"
-                  # "-optl-lHSrts_thr"
-                  "-optl-lffi"
-                  # "-optl-static-libgcc"
-                  # We can't do -optl-static-libstdc++ with gcc. g++ might
-                  # but then we are chaning the compiler altogether.
-                  "${./libsimplex.dll.def}"
-                ];
-                postInstall = ''
-                  set -x
-                  function deps() {
-                    ${pkgs.binutils}/bin/strings "$1" | grep '.\.dll'|grep -v -E 'Winsock|ADVAPI32|dbghelp|KERNEL32|msvcrt|ntdll|ole32|RPCRT4|SHELL32|USER32|WINMM|WS2_32|kernel32|GDI32'|grep -v "$1"
-                  }
-                  ${pkgs.tree}/bin/tree $out
-                  mkdir -p $out/_pkg
-                  cp libsimplex.dll $out/_pkg
-                  cp libsimplex.dll.a $out/_pkg
-                  mkdir $out/libs
-                  find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.openssl}             -name "*.dll" -exec cp {} $out/libs \;
-                  find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.libffi}              -name "*.dll" -exec cp {} $out/libs \;
-                  find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.gmp}                 -name "*.dll" -exec cp {} $out/libs \;
-                  find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.stdenv.cc.cc}        -name "*.dll" -exec cp {} $out/libs \;
-                  find ${pkgs.lib.getBin pkgs.pkgsCross.mingwW64.windows.mcfgthreads} -name "*.dll" -exec cp {} $out/libs \;
-
-                  pushd $out/_pkg
-                  function copyDeps() {
-                    for dep in $(deps "$1"); do
-                      if [ ! -f "$dep" ]; then
-                        if [ ! -f ../libs/"$dep" ]; then
-                          echo "WARN: $1 -> $dep not found!"
-                        else
-                          cp ../libs/"$dep" .
-                          copyDeps "$dep"
-                        fi
-                      fi
-                    done
-                  }
-                  copyDeps libsimplex.dll
-                  popd
-                  ${pkgs.tree}/bin/tree $out/_pkg
-                  (cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/pkg-${pkgs.pkgsCross.mingwW64.hostPlatform.system}-libsimplex.zip *)
-                  rm -fR $out/_pkg
-                  mkdir -p $out/nix-support
-                  echo "file binary-dist \"$(echo $out/*.zip)\"" \
-                      > $out/nix-support/hydra-build-products
-                '';
-              });
+              "${pkgs.pkgsCross.musl32.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.musl32).simplex-chat.components.exes.simplex-chat;
               # "${pkgs.pkgsCross.muslpi.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.muslpi).simplex-chat.components.exes.simplex-chat;
-
-              # STATIC aarch64-linux
               "${pkgs.pkgsCross.aarch64-multiplatform-musl.hostPlatform.system}-static:exe:simplex-chat" = (drv pkgs.pkgsCross.aarch64-multiplatform-musl).simplex-chat.components.exes.simplex-chat;
-              "armv7a-android:lib:support" = (drv android32Pkgs).android-support.components.library.override (p: {
-                smallAddressSpace = true;
-                # we won't want -dyamic (see aarch64-android:lib:simplex-chat)
-                enableShared = false;
-                # we also do not want to have any dependencies listed (especially no rts!)
-                enableStatic = false;
-
-                # This used to work with 8.10.7...
-                # setupBuildFlags = p.component.setupBuildFlags ++ map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ];
-                # ... but now with 9.6+
-                # we have to do the -shared thing by hand.
-                postBuild = ''
-                  armv7a-unknown-linux-androideabi-ghc -shared -o libsupport.so \
-                    -optl-Wl,-u,setLineBuffering \
-                    -optl-Wl,-u,pipe_std_to_socket \
-                    dist/build/*.a
-                '';
-
+              "armv7a-android:lib:support" = (drv android32Pkgs).android-support.components.library.override {
+                smallAddressSpace = true; enableShared = false;
+                setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ];
                 postInstall = ''
 
                   mkdir -p $out/_pkg
@@ -293,29 +138,14 @@
                   echo "file binary-dist \"$(echo $out/*.zip)\"" \
                         > $out/nix-support/hydra-build-products
                 '';
-              });
-              # The android-support package is at
-              # https://github.com/simplex-chat/android-support
-              "aarch64-android:lib:support" = (drv androidPkgs).android-support.components.library.override (p: {
-                smallAddressSpace = true;
-                # no -dynamic
-                enableShared = false;
-                # but also no -staticlib
-                enableStatic = false;
-
-                # we have to do the -shared thing by hand.
-                postBuild = ''
-                  aarch64-unknown-linux-android-ghc -shared -o libsupport.so \
-                    -optl-Wl,-u,setLineBuffering \
-                    -optl-Wl,-u,pipe_std_to_socket \
-                    dist/build/*.a
-                '';
-
+              };
+              "aarch64-android:lib:support" = (drv androidPkgs).android-support.components.library.override {
+                smallAddressSpace = true; enableShared = false;
+                setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsupport.so" ];
                 postInstall = ''
 
                   mkdir -p $out/_pkg
                   cp libsupport.so $out/_pkg
-                  ls -lah $out/_pkg/*
                   ${pkgs.patchelf}/bin/patchelf --remove-needed libunwind.so.1 $out/_pkg/libsupport.so
                   (cd $out/_pkg; ${pkgs.zip}/bin/zip -r -9 $out/pkg-aarch64-android-libsupport.zip *)
                   rm -fR $out/_pkg
@@ -324,11 +154,10 @@
                   echo "file binary-dist \"$(echo $out/*.zip)\"" \
                         > $out/nix-support/hydra-build-products
                 '';
-              });
+              };
               "armv7a-android:lib:simplex-chat" = (drv' {
                 pkgs' = android32Pkgs;
                 extra-modules = [{
-                  packages.text.flags.simdutf = false;
                   packages.direct-sqlcipher.flags.openssl = true;
                   packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
                     (android32Pkgs.openssl.override { static = true; enableKTLS = false; })
@@ -340,56 +169,13 @@
                   packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
                     (android32Pkgs.openssl.override { static = true; enableKTLS = false; })
                   ];
-                  # 32 bit patches
-                  packages.basement.patches = [
-                    ./scripts/nix/basement-pr-573.patch
-                  ];
-                  packages.memory.patches = [
-                    ./scripts/nix/memory-pr-99.patch
-                  ];
                 }];
-              }).simplex-chat.components.library.override (p: {
-                smallAddressSpace = true;
-                # we want -shared, but not -dyanmic, hence `enableShared = false`.
-                enableShared = false;
-                # we _do_ want rts, and other libs. Hence `enableStatic = true`.
-                enableStatic = true;
+              }).simplex-chat.components.library.override {
+                smallAddressSpace = true; enableShared = false;
                 # for android we build a shared library, passing these arguments is a bit tricky, as
                 # we want only the threaded rts (HSrts_thr) and ffi to be linked, but not fed into iserv for
                 # template haskell cross compilation. Thus we just pass them as linker options (-optl).
-                setupBuildFlags = p.component.setupBuildFlags
-                # flags to tell GHC we want to produce a -shared object, and we want to also link
-                # - the ffi library (ffi)
-                ++ map (x: "--ghc-option=${x}") [
-                  "-shared" "-o" "libsimplex.so"
-                  "-threaded"
-                  # "-debug"
-                  "-optl-lffi"
-                ]
-                # This is fairly idiotic. LLD will strip out foreign exported
-                # symbols (a GHC bug? Codegen bug?). So we need to pass `-u <sym>`
-                # to ensure they stay in the produced library. Having them
-                # _undefined_ and _lazy_ (lld will tell with -y <sym> that the
-                # symbol is lazy), makes them _defined_. m(
-                ++ map (sym: "--ghc-option=-optl-Wl,-u,${sym}") [
-                  "chat_close_store"
-                  "chat_decrypt_file"
-                  "chat_decrypt_media"
-                  "chat_encrypt_file"
-                  "chat_encrypt_media"
-                  "chat_migrate_init"
-                  "chat_parse_markdown"
-                  "chat_parse_server"
-                  "chat_password_hash"
-                  "chat_read_file"
-                  "chat_recv_msg"
-                  "chat_recv_msg_wait"
-                  "chat_send_cmd"
-                  "chat_send_remote_cmd"
-                  "chat_valid_name"
-                  "chat_json_length"
-                  "chat_write_file"
-                ];
+                setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsimplex.so" "-optl-lHSrts_thr" "-optl-lffi"];
                 postInstall = ''
                   set -x
                   ${pkgs.tree}/bin/tree $out
@@ -433,11 +219,10 @@
                   echo "file binary-dist \"$(echo $out/*.zip)\"" \
                       > $out/nix-support/hydra-build-products
                 '';
-              });
+              };
               "aarch64-android:lib:simplex-chat" = (drv' {
                 pkgs' = androidPkgs;
                 extra-modules = [{
-                  packages.text.flags.simdutf = false;
                   packages.direct-sqlcipher.flags.openssl = true;
                   packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
                     (androidPkgs.openssl.override { static = true; })
@@ -450,50 +235,12 @@
                     (androidPkgs.openssl.override { static = true; })
                   ];
                 }];
-              }).simplex-chat.components.library.override (p: {
-                smallAddressSpace = true;
-                # we do not want a dynamically linked object, even though we _do_
-                # want to produce a _shared_ object. But `shared` implied -dyanmic
-                # with cabal, so we disable and pass `-shared` explicitly.
-                enableShared = false;
-                # we do want static (e.g. pass all dependencies in, so we get -staticlib)
-                enableStatic = true;
+              }).simplex-chat.components.library.override {
+                smallAddressSpace = true; enableShared = false;
                 # for android we build a shared library, passing these arguments is a bit tricky, as
                 # we want only the threaded rts (HSrts_thr) and ffi to be linked, but not fed into iserv for
                 # template haskell cross compilation. Thus we just pass them as linker options (-optl).
-                setupBuildFlags = p.component.setupBuildFlags
-                # flags to tell GHC we want to produce a -shared object, and we want to also link
-                # - the ffi library (ffi)
-                ++ map (x: "--ghc-option=${x}") [
-                  "-shared" "-o" "libsimplex.so"
-                  "-threaded"
-                  # "-debug"
-                  "-optl-lffi"
-                ]
-                # This is fairly idiotic. LLD will strip out foreign exported
-                # symbols (a GHC bug? Codegen bug?). So we need to pass `-u <sym>`
-                # to ensure they stay in the produced library. Having them
-                # _undefined_ and _lazy_ (lld will tell with -y <sym> that the
-                # symbol is lazy), makes them _defined_. m(
-                ++ map (sym: "--ghc-option=-optl-Wl,-u,${sym}") [
-                  "chat_close_store"
-                  "chat_decrypt_file"
-                  "chat_decrypt_media"
-                  "chat_encrypt_file"
-                  "chat_encrypt_media"
-                  "chat_migrate_init"
-                  "chat_parse_markdown"
-                  "chat_parse_server"
-                  "chat_password_hash"
-                  "chat_read_file"
-                  "chat_recv_msg"
-                  "chat_recv_msg_wait"
-                  "chat_send_cmd"
-                  "chat_send_remote_cmd"
-                  "chat_valid_name"
-                  "chat_json_length"
-                  "chat_write_file"
-                ];
+                setupBuildFlags = map (x: "--ghc-option=${x}") [ "-shared" "-o" "libsimplex.so" "-optl-lHSrts_thr" "-optl-lffi"];
                 postInstall = ''
                   set -x
                   ${pkgs.tree}/bin/tree $out
@@ -537,7 +284,7 @@
                   echo "file binary-dist \"$(echo $out/*.zip)\"" \
                       > $out/nix-support/hydra-build-products
                 '';
-              });
+              };
             };
 
             # builds for iOS and iOS simulator
@@ -552,8 +299,7 @@
                   packages.entropy.flags.DoNotGetEntropy = true;
                   packages.simplexmq.flags.client_library = true;
                   packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
-                    # TODO: have a cross override for iOS, that sets this.
-                    ((pkgs.openssl.override { static = true; }).overrideDerivation (old: { CFLAGS = "-mcpu=apple-a7 -march=armv8-a+norcpc" ;}))
+                    (pkgs.openssl.override { static = true; })
                   ];
                 }];
               }).simplex-chat.components.library.override (

package.yaml

@@ -39,6 +39,7 @@ dependencies:
   - optparse-applicative >= 0.15 && < 0.17
   - random >= 1.1 && < 1.3
   - record-hasfield == 1.0.*
+  - scientific ==0.3.7.*
   - simple-logger == 0.1.*
   - simplexmq >= 5.0
   - socks == 0.6.*
@@ -73,7 +74,7 @@ when:
       - bytestring == 0.10.*
       - process >= 1.6 && < 1.6.18
       - template-haskell == 2.16.*
-      - text >= 1.2.3.0 && < 1.3
+      - text >= 1.2.4.0 && < 1.3
 
 library:
   source-dirs: src

scripts/ci/prepare-keychain-mac.sh

@@ -1,10 +0,0 @@
-#!/bin/bash
-
-security create-keychain -p "" simplex.keychain
-security set-keychain-settings -u simplex.keychain
-security add-certificates -k simplex.keychain "Developer ID Application: SimpleX Chat Ltd (5NN7GUYB6T).cer"
-security add-certificates -k simplex.keychain "Developer ID Certification Authority.cer"
-# Private key with access from any app
-security import "SimpleX Chat.p12" -P "" -k simplex.keychain -A
-# Public key
-security import "SimpleX Chat.pem" -k simplex.keychain

scripts/desktop/build-desktop-mac-ci.sh

@@ -2,7 +2,7 @@
 
 set -e
 
-trap "rm apps/multiplatform/local.properties 2> /dev/null || true; rm local.properties 2> /dev/null || true; rm /tmp/simplex.keychain" EXIT
+trap "rm apps/multiplatform/local.properties || true; rm local.properties || true; rm /tmp/simplex.keychain || true" EXIT
 echo "desktop.mac.signing.identity=Developer ID Application: SimpleX Chat Ltd (5NN7GUYB6T)" >> apps/multiplatform/local.properties
 echo "desktop.mac.signing.keychain=/tmp/simplex.keychain" >> apps/multiplatform/local.properties
 echo "desktop.mac.notarization.apple_id=$APPLE_SIMPLEX_NOTARIZATION_APPLE_ID" >> apps/multiplatform/local.properties
@@ -10,10 +10,6 @@ echo "desktop.mac.notarization.password=$APPLE_SIMPLEX_NOTARIZATION_PASSWORD" >>
 echo "desktop.mac.notarization.team_id=5NN7GUYB6T" >> apps/multiplatform/local.properties
 echo "$APPLE_SIMPLEX_SIGNING_KEYCHAIN" | base64 --decode -o /tmp/simplex.keychain
 
-security unlock-keychain -p "" /tmp/simplex.keychain
-# Adding keychain to the list of keychains.
-# Otherwise, it can find cert but exits while signing with "error: The specified item could not be found in the keychain."
-security list-keychains -s `security list-keychains | xargs` /tmp/simplex.keychain
 scripts/desktop/build-lib-mac.sh
 cd apps/multiplatform
 ./gradlew packageDmg

scripts/desktop/build-lib-linux.sh

@@ -8,7 +8,7 @@ function readlink() {
 
 OS=linux
 ARCH=${1:-`uname -a | rev | cut -d' ' -f2 | rev`}
-GHC_VERSION=9.6.3
+GHC_VERSION=8.10.7
 
 if [ "$ARCH" == "aarch64" ]; then
     COMPOSE_ARCH=arm64
@@ -25,7 +25,7 @@ for elem in "${exports[@]}"; do count=$(grep -R "$elem$" libsimplex.dll.def | wc
 for elem in "${exports[@]}"; do count=$(grep -R "\"$elem\"" flake.nix | wc -l); if [ $count -ne 2 ]; then echo Wrong exports in flake.nix. Add \"$elem\" in two places of the file; exit 1; fi ; done
 
 rm -rf $BUILD_DIR
-cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN -flink-rts -threaded' --constraint 'simplexmq +client_library'
+cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN' --ghc-options="-optl-L$(ghc --print-libdir)/rts -optl-Wl,--as-needed,-lHSrts_thr-ghc$GHC_VERSION" --constraint 'simplexmq +client_library'
 cd $BUILD_DIR/build
 #patchelf --add-needed libHSrts_thr-ghc${GHC_VERSION}.so libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so
 #patchelf --add-rpath '$ORIGIN' libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so

scripts/desktop/build-lib-mac.sh

@@ -5,14 +5,13 @@ set -e
 OS=mac
 ARCH="${1:-`uname -a | rev | cut -d' ' -f1 | rev`}"
 COMPOSE_ARCH=$ARCH
-GHC_VERSION=9.6.3
+GHC_VERSION=8.10.7
 
 if [ "$ARCH" == "arm64" ]; then
     ARCH=aarch64
 else
     COMPOSE_ARCH=x64
 fi
-
 LIB_EXT=dylib
 LIB=libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT
 GHC_LIBS_DIR=$(ghc --print-libdir)
@@ -24,26 +23,13 @@ for elem in "${exports[@]}"; do count=$(grep -R "$elem$" libsimplex.dll.def | wc
 for elem in "${exports[@]}"; do count=$(grep -R "\"$elem\"" flake.nix | wc -l); if [ $count -ne 2 ]; then echo Wrong exports in flake.nix. Add \"$elem\" in two places of the file; exit 1; fi ; done
 
 rm -rf $BUILD_DIR
-cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" --constraint 'simplexmq +client_library'
+cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/rts -optl-lHSrts_thr-ghc8.10.7 -optl-lffi" --constraint 'simplexmq +client_library'
 
 cd $BUILD_DIR/build
 mkdir deps 2> /dev/null || true
 
 # It's not included by default for some reason. Compiled lib tries to find system one but it's not always available
-#cp $GHC_LIBS_DIR/libffi.dylib ./deps
-(
-  BUILD=$PWD
-  cp /tmp/libffi-3.4.4/*-apple-darwin*/.libs/libffi.dylib $BUILD/deps || \
-    ( \
-    cd /tmp && \
-    curl --tlsv1.2 "https://gitlab.haskell.org/ghc/libffi-tarballs/-/raw/libffi-3.4.4/libffi-3.4.4.tar.gz?inline=false" -o libffi.tar.gz && \
-    tar -xzvf libffi.tar.gz && \
-    cd "libffi-3.4.4" && \
-    ./configure && \
-    make && \
-    cp *-apple-darwin*/.libs/libffi.dylib $BUILD/deps \
-    )
-)
+cp $GHC_LIBS_DIR/rts/libffi.dylib ./deps
 
 DYLIBS=`otool -L $LIB | grep @rpath | tail -n +2 | cut -d' ' -f 1 | cut -d'/' -f2`
 RPATHS=`otool -l $LIB | grep "path "| cut -d' ' -f11`
@@ -84,8 +70,6 @@ function copy_deps() {
 }
 
 copy_deps $LIB
-# Special case
-cp $(ghc --print-libdir)/$ARCH-osx-ghc-$GHC_VERSION/libHSghc-boot-th-$GHC_VERSION-ghc$GHC_VERSION.dylib deps
 rm deps/`basename $LIB`
 
 cd -

scripts/nix/basement-pr-573.patch

@@ -1,242 +0,0 @@
-From 38be2c93acb6f459d24ed6c626981c35ccf44095 Mon Sep 17 00:00:00 2001
-From: Sylvain Henry <sylvain@haskus.fr>
-Date: Thu, 16 Feb 2023 15:40:45 +0100
-Subject: [PATCH] Fix build on 32-bit architectures
-
----
- Basement/Bits.hs                 |  4 ++++
- Basement/From.hs                 | 24 -----------------------
- Basement/Numerical/Additive.hs   |  4 ++++
- Basement/Numerical/Conversion.hs | 20 +++++++++++++++++++
- Basement/PrimType.hs             |  6 +++++-
- Basement/Types/OffsetSize.hs     | 22 +++++++++++++++++++--
- 6 files changed, 53 insertions(+), 27 deletions(-)
-
-diff --git a/Basement/Bits.hs b/Basement/Bits.hs
-index 7eeea0f5..24520ed7 100644
---- a/Basement/Bits.hs
-+++ b/Basement/Bits.hs
-@@ -54,8 +54,12 @@ import GHC.Int
- import Basement.Compat.Primitive
-
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+import GHC.Exts
-+#else
- import GHC.IntWord64
- #endif
-+#endif
-
- -- | operation over finite bits
- class FiniteBitsOps bits where
-diff --git a/Basement/From.hs b/Basement/From.hs
-index 7bbe141c..80014b3e 100644
---- a/Basement/From.hs
-+++ b/Basement/From.hs
-@@ -272,23 +272,11 @@ instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)
-     tryFrom = BlockN.toBlockN . UArray.toBlock . BoxArray.mapToUnboxed id
-
- instance (KnownNat n, NatWithinBound Word8 n) => From (Zn64 n) Word8 where
--#if __GLASGOW_HASKELL__ >= 904
--    from = narrow . unZn64 where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# (GHC.Prim.word64ToWord# w)))
--#else
-     from = narrow . unZn64 where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w))
--#endif
- instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where
--#if __GLASGOW_HASKELL__ >= 904
--    from = narrow . unZn64 where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# (GHC.Prim.word64ToWord# w)))
--#else
-     from = narrow . unZn64 where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w))
--#endif
- instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where
--#if __GLASGOW_HASKELL__ >= 904
--    from = narrow . unZn64 where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# (GHC.Prim.word64ToWord# w)))
--#else
-     from = narrow . unZn64 where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w))
--#endif
- instance From (Zn64 n) Word64 where
-     from = unZn64
- instance From (Zn64 n) Word128 where
-@@ -297,23 +285,11 @@ instance From (Zn64 n) Word256 where
-     from = from . unZn64
-
- instance (KnownNat n, NatWithinBound Word8 n) => From (Zn n) Word8 where
--#if __GLASGOW_HASKELL__ >= 904
--    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# (GHC.Prim.word64ToWord# w)))
--#else
-     from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w))
--#endif
- instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where
--#if __GLASGOW_HASKELL__ >= 904
--    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# (GHC.Prim.word64ToWord# w)))
--#else
-     from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w))
--#endif
- instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where
--#if __GLASGOW_HASKELL__ >= 904
--    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# (GHC.Prim.word64ToWord# w)))
--#else
-     from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w))
--#endif
- instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) Word64 where
-     from = naturalToWord64 . unZn
- instance (KnownNat n, NatWithinBound Word128 n) => From (Zn n) Word128 where
-diff --git a/Basement/Numerical/Additive.hs b/Basement/Numerical/Additive.hs
-index d0dfb973..8ab65aa0 100644
---- a/Basement/Numerical/Additive.hs
-+++ b/Basement/Numerical/Additive.hs
-@@ -30,8 +30,12 @@ import qualified Basement.Types.Word128 as Word128
- import qualified Basement.Types.Word256 as Word256
-
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+import           GHC.Exts
-+#else
- import           GHC.IntWord64
- #endif
-+#endif
-
- -- | Represent class of things that can be added together,
- -- contains a neutral element and is commutative.
-diff --git a/Basement/Numerical/Conversion.hs b/Basement/Numerical/Conversion.hs
-index db502c07..fddc8232 100644
---- a/Basement/Numerical/Conversion.hs
-+++ b/Basement/Numerical/Conversion.hs
-@@ -26,8 +26,12 @@ import GHC.Word
- import Basement.Compat.Primitive
-
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+import GHC.Exts
-+#else
- import GHC.IntWord64
- #endif
-+#endif
-
- intToInt64 :: Int -> Int64
- #if WORD_SIZE_IN_BITS == 64
-@@ -96,11 +100,22 @@ int64ToWord64 (I64# i) = W64# (int64ToWord64# i)
- #endif
-
- #if WORD_SIZE_IN_BITS == 64
-+#if __GLASGOW_HASKELL__ >= 904
-+word64ToWord# :: Word64# -> Word#
-+word64ToWord# i = word64ToWord# i
-+#else
- word64ToWord# :: Word# -> Word#
- word64ToWord# i = i
-+#endif
- {-# INLINE word64ToWord# #-}
- #endif
-
-+#if WORD_SIZE_IN_BITS < 64
-+word64ToWord32# :: Word64# -> Word32#
-+word64ToWord32# i = wordToWord32# (word64ToWord# i)
-+{-# INLINE word64ToWord32# #-}
-+#endif
-+
- -- | 2 Word32s
- data Word32x2 = Word32x2 {-# UNPACK #-} !Word32
-                          {-# UNPACK #-} !Word32
-@@ -113,9 +128,14 @@ word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32# (uncheckedShiftRL# (G
- word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32# (uncheckedShiftRL# w64 32#))) (W32# (wordToWord32# w64))
- #endif
- #else
-+#if __GLASGOW_HASKELL__ >= 904
-+word64ToWord32s :: Word64 -> Word32x2
-+word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord32# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord32# w64))
-+#else
- word64ToWord32s :: Word64 -> Word32x2
- word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64))
- #endif
-+#endif
-
- wordToChar :: Word -> Char
- wordToChar (W# word) = C# (chr# (word2Int# word))
-diff --git a/Basement/PrimType.hs b/Basement/PrimType.hs
-index f8ca2926..a888ec91 100644
---- a/Basement/PrimType.hs
-+++ b/Basement/PrimType.hs
-@@ -54,7 +54,11 @@ import           Basement.Nat
- import qualified Prelude (quot)
-
- #if WORD_SIZE_IN_BITS < 64
--import           GHC.IntWord64
-+#if __GLASGOW_HASKELL__ >= 904
-+import GHC.Exts
-+#else
-+import GHC.IntWord64
-+#endif
- #endif
-
- #ifdef FOUNDATION_BOUNDS_CHECK
-diff --git a/Basement/Types/OffsetSize.hs b/Basement/Types/OffsetSize.hs
-index cd944927..1ea80dad 100644
---- a/Basement/Types/OffsetSize.hs
-+++ b/Basement/Types/OffsetSize.hs
-@@ -70,8 +70,12 @@ import Data.List (foldl')
- import qualified Prelude
-
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+import GHC.Exts
-+#else
- import GHC.IntWord64
- #endif
-+#endif
-
- -- | File size in bytes
- newtype FileSize = FileSize Word64
-@@ -225,20 +229,26 @@ countOfRoundUp alignment (CountOf n) = CountOf ((n + (alignment-1)) .&. compleme
-
- csizeOfSize :: CountOf Word8 -> CSize
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+csizeOfSize (CountOf (I# sz)) = CSize (W32# (wordToWord32# (int2Word# sz)))
-+#else
- csizeOfSize (CountOf (I# sz)) = CSize (W32# (int2Word# sz))
-+#endif
- #else
- #if __GLASGOW_HASKELL__ >= 904
- csizeOfSize (CountOf (I# sz)) = CSize (W64# (wordToWord64# (int2Word# sz)))
--
- #else
- csizeOfSize (CountOf (I# sz)) = CSize (W64# (int2Word# sz))
--
- #endif
- #endif
-
- csizeOfOffset :: Offset8 -> CSize
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+csizeOfOffset (Offset (I# sz)) = CSize (W32# (wordToWord32# (int2Word# sz)))
-+#else
- csizeOfOffset (Offset (I# sz)) = CSize (W32# (int2Word# sz))
-+#endif
- #else
- #if __GLASGOW_HASKELL__ >= 904
- csizeOfOffset (Offset (I# sz)) = CSize (W64# (wordToWord64# (int2Word# sz)))
-@@ -250,7 +260,11 @@ csizeOfOffset (Offset (I# sz)) = CSize (W64# (int2Word# sz))
- sizeOfCSSize :: CSsize -> CountOf Word8
- sizeOfCSSize (CSsize (-1))      = error "invalid size: CSSize is -1"
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+sizeOfCSSize (CSsize (I32# sz)) = CountOf (I# (int32ToInt# sz))
-+#else
- sizeOfCSSize (CSsize (I32# sz)) = CountOf (I# sz)
-+#endif
- #else
- #if __GLASGOW_HASKELL__ >= 904
- sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# (int64ToInt# sz))
-@@ -261,7 +275,11 @@ sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# sz)
-
- sizeOfCSize :: CSize -> CountOf Word8
- #if WORD_SIZE_IN_BITS < 64
-+#if __GLASGOW_HASKELL__ >= 904
-+sizeOfCSize (CSize (W32# sz)) = CountOf (I# (word2Int# (word32ToWord# sz)))
-+#else
- sizeOfCSize (CSize (W32# sz)) = CountOf (I# (word2Int# sz))
-+#endif
- #else
- #if __GLASGOW_HASKELL__ >= 904
- sizeOfCSize (CSize (W64# sz)) = CountOf (I# (word2Int# (word64ToWord# sz)))

scripts/nix/direct-sqlcipher-2.3.27-win.patch

@@ -1,12 +0,0 @@
-diff --git a/direct-sqlcipher.cabal b/direct-sqlcipher.cabal
-index 728ba3e..c63745e 100644
---- a/direct-sqlcipher.cabal
-+++ b/direct-sqlcipher.cabal
-@@ -84,6 +84,8 @@ library
-       cc-options: -DSQLITE_TEMP_STORE=2
-                   -DSQLITE_HAS_CODEC
-
-+    extra-libraries: ws2_32
-+
-     if !os(windows) && !os(android)
-       extra-libraries: pthread

scripts/nix/memory-pr-99.patch

@@ -1,36 +0,0 @@
-From 2738929ce15b4c8704bbbac24a08539b5d4bf30e Mon Sep 17 00:00:00 2001
-From: sternenseemann <sternenseemann@systemli.org>
-Date: Mon, 14 Aug 2023 10:51:30 +0200
-Subject: [PATCH] Data.Memory.Internal.CompatPrim64: fix 32 bit with GHC >= 9.4
-
-Since 9.4, GHC.Prim exports Word64# operations like timesWord64# even on
-i686 whereas GHC.IntWord64 no longer exists. Therefore, we can just use
-the ready made solution.
-
-Closes #98, as it should be the better solution.
----
- Data/Memory/Internal/CompatPrim64.hs | 4 ++++
- 1 file changed, 4 insertions(+)
-
-diff --git a/Data/Memory/Internal/CompatPrim64.hs b/Data/Memory/Internal/CompatPrim64.hs
-index b9eef8a..a134c88 100644
---- a/Data/Memory/Internal/CompatPrim64.hs
-+++ b/Data/Memory/Internal/CompatPrim64.hs
-@@ -150,6 +150,7 @@ w64# :: Word# -> Word# -> Word# -> Word64#
- w64# w _ _ = w
- 
- #elif WORD_SIZE_IN_BITS == 32
-+#if __GLASGOW_HASKELL__ < 904
- import GHC.IntWord64
- import GHC.Prim (Word#)
- 
-@@ -158,6 +159,9 @@ timesWord64# a b =
-     let !ai = word64ToInt64# a
-         !bi = word64ToInt64# b
-      in int64ToWord64# (timesInt64# ai bi)
-+#else
-+import GHC.Prim
-+#endif
- 
- w64# :: Word# -> Word# -> Word# -> Word64#
- w64# _ hw lw =

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."ff05a465ee15ac7ae2c14a9fb703a18564950631" = "1gv4nwqzbqkj7y3ffkiwkr4qwv52vdzppsds5vsfqaayl14rzmgp";
+  "https://github.com/simplex-chat/simplexmq.git"."93f30c8edf9243ad2291dd6427d87328e282560a" = "1zf0sp9dy6kz4zvyz6mdgmhydps7khcq84n30irp983w1xh7gzs7";
   "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

@@ -228,6 +228,7 @@ library
     , optparse-applicative >=0.15 && <0.17
     , random >=1.1 && <1.3
     , record-hasfield ==1.0.*
+    , scientific ==0.3.7.*
     , simple-logger ==0.1.*
     , simplexmq >=5.0
     , socks ==0.6.*
@@ -254,7 +255,7 @@ library
         bytestring ==0.10.*
       , process >=1.6 && <1.6.18
       , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
+      , text >=1.2.4.0 && <1.3
 
 executable simplex-bot
   main-is: Main.hs
@@ -292,6 +293,7 @@ executable simplex-bot
     , optparse-applicative >=0.15 && <0.17
     , random >=1.1 && <1.3
     , record-hasfield ==1.0.*
+    , scientific ==0.3.7.*
     , simple-logger ==0.1.*
     , simplex-chat
     , simplexmq >=5.0
@@ -319,7 +321,7 @@ executable simplex-bot
         bytestring ==0.10.*
       , process >=1.6 && <1.6.18
       , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
+      , text >=1.2.4.0 && <1.3
 
 executable simplex-bot-advanced
   main-is: Main.hs
@@ -357,6 +359,7 @@ executable simplex-bot-advanced
     , optparse-applicative >=0.15 && <0.17
     , random >=1.1 && <1.3
     , record-hasfield ==1.0.*
+    , scientific ==0.3.7.*
     , simple-logger ==0.1.*
     , simplex-chat
     , simplexmq >=5.0
@@ -384,7 +387,7 @@ executable simplex-bot-advanced
         bytestring ==0.10.*
       , process >=1.6 && <1.6.18
       , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
+      , text >=1.2.4.0 && <1.3
 
 executable simplex-broadcast-bot
   main-is: Main.hs
@@ -425,6 +428,7 @@ executable simplex-broadcast-bot
     , optparse-applicative >=0.15 && <0.17
     , random >=1.1 && <1.3
     , record-hasfield ==1.0.*
+    , scientific ==0.3.7.*
     , simple-logger ==0.1.*
     , simplex-chat
     , simplexmq >=5.0
@@ -452,7 +456,7 @@ executable simplex-broadcast-bot
         bytestring ==0.10.*
       , process >=1.6 && <1.6.18
       , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
+      , text >=1.2.4.0 && <1.3
 
 executable simplex-chat
   main-is: Main.hs
@@ -491,6 +495,7 @@ executable simplex-chat
     , optparse-applicative >=0.15 && <0.17
     , random >=1.1 && <1.3
     , record-hasfield ==1.0.*
+    , scientific ==0.3.7.*
     , simple-logger ==0.1.*
     , simplex-chat
     , simplexmq >=5.0
@@ -519,7 +524,7 @@ executable simplex-chat
         bytestring ==0.10.*
       , process >=1.6 && <1.6.18
       , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
+      , text >=1.2.4.0 && <1.3
 
 executable simplex-directory-service
   main-is: Main.hs
@@ -563,6 +568,7 @@ executable simplex-directory-service
     , optparse-applicative >=0.15 && <0.17
     , random >=1.1 && <1.3
     , record-hasfield ==1.0.*
+    , scientific ==0.3.7.*
     , simple-logger ==0.1.*
     , simplex-chat
     , simplexmq >=5.0
@@ -590,7 +596,7 @@ executable simplex-directory-service
         bytestring ==0.10.*
       , process >=1.6 && <1.6.18
       , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
+      , text >=1.2.4.0 && <1.3
 
 test-suite simplex-chat-test
   type: exitcode-stdio-1.0
@@ -664,6 +670,7 @@ test-suite simplex-chat-test
     , optparse-applicative >=0.15 && <0.17
     , random >=1.1 && <1.3
     , record-hasfield ==1.0.*
+    , scientific ==0.3.7.*
     , silently ==1.2.*
     , simple-logger ==0.1.*
     , simplex-chat
@@ -692,7 +699,7 @@ test-suite simplex-chat-test
         bytestring ==0.10.*
       , process >=1.6 && <1.6.18
       , template-haskell ==2.16.*
-      , text >=1.2.3.0 && <1.3
+      , text >=1.2.4.0 && <1.3
   if impl(ghc >= 9.6.2)
     build-depends:
         hspec ==2.11.*

src/Simplex/Chat.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -43,7 +44,7 @@ import Data.Functor (($>))
 import Data.Functor.Identity
 import Data.Int (Int64)
 import Data.List (find, foldl', isSuffixOf, mapAccumL, partition, sortOn, zipWith4)
-import Data.List.NonEmpty (NonEmpty (..), nonEmpty, toList, (<|))
+import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -54,6 +55,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
+import Data.Type.Equality
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as V4
 import Data.Word (Word32)
@@ -98,7 +100,7 @@ import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
 import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getFastNetworkConfig, ipAddressProtected, withLockMap)
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), OperatorId, ServerCfg (..), allRoles, createAgentStore, defaultAgentConfig, enabledServerCfg, presetServerCfg)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), ServerCfg (..), ServerRoles (..), allRoles, createAgentStore, defaultAgentConfig)
 import Simplex.Messaging.Agent.Lock (withLock)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
@@ -138,6 +140,32 @@ import qualified UnliftIO.Exception as E
 import UnliftIO.IO (hClose, hSeek, hTell, openFile)
 import UnliftIO.STM
 
+operatorSimpleXChat :: NewServerOperator
+operatorSimpleXChat =
+  ServerOperator
+    { operatorId = DBNewEntity,
+      operatorTag = Just OTSimplex,
+      tradeName = "SimpleX Chat",
+      legalName = Just "SimpleX Chat Ltd",
+      serverDomains = ["simplex.im"],
+      conditionsAcceptance = CARequired Nothing,
+      enabled = True,
+      roles = allRoles
+    }
+
+operatorFlux :: NewServerOperator
+operatorFlux =
+  ServerOperator
+    { operatorId = DBNewEntity,
+      operatorTag = Just OTFlux,
+      tradeName = "Flux",
+      legalName = Just "InFlux Technologies Limited",
+      serverDomains = ["simplexonflux.com"],
+      conditionsAcceptance = CARequired Nothing,
+      enabled = False,
+      roles = ServerRoles {storage = False, proxy = True}
+    }
+
 defaultChatConfig :: ChatConfig
 defaultChatConfig =
   ChatConfig
@@ -148,13 +176,25 @@ defaultChatConfig =
           },
       chatVRange = supportedChatVRange,
       confirmMigrations = MCConsole,
-      defaultServers =
-        DefaultAgentServers
-          { smp = _defaultSMPServers,
-            useSMP = 4,
+      presetServers =
+        PresetServers
+          { operators =
+              [ PresetOperator
+                  { operator = Just operatorSimpleXChat,
+                    smp = simplexChatSMPServers,
+                    useSMP = 4,
+                    xftp = map (presetServer True) $ L.toList defaultXFTPServers,
+                    useXFTP = 3
+                  },
+                PresetOperator
+                  { operator = Just operatorFlux,
+                    smp = fluxSMPServers,
+                    useSMP = 3,
+                    xftp = fluxXFTPServers,
+                    useXFTP = 3
+                  }
+              ],
             ntf = _defaultNtfServers,
-            xftp = L.map (presetServerCfg True allRoles operatorSimpleXChat) defaultXFTPServers,
-            useXFTP = L.length defaultXFTPServers,
             netCfg = defaultNetworkConfig
           },
       tbqSize = 1024,
@@ -178,32 +218,52 @@ defaultChatConfig =
       chatHooks = defaultChatHooks
     }
 
-_defaultSMPServers :: NonEmpty (ServerCfg 'PSMP)
-_defaultSMPServers =
-  L.fromList $
-    map
-      (presetServerCfg True allRoles operatorSimpleXChat)
-      [ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion",
-        "smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im,jssqzccmrcws6bhmn77vgmhfjmhwlyr3u7puw4erkyoosywgl67slqqd.onion",
-        "smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im,rb2pbttocvnbrngnwziclp2f4ckjq65kebafws6g4hy22cdaiv5dwjqd.onion",
-        "smp://1OwYGt-yqOfe2IyVHhxz3ohqo3aCCMjtB-8wn4X_aoY=@smp11.simplex.im,6ioorbm6i3yxmuoezrhjk6f6qgkc4syabh7m3so74xunb5nzr4pwgfqd.onion",
-        "smp://UkMFNAXLXeAAe0beCa4w6X_zp18PwxSaSjY17BKUGXQ=@smp12.simplex.im,ie42b5weq7zdkghocs3mgxdjeuycheeqqmksntj57rmejagmg4eor5yd.onion",
-        "smp://enEkec4hlR3UtKx2NMpOUK_K4ZuDxjWBO1d9Y4YXVaA=@smp14.simplex.im,aspkyu2sopsnizbyfabtsicikr2s4r3ti35jogbcekhm3fsoeyjvgrid.onion",
-        "smp://h--vW7ZSkXPeOUpfxlFGgauQmXNFOzGoizak7Ult7cw=@smp15.simplex.im,oauu4bgijybyhczbnxtlggo6hiubahmeutaqineuyy23aojpih3dajad.onion",
-        "smp://hejn2gVIqNU6xjtGM3OwQeuk8ZEbDXVJXAlnSBJBWUA=@smp16.simplex.im,p3ktngodzi6qrf7w64mmde3syuzrv57y55hxabqcq3l5p6oi7yzze6qd.onion",
-        "smp://ZKe4uxF4Z_aLJJOEsC-Y6hSkXgQS5-oc442JQGkyP8M=@smp17.simplex.im,ogtwfxyi3h2h5weftjjpjmxclhb5ugufa5rcyrmg7j4xlch7qsr5nuqd.onion",
-        "smp://PtsqghzQKU83kYTlQ1VKg996dW4Cw4x_bvpKmiv8uns=@smp18.simplex.im,lyqpnwbs2zqfr45jqkncwpywpbtq7jrhxnib5qddtr6npjyezuwd3nqd.onion",
-        "smp://N_McQS3F9TGoh4ER0QstUf55kGnNSd-wXfNPZ7HukcM=@smp19.simplex.im,i53bbtoqhlc365k6kxzwdp5w3cdt433s7bwh3y32rcbml2vztiyyz5id.onion"
+simplexChatSMPServers :: [NewUserServer 'PSMP]
+simplexChatSMPServers =
+  map
+    (presetServer True)
+    [ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion",
+      "smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im,jssqzccmrcws6bhmn77vgmhfjmhwlyr3u7puw4erkyoosywgl67slqqd.onion",
+      "smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im,rb2pbttocvnbrngnwziclp2f4ckjq65kebafws6g4hy22cdaiv5dwjqd.onion",
+      "smp://1OwYGt-yqOfe2IyVHhxz3ohqo3aCCMjtB-8wn4X_aoY=@smp11.simplex.im,6ioorbm6i3yxmuoezrhjk6f6qgkc4syabh7m3so74xunb5nzr4pwgfqd.onion",
+      "smp://UkMFNAXLXeAAe0beCa4w6X_zp18PwxSaSjY17BKUGXQ=@smp12.simplex.im,ie42b5weq7zdkghocs3mgxdjeuycheeqqmksntj57rmejagmg4eor5yd.onion",
+      "smp://enEkec4hlR3UtKx2NMpOUK_K4ZuDxjWBO1d9Y4YXVaA=@smp14.simplex.im,aspkyu2sopsnizbyfabtsicikr2s4r3ti35jogbcekhm3fsoeyjvgrid.onion",
+      "smp://h--vW7ZSkXPeOUpfxlFGgauQmXNFOzGoizak7Ult7cw=@smp15.simplex.im,oauu4bgijybyhczbnxtlggo6hiubahmeutaqineuyy23aojpih3dajad.onion",
+      "smp://hejn2gVIqNU6xjtGM3OwQeuk8ZEbDXVJXAlnSBJBWUA=@smp16.simplex.im,p3ktngodzi6qrf7w64mmde3syuzrv57y55hxabqcq3l5p6oi7yzze6qd.onion",
+      "smp://ZKe4uxF4Z_aLJJOEsC-Y6hSkXgQS5-oc442JQGkyP8M=@smp17.simplex.im,ogtwfxyi3h2h5weftjjpjmxclhb5ugufa5rcyrmg7j4xlch7qsr5nuqd.onion",
+      "smp://PtsqghzQKU83kYTlQ1VKg996dW4Cw4x_bvpKmiv8uns=@smp18.simplex.im,lyqpnwbs2zqfr45jqkncwpywpbtq7jrhxnib5qddtr6npjyezuwd3nqd.onion",
+      "smp://N_McQS3F9TGoh4ER0QstUf55kGnNSd-wXfNPZ7HukcM=@smp19.simplex.im,i53bbtoqhlc365k6kxzwdp5w3cdt433s7bwh3y32rcbml2vztiyyz5id.onion"
+    ]
+    <> map
+      (presetServer False)
+      [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
+        "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
+        "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
       ]
-      <> map
-        (presetServerCfg False allRoles operatorSimpleXChat)
-        [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
-          "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
-          "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
-        ]
 
-operatorSimpleXChat :: Maybe OperatorId
-operatorSimpleXChat = Just 1
+fluxSMPServers :: [NewUserServer 'PSMP]
+fluxSMPServers =
+  map
+    (presetServer True)
+    [ "smp://xQW_ufMkGE20UrTlBl8QqceG1tbuylXhr9VOLPyRJmw=@smp1.simplexonflux.com,qb4yoanyl4p7o33yrknv4rs6qo7ugeb2tu2zo66sbebezs4cpyosarid.onion",
+      "smp://LDnWZVlAUInmjmdpQQoIo6FUinRXGe0q3zi5okXDE4s=@smp2.simplexonflux.com,yiqtuh3q4x7hgovkomafsod52wvfjucdljqbbipg5sdssnklgongxbqd.onion",
+      "smp://1jne379u7IDJSxAvXbWb_JgoE7iabcslX0LBF22Rej0=@smp3.simplexonflux.com,a5lm4k7ufei66cdck6fy63r4lmkqy3dekmmb7jkfdm5ivi6kfaojshad.onion",
+      "smp://xmAmqj75I9mWrUihLUlI0ZuNLXlIwFIlHRq5Pb6cHAU=@smp4.simplexonflux.com,qpcz2axyy66u26hfdd2e23uohcf3y6c36mn7dcuilcgnwjasnrvnxjqd.onion",
+      "smp://rWvBYyTamuRCBYb_KAn-nsejg879ndhiTg5Sq3k0xWA=@smp5.simplexonflux.com,4ao347qwiuluyd45xunmii4skjigzuuox53hpdsgbwxqafd4yrticead.onion",
+      "smp://PN7-uqLBToqlf1NxHEaiL35lV2vBpXq8Nj8BW11bU48=@smp6.simplexonflux.com,hury6ot3ymebbr2535mlp7gcxzrjpc6oujhtfxcfh2m4fal4xw5fq6qd.onion"
+    ]
+
+fluxXFTPServers :: [NewUserServer 'PXFTP]
+fluxXFTPServers =
+  map
+    (presetServer True)
+    [ "xftp://92Sctlc09vHl_nAqF2min88zKyjdYJ9mgxRCJns5K2U=@xftp1.simplexonflux.com,apl3pumq3emwqtrztykyyoomdx4dg6ysql5zek2bi3rgznz7ai3odkid.onion",
+      "xftp://YBXy4f5zU1CEhnbbCzVWTNVNsaETcAGmYqGNxHntiE8=@xftp2.simplexonflux.com,c5jjecisncnngysah3cz2mppediutfelco4asx65mi75d44njvua3xid.onion",
+      "xftp://ARQO74ZSvv2OrulRF3CdgwPz_AMy27r0phtLSq5b664=@xftp3.simplexonflux.com,dc4mohiubvbnsdfqqn7xhlhpqs5u4tjzp7xpz6v6corwvzvqjtaqqiqd.onion",
+      "xftp://ub2jmAa9U0uQCy90O-fSUNaYCj6sdhl49Jh3VpNXP58=@xftp4.simplexonflux.com,4qq5pzier3i4yhpuhcrhfbl6j25udc4czoyascrj4yswhodhfwev3nyd.onion",
+      "xftp://Rh19D5e4Eez37DEE9hAlXDB3gZa1BdFYJTPgJWPO9OI=@xftp5.simplexonflux.com,q7itltdn32hjmgcqwhow4tay5ijetng3ur32bolssw32fvc5jrwvozad.onion",
+      "xftp://0AznwoyfX8Od9T_acp1QeeKtxUi676IBIiQjXVwbdyU=@xftp6.simplexonflux.com,upvzf23ou6nrmaf3qgnhd6cn3d74tvivlmz3p7wdfwq6fhthjrjiiqid.onion "
+    ]
 
 _defaultNtfServers :: [NtfServer]
 _defaultNtfServers =
@@ -240,16 +300,19 @@ newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Boo
 newChatController
   ChatDatabase {chatStore, agentStore}
   user
-  cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, deviceNameForRemote, confirmMigrations}
+  cfg@ChatConfig {agentConfig = aCfg, presetServers, inlineFiles, deviceNameForRemote, confirmMigrations}
   ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, simpleNetCfg, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable, yesToUpMigrations}, deviceName, optFilesFolder, optTempDirectory, showReactions, allowInstantFiles, autoAcceptFileSize}
   backgroundMode = do
     let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
         confirmMigrations' = if confirmMigrations == MCConsole && yesToUpMigrations then MCYesUp else confirmMigrations
-        config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable, confirmMigrations = confirmMigrations'}
+        config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, presetServers = presetServers', inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable, confirmMigrations = confirmMigrations'}
         firstTime = dbNew chatStore
     currentUser <- newTVarIO user
+    randomSMP <- randomPresetServers SPSMP presetServers'
+    randomXFTP <- randomPresetServers SPXFTP presetServers'
+    let randomServers = RandomServers {smpServers = randomSMP, xftpServers = randomXFTP}
     currentRemoteHost <- newTVarIO Nothing
-    servers <- agentServers config
+    servers <- withTransaction chatStore $ \db -> agentServers db config randomServers
     smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore backgroundMode
     agentAsync <- newTVarIO Nothing
     random <- liftIO C.newRandom
@@ -285,6 +348,7 @@ newChatController
       ChatController
         { firstTime,
           currentUser,
+          randomServers,
           currentRemoteHost,
           smpAgent,
           agentAsync,
@@ -322,28 +386,41 @@ newChatController
           contactMergeEnabled
         }
     where
-      configServers :: DefaultAgentServers
-      configServers =
-        let DefaultAgentServers {smp = defSmp, xftp = defXftp, netCfg} = defaultServers
-            smp' = maybe defSmp (L.map enabledServerCfg) (nonEmpty smpServers)
-            xftp' = maybe defXftp (L.map enabledServerCfg) (nonEmpty xftpServers)
-         in defaultServers {smp = smp', xftp = xftp', netCfg = updateNetworkConfig netCfg simpleNetCfg}
-      agentServers :: ChatConfig -> IO InitialAgentServers
-      agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
-        users <- withTransaction chatStore getUsers
-        smp' <- getUserServers users SPSMP
-        xftp' <- getUserServers users SPXFTP
+      presetServers' :: PresetServers
+      presetServers' = presetServers {operators = operators', netCfg = netCfg'}
+        where
+          PresetServers {operators, netCfg} = presetServers
+          netCfg' = updateNetworkConfig netCfg simpleNetCfg
+          operators' = case (smpServers, xftpServers) of
+            ([], []) -> operators
+            (smpSrvs, []) -> L.map disableSMP operators <> [custom smpSrvs []]
+            ([], xftpSrvs) -> L.map disableXFTP operators <> [custom [] xftpSrvs]
+            (smpSrvs, xftpSrvs) -> [custom smpSrvs xftpSrvs]
+          disableSMP op@PresetOperator {smp} = (op :: PresetOperator) {smp = map disableSrv smp}
+          disableXFTP op@PresetOperator {xftp} = (op :: PresetOperator) {xftp = map disableSrv xftp}
+          disableSrv :: forall p. NewUserServer p -> NewUserServer p
+          disableSrv srv = (srv :: NewUserServer p) {enabled = False}
+          custom smpSrvs xftpSrvs =
+            PresetOperator
+              { operator = Nothing,
+                smp = map newUserServer smpSrvs,
+                useSMP = 0,
+                xftp = map newUserServer xftpSrvs,
+                useXFTP = 0
+              }
+      agentServers :: DB.Connection -> ChatConfig -> RandomServers -> IO InitialAgentServers
+      agentServers db ChatConfig {presetServers = PresetServers {operators = presetOps, ntf, netCfg}} rs = do
+        users <- getUsers db
+        opDomains <- operatorDomains <$> getUpdateServerOperators db presetOps (null users)
+        smp' <- getServers SPSMP users opDomains
+        xftp' <- getServers SPXFTP users opDomains
         pure InitialAgentServers {smp = smp', xftp = xftp', ntf, netCfg}
         where
-          getUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => [User] -> SProtocolType p -> IO (Map UserId (NonEmpty (ServerCfg p)))
-          getUserServers users protocol = case users of
-            [] -> pure $ M.fromList [(1, cfgServers protocol defServers)]
-            _ -> M.fromList <$> initialServers
-            where
-              initialServers :: IO [(UserId, NonEmpty (ServerCfg p))]
-              initialServers = mapM (\u -> (aUserId u,) <$> userServers u) users
-              userServers :: User -> IO (NonEmpty (ServerCfg p))
-              userServers user' = useServers config protocol <$> withTransaction chatStore (`getProtocolServers` user')
+          getServers :: forall p. (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [User] -> [(Text, ServerOperator)] -> IO (Map UserId (NonEmpty (ServerCfg p)))
+          getServers p users opDomains = do
+            let rs' = rndServers p rs
+            fmap M.fromList $ forM users $ \u ->
+              (aUserId u,) . agentServerCfgs opDomains rs' <$> getUpdateUserServers db p presetOps rs' u
 
 updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig
 updateNetworkConfig cfg SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors} =
@@ -386,33 +463,37 @@ withFileLock :: String -> Int64 -> CM a -> CM a
 withFileLock name = withEntityLock name . CLFile
 {-# INLINE withFileLock #-}
 
-useServers :: UserProtocol p => ChatConfig -> SProtocolType p -> [ServerCfg p] -> NonEmpty (ServerCfg p)
-useServers ChatConfig {defaultServers} p = fromMaybe (cfgServers p defaultServers) . nonEmpty
+serverCfg :: ProtoServerWithAuth p -> ServerCfg p
+serverCfg server = ServerCfg {server, operator = Nothing, enabled = True, roles = allRoles}
 
-randomServers :: forall p. UserProtocol p => SProtocolType p -> ChatConfig -> IO (NonEmpty (ServerCfg p), [ServerCfg p])
-randomServers p ChatConfig {defaultServers} = do
-  let srvs = cfgServers p defaultServers
-      (enbldSrvs, dsbldSrvs) = L.partition (\ServerCfg {enabled} -> enabled) srvs
-      toUse = cfgServersToUse p defaultServers
-  if length enbldSrvs <= toUse
-    then pure (srvs, [])
-    else do
-      (enbldSrvs', srvsToDisable) <- splitAt toUse <$> shuffle enbldSrvs
-      let dsbldSrvs' = map (\srv -> (srv :: ServerCfg p) {enabled = False}) srvsToDisable
-          srvs' = sortOn server' $ enbldSrvs' <> dsbldSrvs' <> dsbldSrvs
-      pure (fromMaybe srvs $ L.nonEmpty srvs', srvs')
+useServers :: forall p. UserProtocol p => SProtocolType p -> RandomServers -> [UserServer p] -> NonEmpty (NewUserServer p)
+useServers p rs servers = case L.nonEmpty servers of
+  Nothing -> rndServers p rs
+  Just srvs -> L.map (\srv -> (srv :: UserServer p) {serverId = DBNewEntity}) srvs
+
+rndServers :: UserProtocol p => SProtocolType p -> RandomServers -> NonEmpty (NewUserServer p)
+rndServers p RandomServers {smpServers, xftpServers} = case p of
+  SPSMP -> smpServers
+  SPXFTP -> xftpServers
+
+randomPresetServers :: forall p. UserProtocol p => SProtocolType p -> PresetServers -> IO (NonEmpty (NewUserServer p))
+randomPresetServers p PresetServers {operators} = toJust . L.nonEmpty . concat =<< mapM opSrvs operators
   where
-    server' ServerCfg {server = ProtoServerWithAuth srv _} = srv
-
-cfgServers :: UserProtocol p => SProtocolType p -> DefaultAgentServers -> NonEmpty (ServerCfg p)
-cfgServers p DefaultAgentServers {smp, xftp} = case p of
-  SPSMP -> smp
-  SPXFTP -> xftp
-
-cfgServersToUse :: UserProtocol p => SProtocolType p -> DefaultAgentServers -> Int
-cfgServersToUse p DefaultAgentServers {useSMP, useXFTP} = case p of
-  SPSMP -> useSMP
-  SPXFTP -> useXFTP
+    toJust = \case
+      Just a -> pure a
+      Nothing -> E.throwIO $ userError "no preset servers"
+    opSrvs :: PresetOperator -> IO [NewUserServer p]
+    opSrvs op = do
+      let srvs = operatorServers p op
+          toUse = operatorServersToUse p op
+          (enbldSrvs, dsbldSrvs) = partition (\UserServer {enabled} -> enabled) srvs
+      if toUse <= 0 || toUse >= length enbldSrvs
+        then pure srvs
+        else do
+          (enbldSrvs', srvsToDisable) <- splitAt toUse <$> shuffle enbldSrvs
+          let dsbldSrvs' = map (\srv -> (srv :: NewUserServer p) {enabled = False}) srvsToDisable
+          pure $ sortOn server' $ enbldSrvs' <> dsbldSrvs' <> dsbldSrvs
+    server' UserServer {server = ProtoServerWithAuth srv _} = srv
 
 -- enableSndFiles has no effect when mainApp is True
 startChatController :: Bool -> Bool -> CM' (Async ())
@@ -556,19 +637,24 @@ processChatCommand' vr = \case
     forM_ profile $ \Profile {displayName} -> checkValidName displayName
     p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile
     u <- asks currentUser
-    (smp, smpServers) <- chooseServers SPSMP
-    (xftp, xftpServers) <- chooseServers SPXFTP
+    smpServers <- chooseServers SPSMP
+    xftpServers <- chooseServers SPXFTP
     users <- withFastStore' getUsers
     forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} ->
       when (n == displayName) . throwChatError $
         if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
+    opDomains <- operatorDomains . fst <$> withFastStore getServerOperators
+    rs <- asks randomServers
+    let smp = agentServerCfgs opDomains (rndServers SPSMP rs) smpServers
+        xftp = agentServerCfgs opDomains (rndServers SPXFTP rs) xftpServers
     auId <- withAgent (\a -> createUser a smp xftp)
     ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
     user <- withFastStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts
     createPresetContactCards user `catchChatError` \_ -> pure ()
-    withFastStore $ \db -> createNoteFolder db user
-    storeServers user smpServers
-    storeServers user xftpServers
+    withFastStore $ \db -> do
+      createNoteFolder db user
+      liftIO $ mapM_ (insertProtocolServer db SPSMP user ts) $ useServers SPSMP rs smpServers
+      liftIO $ mapM_ (insertProtocolServer db SPXFTP user ts) $ useServers SPXFTP rs xftpServers
     atomically . writeTVar u $ Just user
     pure $ CRActiveUser user
     where
@@ -577,18 +663,10 @@ processChatCommand' vr = \case
         withFastStore $ \db -> do
           createContact db user simplexStatusContactProfile
           createContact db user simplexTeamContactProfile
-      chooseServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> CM (NonEmpty (ServerCfg p), [ServerCfg p])
-      chooseServers protocol =
-        asks currentUser >>= readTVarIO >>= \case
-          Nothing -> asks config >>= liftIO . randomServers protocol
-          Just user -> chosenServers =<< withFastStore' (`getProtocolServers` user)
-        where
-          chosenServers servers = do
-            cfg <- asks config
-            pure (useServers cfg protocol servers, servers)
-      storeServers user servers =
-        unless (null servers) . withFastStore $
-          \db -> overwriteProtocolServers db user servers
+      chooseServers :: forall p. ProtocolTypeI p => SProtocolType p -> CM [UserServer p]
+      chooseServers p = do
+        srvs <- chatReadVar currentUser >>= mapM (\user -> withFastStore' $ \db -> getProtocolServers db p user)
+        pure $ fromMaybe [] srvs
       coupleDaysAgo t = (`addUTCTime` t) . fromInteger . negate . (+ (2 * day)) <$> randomRIO (0, day)
       day = 86400
   ListUsers -> CRUsersList <$> withFastStore' getUsersInfo
@@ -1486,57 +1564,67 @@ processChatCommand' vr = \case
     msgs <- lift $ withAgent' $ \a -> getConnectionMessages a acIds
     let ntfMsgs = L.map (\msg -> receivedMsgInfo <$> msg) msgs
     pure $ CRConnNtfMessages ntfMsgs
-  APIGetUserProtoServers userId (AProtocolType p) -> withUserId userId $ \user -> withServerProtocol p $ do
-    cfg@ChatConfig {defaultServers} <- asks config
-    srvs <- withFastStore' (`getProtocolServers` user)
-    (operators, _) <- withFastStore $ \db -> getServerOperators db
-    let servers = AUPS $ UserProtoServers p (useServers cfg p srvs) (cfgServers p defaultServers)
-    pure $ CRUserProtoServers {user, servers, operators}
-  GetUserProtoServers aProtocol -> withUser $ \User {userId} ->
-    processChatCommand $ APIGetUserProtoServers userId aProtocol
-  APISetUserProtoServers userId (APSC p (ProtoServersConfig servers))
-    | null servers || any (\ServerCfg {enabled} -> enabled) servers -> withUserId userId $ \user -> withServerProtocol p $ do
-        withFastStore $ \db -> overwriteProtocolServers db user servers
-        cfg <- asks config
-        lift $ withAgent' $ \a -> setProtocolServers a (aUserId user) $ useServers cfg p servers
-        ok user
-    | otherwise -> withUserId userId $ \user -> pure $ chatCmdError (Just user) "all servers are disabled"
-  SetUserProtoServers serversConfig -> withUser $ \User {userId} ->
-    processChatCommand $ APISetUserProtoServers userId serversConfig
+  GetUserProtoServers (AProtocolType p) -> withUser $ \user -> withServerProtocol p $ do
+    srvs <- withFastStore (`getUserServers` user)
+    CRUserServers user <$> liftIO (groupedServers srvs p)
+    where
+      groupedServers :: UserProtocol p => ([ServerOperator], [UserServer 'PSMP],  [UserServer 'PXFTP]) -> SProtocolType p -> IO [UserOperatorServers]
+      groupedServers (operators, smpServers, xftpServers) = \case
+        SPSMP -> groupByOperator (operators, smpServers, [])
+        SPXFTP -> groupByOperator (operators, [], xftpServers)
+  SetUserProtoServers (AProtocolType (p :: SProtocolType p)) srvs -> withUser $ \user@User {userId} -> withServerProtocol p $ do
+    srvs' <- mapM aUserServer srvs
+    userServers_ <- liftIO . groupByOperator =<< withFastStore (`getUserServers` user)
+    case L.nonEmpty userServers_ of
+      Nothing -> throwChatError $ CECommandError "no servers"
+      Just userServers -> case srvs of
+        [] -> throwChatError $ CECommandError "no servers"
+        _ -> processChatCommand $ APISetUserServers userId $ L.map (updatedSrvs p) userServers
+          where
+            -- disable preset and replace custom servers (groupByOperator always adds custom)
+            updatedSrvs :: UserProtocol p => SProtocolType p -> UserOperatorServers -> UpdatedUserOperatorServers
+            updatedSrvs p' UserOperatorServers {operator, smpServers, xftpServers} = case p' of
+              SPSMP -> u (updateSrvs smpServers, map (AUS SDBStored) xftpServers)
+              SPXFTP -> u (map (AUS SDBStored) smpServers, updateSrvs xftpServers)
+              where
+                u = uncurry $ UpdatedUserOperatorServers operator
+                updateSrvs :: [UserServer p] -> [AUserServer p]
+                updateSrvs pSrvs = map disableSrv pSrvs <> maybe srvs' (const []) operator
+                disableSrv srv@UserServer {preset} =
+                  AUS SDBStored $ if preset then srv {enabled = False} else srv {deleted = True}
+    where
+      aUserServer ::  AProtoServerWithAuth -> CM (AUserServer p)
+      aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of
+        Just Refl -> pure $ AUS SDBNew $ newUserServer srv
+        Nothing -> throwChatError $ CECommandError $ "incorrect server protocol: " <> B.unpack (strEncode srv)
   APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user ->
     lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a (aUserId user) server)
   TestProtoServer srv -> withUser $ \User {userId} ->
     processChatCommand $ APITestProtoServer userId srv
-  APIGetServerOperators -> do
-    (operators, conditionsAction) <- withFastStore $ \db -> getServerOperators db
-    pure $ CRServerOperators operators conditionsAction
-  APISetServerOperators operatorsEnabled -> do
-    (operators, conditionsAction) <- withFastStore $ \db -> setServerOperators db operatorsEnabled
-    pure $ CRServerOperators operators conditionsAction
-  APIGetUserServers userId -> withUserId userId $ \user -> do
-    (operators, smpServers, xftpServers) <- withFastStore $ \db -> do
-      (operators, _) <- getServerOperators db
-      smpServers <- liftIO $ getServers db user SPSMP
-      xftpServers <- liftIO $ getServers db user SPXFTP
-      pure (operators, smpServers, xftpServers)
-    let userServers = groupByOperator operators smpServers xftpServers
-    pure $ CRUserServers user userServers
-    where
-      getServers :: ProtocolTypeI p => DB.Connection -> User -> SProtocolType p -> IO [ServerCfg p]
-      getServers db user _p = getProtocolServers db user
+  APIGetServerOperators -> uncurry CRServerOperators <$> withFastStore getServerOperators
+  APISetServerOperators operatorsEnabled -> withFastStore $ \db -> do
+    liftIO $ setServerOperators db operatorsEnabled
+    uncurry CRServerOperators <$> getServerOperators db
+  APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db ->
+    CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user)
   APISetUserServers userId userServers -> withUserId userId $ \user -> do
     let errors = validateUserServers userServers
     unless (null errors) $ throwChatError (CECommandError $ "user servers validation error(s): " <> show errors)
-    withFastStore $ \db -> setUserServers db user userServers
-    -- TODO set protocol servers for agent
+    (operators, smpServers, xftpServers) <- withFastStore $ \db -> do
+      setUserServers db user userServers
+      getUserServers db user
+    let opDomains = operatorDomains operators
+    rs <- asks randomServers
+    lift $ withAgent' $ \a -> do
+      let auId = aUserId user
+      setProtocolServers a auId $ agentServerCfgs opDomains (rndServers SPSMP rs) smpServers
+      setProtocolServers a auId $ agentServerCfgs opDomains (rndServers SPXFTP rs) xftpServers
     ok_
-  APIValidateServers userServers -> do
-    let errors = validateUserServers userServers
-    pure $ CRUserServersValidation errors
+  APIValidateServers userServers -> pure $ CRUserServersValidation $ validateUserServers userServers
   APIGetUsageConditions -> do
     (usageConditions, acceptedConditions) <- withFastStore $ \db -> do
       usageConditions <- getCurrentUsageConditions db
-      acceptedConditions <- getLatestAcceptedConditions db
+      acceptedConditions <- liftIO $ getLatestAcceptedConditions db
       pure (usageConditions, acceptedConditions)
     -- TODO if db commit is different from source commit, conditionsText should be nothing in response
     pure
@@ -1545,14 +1633,14 @@ processChatCommand' vr = \case
           conditionsText = usageConditionsText,
           acceptedConditions
         }
-  APISetConditionsNotified conditionsId -> do
+  APISetConditionsNotified condId -> do
     currentTs <- liftIO getCurrentTime
-    withFastStore' $ \db -> setConditionsNotified db conditionsId currentTs
+    withFastStore' $ \db -> setConditionsNotified db condId currentTs
     ok_
-  APIAcceptConditions conditionsId operators -> do
+  APIAcceptConditions condId opIds -> withFastStore $ \db -> do
     currentTs <- liftIO getCurrentTime
-    (operators', conditionsAction) <- withFastStore $ \db -> acceptConditions db conditionsId operators currentTs
-    pure $ CRServerOperators operators' conditionsAction
+    acceptConditions db condId opIds currentTs
+    uncurry CRServerOperators <$> getServerOperators db
   APISetChatItemTTL userId newTTL_ -> withUserId userId $ \user ->
     checkStoreNotChanged $
       withChatLock "setChatItemTTL" $ do
@@ -1805,8 +1893,9 @@ processChatCommand' vr = \case
       canKeepLink (CRInvitationUri crData _) newUser = do
         let ConnReqUriData {crSmpQueues = q :| _} = crData
             SMPQueueUri {queueAddress = SMPQueueAddress {smpServer}} = q
-        cfg <- asks config
-        newUserServers <- L.map (\ServerCfg {server} -> protoServer server) . useServers cfg SPSMP <$> withFastStore' (`getProtocolServers` newUser)
+        newUserServers <- 
+          map protoServer' . filter (\ServerCfg {enabled} -> enabled)
+            <$> getKnownAgentServers SPSMP newUser
         pure $ smpServer `elem` newUserServers
       updateConnRecord user@User {userId} conn@PendingContactConnection {customUserProfileId} newUser = do
         withAgent $ \a -> changeConnectionUser a (aUserId user) (aConnId' conn) (aUserId newUser)
@@ -2140,7 +2229,7 @@ processChatCommand' vr = \case
     where
       changeMemberRole user gInfo members m gEvent = do
         let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m
-        assertUserGroupRole gInfo $ maximum [GRAdmin, mRole, memRole]
+        assertUserGroupRole gInfo $ maximum ([GRAdmin, mRole, memRole] :: [GroupMemberRole])
         withGroupLock "memberRole" groupId . procCmd $ do
           unless (mRole == memRole) $ do
             withFastStore' $ \db -> updateGroupMemberRole db user m memRole
@@ -2538,14 +2627,15 @@ processChatCommand' vr = \case
     pure $ CRAgentSubsTotal user subsTotal hasSession
   GetAgentServersSummary userId -> withUserId userId $ \user -> do
     agentServersSummary <- lift $ withAgent' getAgentServersSummary
-    cfg <- asks config
-    (users, smpServers, xftpServers) <-
-      withStore' $ \db -> (,,) <$> getUsers db <*> getServers db cfg user SPSMP <*> getServers db cfg user SPXFTP
-    let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers _defaultNtfServers
-    pure $ CRAgentServersSummary user presentedServersSummary
+    withStore' $ \db -> do
+      users <- getUsers db
+      smpServers <- getServers db user SPSMP
+      xftpServers <- getServers db user SPXFTP
+      let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers _defaultNtfServers
+      pure $ CRAgentServersSummary user presentedServersSummary
     where
-      getServers :: (ProtocolTypeI p, UserProtocol p) => DB.Connection -> ChatConfig -> User -> SProtocolType p -> IO (NonEmpty (ProtocolServer p))
-      getServers db cfg user p = L.map (\ServerCfg {server} -> protoServer server) . useServers cfg p <$> getProtocolServers db user
+      getServers :: ProtocolTypeI p => DB.Connection -> User -> SProtocolType p -> IO [ProtocolServer p]
+      getServers db user p = map (\UserServer {server} -> protoServer server) <$> getProtocolServers db p user
   ResetAgentServersStats -> withAgent resetAgentServersStats >> ok_
   GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary
   GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails
@@ -3663,8 +3753,7 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
       S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks
     getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer]
     getUnknownSrvs srvs = do
-      cfg <- asks config
-      knownSrvs <- L.map (\ServerCfg {server} -> protoServer server) . useServers cfg SPXFTP <$> withStore' (`getProtocolServers` user)
+      knownSrvs <- map protoServer' <$> getKnownAgentServers SPXFTP user
       pure $ filter (`notElem` knownSrvs) srvs
     ipProtectedForSrvs :: [XFTPServer] -> CM Bool
     ipProtectedForSrvs srvs = do
@@ -3678,6 +3767,17 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
         toView $ CRChatItemUpdated user aci
       throwChatError $ CEFileNotApproved fileId unknownSrvs
 
+getKnownAgentServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> User -> CM [ServerCfg p]
+getKnownAgentServers p user = do
+  rs <- asks randomServers
+  withStore $ \db -> do
+    opDomains <- operatorDomains . fst <$> getServerOperators db
+    srvs <- liftIO $ getProtocolServers db p user
+    pure $ L.toList $ agentServerCfgs opDomains (rndServers p rs) srvs
+
+protoServer' :: ServerCfg p -> ProtocolServer p
+protoServer' ServerCfg {server} = protoServer server
+
 getNetworkConfig :: CM' NetworkConfig
 getNetworkConfig = withAgent' $ liftIO . getFastNetworkConfig
 
@@ -3876,7 +3976,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
         (sftConns, sfts) <- getSndFileTransferConns
         (rftConns, rfts) <- getRcvFileTransferConns
         (pcConns, pcs) <- getPendingContactConns
-        let conns = concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns]
+        let conns = concat ([ctConns, ucConns, mConns, sftConns, rftConns, pcConns] :: [[ConnId]])
         pure (conns, cts, ucs, gs, ms, sfts, rfts, pcs)
   -- subscribe using batched commands
   rs <- withAgent $ \a -> agentBatchSubscribe a conns
@@ -4684,7 +4784,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct)
         SWITCH qd phase cStats -> do
           toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats)
-          when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
+          when (phase == SPStarted || phase == SPCompleted) $ case qd of
             QDRcv -> createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCESwitchQueue phase Nothing) Nothing
             QDSnd -> createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
         RSYNC rss cryptoErr_ cStats ->
@@ -4969,7 +5069,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                           (Just fileDescrText, Just msgId) -> do
                             partSize <- asks $ xftpDescrPartSize . config
                             let parts = splitFileDescr partSize fileDescrText
-                            pure . toList $ L.map (XMsgFileDescr msgId) parts
+                            pure . L.toList $ L.map (XMsgFileDescr msgId) parts
                           _ -> pure []
                         let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
                             GroupMember {memberId} = sender
@@ -5095,7 +5195,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         when continued $ sendPendingGroupMessages user m conn
       SWITCH qd phase cStats -> do
         toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
-        when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
+        when (phase == SPStarted || phase == SPCompleted) $ case qd of
           QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing
           QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
       RSYNC rss cryptoErr_ cStats ->
@@ -6659,15 +6759,17 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           messageWarning "x.grp.mem.con: neither member is invitee"
       where
         inviteeXGrpMemCon :: GroupMemberIntro -> CM ()
-        inviteeXGrpMemCon GroupMemberIntro {introId, introStatus}
-          | introStatus == GMIntroReConnected = updateStatus introId GMIntroConnected
-          | introStatus `elem` [GMIntroToConnected, GMIntroConnected] = pure ()
-          | otherwise = updateStatus introId GMIntroToConnected
+        inviteeXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of
+          GMIntroReConnected -> updateStatus introId GMIntroConnected
+          GMIntroToConnected -> pure ()
+          GMIntroConnected -> pure ()
+          _ -> updateStatus introId GMIntroToConnected
         forwardMemberXGrpMemCon :: GroupMemberIntro -> CM ()
-        forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus}
-          | introStatus == GMIntroToConnected = updateStatus introId GMIntroConnected
-          | introStatus `elem` [GMIntroReConnected, GMIntroConnected] = pure ()
-          | otherwise = updateStatus introId GMIntroReConnected
+        forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of
+          GMIntroToConnected -> updateStatus introId GMIntroConnected
+          GMIntroReConnected -> pure ()
+          GMIntroConnected -> pure ()
+          _ -> updateStatus introId GMIntroReConnected
         updateStatus introId status = withStore' $ \db -> updateIntroStatus db introId status
 
     xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> CM ()
@@ -8132,22 +8234,18 @@ chatCommandP =
       "/smp test " *> (TestProtoServer . AProtoServerWithAuth SPSMP <$> strP),
       "/xftp test " *> (TestProtoServer . AProtoServerWithAuth SPXFTP <$> strP),
       "/ntf test " *> (TestProtoServer . AProtoServerWithAuth SPNTF <$> strP),
-      "/_servers " *> (APISetUserProtoServers <$> A.decimal <* A.space <*> srvCfgP),
-      "/smp " *> (SetUserProtoServers . APSC SPSMP . ProtoServersConfig . map enabledServerCfg <$> protocolServersP),
-      "/smp default" $> SetUserProtoServers (APSC SPSMP $ ProtoServersConfig []),
-      "/xftp " *> (SetUserProtoServers . APSC SPXFTP . ProtoServersConfig . map enabledServerCfg <$> protocolServersP),
-      "/xftp default" $> SetUserProtoServers (APSC SPXFTP $ ProtoServersConfig []),
-      "/_servers " *> (APIGetUserProtoServers <$> A.decimal <* A.space <*> strP),
+      "/smp " *> (SetUserProtoServers (AProtocolType SPSMP) . map (AProtoServerWithAuth SPSMP) <$> protocolServersP),
+      "/xftp " *> (SetUserProtoServers (AProtocolType SPXFTP) . map (AProtoServerWithAuth SPXFTP) <$> protocolServersP),
       "/smp" $> GetUserProtoServers (AProtocolType SPSMP),
       "/xftp" $> GetUserProtoServers (AProtocolType SPXFTP),
       "/_operators" $> APIGetServerOperators,
       "/_operators " *> (APISetServerOperators <$> jsonP),
-      "/_user_servers " *> (APIGetUserServers <$> A.decimal),
-      "/_user_servers " *> (APISetUserServers <$> A.decimal <* A.space <*> jsonP),
+      "/_servers " *> (APIGetUserServers <$> A.decimal),
+      "/_servers " *> (APISetUserServers <$> A.decimal <* A.space <*> jsonP),
       "/_validate_servers " *> (APIValidateServers <$> jsonP),
       "/_conditions" $> APIGetUsageConditions,
       "/_conditions_notified " *> (APISetConditionsNotified <$> A.decimal),
-      "/_accept_conditions " *> (APIAcceptConditions <$> A.decimal <* A.space <*> jsonP),
+      "/_accept_conditions " *> (APIAcceptConditions <$> A.decimal <*> _strP),
       "/_ttl " *> (APISetChatItemTTL <$> A.decimal <* A.space <*> ciTTLDecimal),
       "/ttl " *> (SetChatItemTTL <$> ciTTL),
       "/_ttl " *> (APIGetChatItemTTL <$> A.decimal),
@@ -8491,7 +8589,6 @@ chatCommandP =
         onOffP
         (Just <$> (AutoAccept <$> (" incognito=" *> onOffP <|> pure False) <*> optional (A.space *> msgContentP)))
         (pure Nothing)
-    srvCfgP = strP >>= \case AProtocolType p -> APSC p <$> (A.space *> jsonP)
     rcCtrlAddressP = RCCtrlAddress <$> ("addr=" *> strP) <*> (" iface=" *> (jsonP <|> text1P))
     text1P = safeDecodeUtf8 <$> A.takeTill (== ' ')
     char_ = optional . A.char

src/Simplex/Chat/Controller.hs

@@ -35,7 +35,6 @@ import qualified Data.ByteArray as BA
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (ord)
-import Data.Constraint (Dict (..))
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
@@ -71,7 +70,7 @@ import Simplex.Chat.Util (liftIOEither)
 import Simplex.FileTransfer.Description (FileDescriptionURI)
 import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
 import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, SMPServerSubs, ServerQueueInfo, UserNetworkInfo)
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerCfg)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
 import Simplex.Messaging.Agent.Lock
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction, withTransactionPriority)
@@ -85,7 +84,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgId, NMsgMeta (..), NtfServer, ProtocolType (..), ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgId, NMsgMeta (..), NtfServer, ProtocolType (..), QueueId, SMPMsgMeta (..), SubscriptionMode (..), XFTPServer)
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (TLS, simplexMQVersion)
 import Simplex.Messaging.Transport.Client (SocksProxyWithAuth, TransportHost)
@@ -133,7 +132,7 @@ data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,
     chatVRange :: VersionRangeChat,
     confirmMigrations :: MigrationConfirmation,
-    defaultServers :: DefaultAgentServers,
+    presetServers :: PresetServers,
     tbqSize :: Natural,
     fileChunkSize :: Integer,
     xftpDescrPartSize :: Int,
@@ -155,6 +154,12 @@ data ChatConfig = ChatConfig
     chatHooks :: ChatHooks
   }
 
+data RandomServers = RandomServers
+  { smpServers :: NonEmpty (NewUserServer 'PSMP),
+    xftpServers :: NonEmpty (NewUserServer 'PXFTP)
+  }
+  deriving (Show)
+
 -- The hooks can be used to extend or customize chat core in mobile or CLI clients.
 data ChatHooks = ChatHooks
   { -- preCmdHook can be used to process or modify the commands before they are processed.
@@ -173,12 +178,9 @@ defaultChatHooks =
       eventHook = \_ -> pure
     }
 
-data DefaultAgentServers = DefaultAgentServers
-  { smp :: NonEmpty (ServerCfg 'PSMP),
-    useSMP :: Int,
+data PresetServers = PresetServers
+  { operators :: NonEmpty PresetOperator,
     ntf :: [NtfServer],
-    xftp :: NonEmpty (ServerCfg 'PXFTP),
-    useXFTP :: Int,
     netCfg :: NetworkConfig
   }
 
@@ -204,6 +206,7 @@ data ChatDatabase = ChatDatabase {chatStore :: SQLiteStore, agentStore :: SQLite
 
 data ChatController = ChatController
   { currentUser :: TVar (Maybe User),
+    randomServers :: RandomServers,
     currentRemoteHost :: TVar (Maybe RemoteHostId),
     firstTime :: Bool,
     smpAgent :: AgentClient,
@@ -347,20 +350,18 @@ data ChatCommand
   | APIGetGroupLink GroupId
   | APICreateMemberContact GroupId GroupMemberId
   | APISendMemberContactInvitation {contactId :: ContactId, msgContent_ :: Maybe MsgContent}
-  | APIGetUserProtoServers UserId AProtocolType
   | GetUserProtoServers AProtocolType
-  | APISetUserProtoServers UserId AProtoServersConfig
-  | SetUserProtoServers AProtoServersConfig
+  | SetUserProtoServers AProtocolType [AProtoServerWithAuth]
   | APITestProtoServer UserId AProtoServerWithAuth
   | TestProtoServer AProtoServerWithAuth
   | APIGetServerOperators
-  | APISetServerOperators (NonEmpty OperatorEnabled)
+  | APISetServerOperators (NonEmpty ServerOperator)
   | APIGetUserServers UserId
-  | APISetUserServers UserId (NonEmpty UserServers)
-  | APIValidateServers (NonEmpty UserServers) -- response is CRUserServersValidation
+  | APISetUserServers UserId (NonEmpty UpdatedUserOperatorServers)
+  | APIValidateServers (NonEmpty UpdatedUserOperatorServers) -- response is CRUserServersValidation
   | APIGetUsageConditions
   | APISetConditionsNotified Int64
-  | APIAcceptConditions Int64 (NonEmpty ServerOperator)
+  | APIAcceptConditions Int64 (NonEmpty Int64)
   | APISetChatItemTTL UserId (Maybe Int64)
   | SetChatItemTTL (Maybe Int64)
   | APIGetChatItemTTL UserId
@@ -586,10 +587,9 @@ data ChatResponse
   | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
   | CRChatItemId User (Maybe ChatItemId)
   | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
-  | CRUserProtoServers {user :: User, servers :: AUserProtoServers, operators :: [ServerOperator]}
   | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
   | CRServerOperators {operators :: [ServerOperator], conditionsAction :: Maybe UsageConditionsAction}
-  | CRUserServers {user :: User, userServers :: [UserServers]}
+  | CRUserServers {user :: User, userServers :: [UserOperatorServers]}
   | CRUserServersValidation {serverErrors :: [UserServersError]}
   | CRUsageConditions {usageConditions :: UsageConditions, conditionsText :: Text, acceptedConditions :: Maybe UsageConditions}
   | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
@@ -956,23 +956,23 @@ instance ToJSON AgentQueueId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
-data ProtoServersConfig p = ProtoServersConfig {servers :: [ServerCfg p]}
-  deriving (Show)
+-- data ProtoServersConfig p = ProtoServersConfig {servers :: [ServerCfg p]}
+--   deriving (Show)
 
-data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (ProtoServersConfig p)
+-- data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (ProtoServersConfig p)
 
-deriving instance Show AProtoServersConfig
+-- deriving instance Show AProtoServersConfig
 
-data UserProtoServers p = UserProtoServers
-  { serverProtocol :: SProtocolType p,
-    protoServers :: NonEmpty (ServerCfg p),
-    presetServers :: NonEmpty (ServerCfg p)
-  }
-  deriving (Show)
+-- data UserProtoServers p = UserProtoServers
+--   { serverProtocol :: SProtocolType p,
+--     protoServers :: NonEmpty (ServerCfg p),
+--     presetServers :: NonEmpty (ServerCfg p)
+--   }
+--   deriving (Show)
 
-data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
+-- data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
 
-deriving instance Show AUserProtoServers
+-- deriving instance Show AUserProtoServers
 
 data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
   deriving (Show)
@@ -1575,28 +1575,28 @@ $(JQ.deriveJSON defaultJSON ''CoreVersionInfo)
 
 $(JQ.deriveJSON defaultJSON ''SlowSQLQuery)
 
-instance ProtocolTypeI p => FromJSON (ProtoServersConfig p) where
-  parseJSON = $(JQ.mkParseJSON defaultJSON ''ProtoServersConfig)
+-- instance ProtocolTypeI p => FromJSON (ProtoServersConfig p) where
+--   parseJSON = $(JQ.mkParseJSON defaultJSON ''ProtoServersConfig)
 
-instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
-  parseJSON = $(JQ.mkParseJSON defaultJSON ''UserProtoServers)
+-- instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
+--   parseJSON = $(JQ.mkParseJSON defaultJSON ''UserProtoServers)
 
-instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
-  toJSON = $(JQ.mkToJSON defaultJSON ''UserProtoServers)
-  toEncoding = $(JQ.mkToEncoding defaultJSON ''UserProtoServers)
+-- instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
+--   toJSON = $(JQ.mkToJSON defaultJSON ''UserProtoServers)
+--   toEncoding = $(JQ.mkToEncoding defaultJSON ''UserProtoServers)
 
-instance FromJSON AUserProtoServers where
-  parseJSON v = J.withObject "AUserProtoServers" parse v
-    where
-      parse o = do
-        AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
-        case userProtocol p of
-          Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
-          Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
+-- instance FromJSON AUserProtoServers where
+--   parseJSON v = J.withObject "AUserProtoServers" parse v
+--     where
+--       parse o = do
+--         AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
+--         case userProtocol p of
+--           Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
+--           Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
 
-instance ToJSON AUserProtoServers where
-  toJSON (AUPS s) = $(JQ.mkToJSON defaultJSON ''UserProtoServers) s
-  toEncoding (AUPS s) = $(JQ.mkToEncoding defaultJSON ''UserProtoServers) s
+-- instance ToJSON AUserProtoServers where
+--   toJSON (AUPS s) = $(JQ.mkToJSON defaultJSON ''UserProtoServers) s
+--   toEncoding (AUPS s) = $(JQ.mkToEncoding defaultJSON ''UserProtoServers) s
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCS") ''RemoteCtrlSessionState)
 

src/Simplex/Chat/Migrations/M20241027_server_operators.hs

@@ -11,7 +11,6 @@ m20241027_server_operators =
 CREATE TABLE server_operators (
   server_operator_id INTEGER PRIMARY KEY AUTOINCREMENT,
   server_operator_tag TEXT,
-  app_vendor INTEGER NOT NULL,
   trade_name TEXT NOT NULL,
   legal_name TEXT,
   server_domains TEXT,
@@ -22,8 +21,6 @@ CREATE TABLE server_operators (
   updated_at TEXT NOT NULL DEFAULT (datetime('now'))
 );
 
-ALTER TABLE protocol_servers ADD COLUMN server_operator_id INTEGER REFERENCES server_operators ON DELETE SET NULL;
-
 CREATE TABLE usage_conditions (
   usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
   conditions_commit TEXT NOT NULL UNIQUE,
@@ -41,18 +38,8 @@ CREATE TABLE operator_usage_conditions (
   created_at TEXT NOT NULL DEFAULT (datetime('now'))
 );
 
-CREATE INDEX idx_protocol_servers_server_operator_id ON protocol_servers(server_operator_id);
 CREATE INDEX idx_operator_usage_conditions_server_operator_id ON operator_usage_conditions(server_operator_id);
-CREATE UNIQUE INDEX idx_operator_usage_conditions_conditions_commit ON operator_usage_conditions(server_operator_id, conditions_commit);
-
-INSERT INTO server_operators
-  (server_operator_id, server_operator_tag, app_vendor, trade_name, legal_name, server_domains, enabled)
-  VALUES (1, 'simplex', 1, 'SimpleX Chat', 'SimpleX Chat Ltd', 'simplex.im', 1);
-INSERT INTO server_operators
-  (server_operator_id, server_operator_tag, app_vendor, trade_name, legal_name, server_domains, enabled)
-  VALUES (2, 'xyz', 0, 'XYZ', 'XYZ Ltd', 'xyz.com', 0);
-
--- UPDATE protocol_servers SET server_operator_id = 1 WHERE host LIKE "%.simplex.im" OR host LIKE "%.simplex.im,%";
+CREATE UNIQUE INDEX idx_operator_usage_conditions_conditions_commit ON operator_usage_conditions(conditions_commit, server_operator_id);
 |]
 
 down_m20241027_server_operators :: Query
@@ -60,9 +47,6 @@ down_m20241027_server_operators =
   [sql|
 DROP INDEX idx_operator_usage_conditions_conditions_commit;
 DROP INDEX idx_operator_usage_conditions_server_operator_id;
-DROP INDEX idx_protocol_servers_server_operator_id;
-
-ALTER TABLE protocol_servers DROP COLUMN server_operator_id;
 
 DROP TABLE operator_usage_conditions;
 DROP TABLE usage_conditions;

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -450,7 +450,6 @@ CREATE TABLE IF NOT EXISTS "protocol_servers"(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now')),
   protocol TEXT NOT NULL DEFAULT 'smp',
-  server_operator_id INTEGER REFERENCES server_operators ON DELETE SET NULL,
   UNIQUE(user_id, host, port)
 );
 CREATE TABLE xftp_file_descriptions(
@@ -593,7 +592,6 @@ CREATE TABLE app_settings(app_settings TEXT NOT NULL);
 CREATE TABLE server_operators(
   server_operator_id INTEGER PRIMARY KEY AUTOINCREMENT,
   server_operator_tag TEXT,
-  app_vendor INTEGER NOT NULL,
   trade_name TEXT NOT NULL,
   legal_name TEXT,
   server_domains TEXT,
@@ -919,13 +917,10 @@ CREATE INDEX idx_received_probes_group_member_id on received_probes(
   group_member_id
 );
 CREATE INDEX idx_contact_requests_contact_id ON contact_requests(contact_id);
-CREATE INDEX idx_protocol_servers_server_operator_id ON protocol_servers(
-  server_operator_id
-);
 CREATE INDEX idx_operator_usage_conditions_server_operator_id ON operator_usage_conditions(
   server_operator_id
 );
 CREATE UNIQUE INDEX idx_operator_usage_conditions_conditions_commit ON operator_usage_conditions(
-  server_operator_id,
-  conditions_commit
+  conditions_commit,
+  server_operator_id
 );

src/Simplex/Chat/Operators.hs

@@ -1,24 +1,42 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Chat.Operators where
 
+import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as JQ
 import Data.FileEmbed
+import Data.Foldable (foldMap')
+import Data.IORef
 import Data.Int (Int64)
+import Data.List (find, foldl')
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isNothing)
+import Data.Maybe (fromMaybe, isNothing, mapMaybe)
+import Data.Scientific (floatingOrInteger)
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Time (addUTCTime)
 import Data.Time.Clock (UTCTime, nominalDay)
 import Database.SQLite.Simple.FromField (FromField (..))
@@ -26,23 +44,51 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import Language.Haskell.TH.Syntax (lift)
 import Simplex.Chat.Operators.Conditions
 import Simplex.Chat.Types.Util (textParseJSON)
-import Simplex.Messaging.Agent.Env.SQLite (OperatorId, ServerCfg (..), ServerRoles (..))
+import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTypeJSON)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), SProtocolType (..))
-import Simplex.Messaging.Util (safeDecodeUtf8)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, SProtocolType (..), UserProtocol)
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+import Simplex.Messaging.Util (atomicModifyIORef'_, safeDecodeUtf8)
 
 usageConditionsCommit :: Text
-usageConditionsCommit = "165143a1112308c035ac00ed669b96b60599aa1c"
+usageConditionsCommit = "a5061f3147165a05979d6ace33960aced2d6ac03"
+
+previousConditionsCommit :: Text
+previousConditionsCommit = "11a44dc1fd461a93079f897048b46998db55da5c"
 
 usageConditionsText :: Text
 usageConditionsText =
   $( let s = $(embedFile =<< makeRelativeToProject "PRIVACY.md")
-      in [|stripFrontMatter (safeDecodeUtf8 $(lift s))|]
+      in [|stripFrontMatter $(lift (safeDecodeUtf8 s))|]
    )
 
-data OperatorTag = OTSimplex | OTXyz
-  deriving (Show)
+data DBStored = DBStored | DBNew
+
+data SDBStored (s :: DBStored) where
+  SDBStored :: SDBStored 'DBStored
+  SDBNew :: SDBStored 'DBNew
+
+deriving instance Show (SDBStored s)
+
+class DBStoredI s where sdbStored :: SDBStored s
+
+instance DBStoredI 'DBStored where sdbStored = SDBStored
+
+instance DBStoredI 'DBNew where sdbStored = SDBNew
+
+data DBEntityId' (s :: DBStored) where
+  DBEntityId :: Int64 -> DBEntityId' 'DBStored
+  DBNewEntity :: DBEntityId' 'DBNew
+
+deriving instance Show (DBEntityId' s)
+
+type DBEntityId = DBEntityId' 'DBStored
+
+type DBNewEntity = DBEntityId' 'DBNew
+
+data OperatorTag = OTSimplex | OTFlux
+  deriving (Eq, Ord, Show)
 
 instance FromField OperatorTag where fromField = fromTextField_ textDecode
 
@@ -58,11 +104,17 @@ instance ToJSON OperatorTag where
 instance TextEncoding OperatorTag where
   textDecode = \case
     "simplex" -> Just OTSimplex
-    "xyz" -> Just OTXyz
+    "flux" -> Just OTFlux
     _ -> Nothing
   textEncode = \case
     OTSimplex -> "simplex"
-    OTXyz -> "xyz"
+    OTFlux -> "flux"
+
+-- this and other types only define instances of serialization for known DB IDs only,
+-- entities without IDs cannot be serialized to JSON
+instance FromField DBEntityId where fromField f = DBEntityId <$> fromField f
+
+instance ToField DBEntityId where toField (DBEntityId i) = toField i
 
 data UsageConditions = UsageConditions
   { conditionsId :: Int64,
@@ -80,18 +132,16 @@ data UsageConditionsAction
 usageConditionsAction :: [ServerOperator] -> UsageConditions -> UTCTime -> Maybe UsageConditionsAction
 usageConditionsAction operators UsageConditions {createdAt, notifiedAt} now = do
   let enabledOperators = filter (\ServerOperator {enabled} -> enabled) operators
-  if null enabledOperators
-    then Nothing
-    else
-      if all conditionsAccepted enabledOperators
-        then
-          let acceptedForOperators = filter conditionsAccepted operators
-           in Just $ UCAAccepted acceptedForOperators
-        else
-          let acceptForOperators = filter (not . conditionsAccepted) enabledOperators
-              deadline = conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
-              showNotice = isNothing notifiedAt
-           in Just $ UCAReview acceptForOperators deadline showNotice
+  if
+    | null enabledOperators -> Nothing
+    | all conditionsAccepted enabledOperators ->
+        let acceptedForOperators = filter conditionsAccepted operators
+         in Just $ UCAAccepted acceptedForOperators
+    | otherwise ->
+        let acceptForOperators = filter (not . conditionsAccepted) enabledOperators
+            deadline = conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
+            showNotice = isNothing notifiedAt
+         in Just $ UCAReview acceptForOperators deadline showNotice
 
 conditionsRequiredOrDeadline :: UTCTime -> UTCTime -> Maybe UTCTime
 conditionsRequiredOrDeadline createdAt notifiedAtOrNow =
@@ -107,8 +157,16 @@ data ConditionsAcceptance
   | CARequired {deadline :: Maybe UTCTime}
   deriving (Show)
 
-data ServerOperator = ServerOperator
-  { operatorId :: OperatorId,
+type ServerOperator = ServerOperator' 'DBStored
+
+type NewServerOperator = ServerOperator' 'DBNew
+
+data AServerOperator = forall s. ASO (SDBStored s) (ServerOperator' s)
+
+deriving instance Show AServerOperator
+
+data ServerOperator' s = ServerOperator
+  { operatorId :: DBEntityId' s,
     operatorTag :: Maybe OperatorTag,
     tradeName :: Text,
     legalName :: Maybe Text,
@@ -124,81 +182,257 @@ conditionsAccepted ServerOperator {conditionsAcceptance} = case conditionsAccept
   CAAccepted {} -> True
   _ -> False
 
-data OperatorEnabled = OperatorEnabled
-  { operatorId :: OperatorId,
-    enabled :: Bool,
-    roles :: ServerRoles
-  }
-  deriving (Show)
-
-data UserServers = UserServers
+data UserOperatorServers = UserOperatorServers
   { operator :: Maybe ServerOperator,
-    smpServers :: [ServerCfg 'PSMP],
-    xftpServers :: [ServerCfg 'PXFTP]
+    smpServers :: [UserServer 'PSMP],
+    xftpServers :: [UserServer 'PXFTP]
   }
   deriving (Show)
 
-groupByOperator :: [ServerOperator] -> [ServerCfg 'PSMP] -> [ServerCfg 'PXFTP] -> [UserServers]
-groupByOperator srvOperators smpSrvs xftpSrvs =
-  map createOperatorServers (M.toList combinedMap)
+data UpdatedUserOperatorServers = UpdatedUserOperatorServers
+  { operator :: Maybe ServerOperator,
+    smpServers :: [AUserServer 'PSMP],
+    xftpServers :: [AUserServer 'PXFTP]
+  }
+  deriving (Show)
+
+updatedServers :: UserProtocol p => UpdatedUserOperatorServers -> SProtocolType p -> [AUserServer p]
+updatedServers UpdatedUserOperatorServers {smpServers, xftpServers} = \case
+  SPSMP -> smpServers
+  SPXFTP -> xftpServers
+
+type UserServer p = UserServer' 'DBStored p
+
+type NewUserServer p = UserServer' 'DBNew p
+
+data AUserServer p = forall s. AUS (SDBStored s) (UserServer' s p)
+
+deriving instance Show (AUserServer p)
+
+data UserServer' s p = UserServer
+  { serverId :: DBEntityId' s,
+    server :: ProtoServerWithAuth p,
+    preset :: Bool,
+    tested :: Maybe Bool,
+    enabled :: Bool,
+    deleted :: Bool
+  }
+  deriving (Show)
+
+data PresetOperator = PresetOperator
+  { operator :: Maybe NewServerOperator,
+    smp :: [NewUserServer 'PSMP],
+    useSMP :: Int,
+    xftp :: [NewUserServer 'PXFTP],
+    useXFTP :: Int
+  }
+
+operatorServers :: UserProtocol p => SProtocolType p -> PresetOperator -> [NewUserServer p]
+operatorServers p PresetOperator {smp, xftp} = case p of
+  SPSMP -> smp
+  SPXFTP -> xftp
+
+operatorServersToUse :: UserProtocol p => SProtocolType p -> PresetOperator -> Int
+operatorServersToUse p PresetOperator {useSMP, useXFTP} = case p of
+  SPSMP -> useSMP
+  SPXFTP -> useXFTP
+
+presetServer :: Bool -> ProtoServerWithAuth p -> NewUserServer p
+presetServer = newUserServer_ True
+
+newUserServer :: ProtoServerWithAuth p -> NewUserServer p
+newUserServer = newUserServer_ False True
+
+newUserServer_ :: Bool -> Bool -> ProtoServerWithAuth p -> NewUserServer p
+newUserServer_ preset enabled server =
+  UserServer {serverId = DBNewEntity, server, preset, tested = Nothing, enabled, deleted = False}
+
+-- This function should be used inside DB transaction to update conditions in the database
+-- it evaluates to (conditions to mark as accepted to SimpleX operator, current conditions, and conditions to add)
+usageConditionsToAdd :: Bool -> UTCTime -> [UsageConditions] -> (Maybe UsageConditions, UsageConditions, [UsageConditions])
+usageConditionsToAdd = usageConditionsToAdd' previousConditionsCommit usageConditionsCommit
+
+-- This function is used in unit tests
+usageConditionsToAdd' :: Text -> Text -> Bool -> UTCTime -> [UsageConditions] -> (Maybe UsageConditions, UsageConditions, [UsageConditions])
+usageConditionsToAdd' prevCommit sourceCommit newUser createdAt = \case
+  []
+    | newUser -> (Just sourceCond, sourceCond, [sourceCond])
+    | otherwise -> (Just prevCond, sourceCond, [prevCond, sourceCond])
+    where
+      prevCond = conditions 1 prevCommit
+      sourceCond = conditions 2 sourceCommit
+  conds
+    | hasSourceCond -> (Nothing, last conds, [])
+    | otherwise -> (Nothing, sourceCond, [sourceCond])
+    where
+      hasSourceCond = any ((sourceCommit ==) . conditionsCommit) conds
+      sourceCond = conditions cId sourceCommit
+      cId = maximum (map conditionsId conds) + 1
   where
-    srvOperatorId ServerCfg {operator} = operator
-    opId ServerOperator {operatorId} = operatorId
-    operatorMap :: Map (Maybe Int64) (Maybe ServerOperator)
-    operatorMap = M.fromList [(Just (opId op), Just op) | op <- srvOperators] `M.union` M.singleton Nothing Nothing
-    initialMap :: Map (Maybe Int64) ([ServerCfg 'PSMP], [ServerCfg 'PXFTP])
-    initialMap = M.fromList [(key, ([], [])) | key <- M.keys operatorMap]
-    smpsMap = foldr (\server acc -> M.adjust (\(smps, xftps) -> (server : smps, xftps)) (srvOperatorId server) acc) initialMap smpSrvs
-    combinedMap = foldr (\server acc -> M.adjust (\(smps, xftps) -> (smps, server : xftps)) (srvOperatorId server) acc) smpsMap xftpSrvs
-    createOperatorServers (key, (groupedSmps, groupedXftps)) =
-      UserServers
-        { operator = fromMaybe Nothing (M.lookup key operatorMap),
-          smpServers = groupedSmps,
-          xftpServers = groupedXftps
-        }
+    conditions cId commit = UsageConditions {conditionsId = cId, conditionsCommit = commit, notifiedAt = Nothing, createdAt}
+
+-- This function should be used inside DB transaction to update operators.
+-- It allows to add/remove/update preset operators in the database preserving enabled and roles settings,
+-- and preserves custom operators without tags for forward compatibility.
+updatedServerOperators :: NonEmpty PresetOperator -> [ServerOperator] -> [AServerOperator]
+updatedServerOperators presetOps storedOps =
+  foldr addPreset [] presetOps
+    <> map (ASO SDBStored) (filter (isNothing . operatorTag) storedOps)
+  where
+    -- TODO remove domains of preset operators from custom
+    addPreset PresetOperator {operator} = case operator of
+      Nothing -> id
+      Just presetOp -> (storedOp' :)
+        where
+          storedOp' = case find ((operatorTag presetOp ==) . operatorTag) storedOps of
+            Just ServerOperator {operatorId, conditionsAcceptance, enabled, roles} ->
+              ASO SDBStored presetOp {operatorId, conditionsAcceptance, enabled, roles}
+            Nothing -> ASO SDBNew presetOp
+
+-- This function should be used inside DB transaction to update servers.
+updatedUserServers :: forall p. UserProtocol p => SProtocolType p -> NonEmpty PresetOperator -> NonEmpty (NewUserServer p) -> [UserServer p] -> NonEmpty (AUserServer p)
+updatedUserServers _ _ randomSrvs [] = L.map (AUS SDBNew) randomSrvs
+updatedUserServers p presetOps randomSrvs srvs = 
+  fromMaybe (L.map (AUS SDBNew) randomSrvs) (L.nonEmpty updatedSrvs)
+  where
+    updatedSrvs = map userServer presetSrvs <> map (AUS SDBStored) (filter customServer srvs)
+    storedSrvs :: Map (ProtoServerWithAuth p) (UserServer p)
+    storedSrvs = foldl' (\ss srv@UserServer {server} -> M.insert server srv ss) M.empty srvs
+    customServer :: UserServer p -> Bool
+    customServer srv = not (preset srv) && all (`S.notMember` presetHosts) (srvHost srv)
+    presetSrvs :: [NewUserServer p]
+    presetSrvs = concatMap (operatorServers p) presetOps
+    presetHosts :: Set TransportHost
+    presetHosts = foldMap' (S.fromList . L.toList . srvHost) presetSrvs
+    userServer :: NewUserServer p -> AUserServer p
+    userServer srv@UserServer {server} = maybe (AUS SDBNew srv) (AUS SDBStored) (M.lookup server storedSrvs)
+
+srvHost :: UserServer' s p -> NonEmpty TransportHost
+srvHost UserServer {server = ProtoServerWithAuth srv _} = host srv
+
+agentServerCfgs :: [(Text, ServerOperator)] -> NonEmpty (NewUserServer p) -> [UserServer' s p] -> NonEmpty (ServerCfg p)
+agentServerCfgs opDomains randomSrvs =
+  fromMaybe fallbackSrvs . L.nonEmpty . mapMaybe enabledOpAgentServer
+  where
+    fallbackSrvs = L.map (snd . agentServer) randomSrvs
+    enabledOpAgentServer srv =
+      let (opEnabled, srvCfg) = agentServer srv
+       in if opEnabled then Just srvCfg else Nothing
+    agentServer :: UserServer' s p -> (Bool, ServerCfg p)
+    agentServer srv@UserServer {server, enabled} =
+      case find (\(d, _) -> any (matchingHost d) (srvHost srv)) opDomains of
+        Just (_, ServerOperator {operatorId = DBEntityId opId, enabled = opEnabled, roles}) ->
+          (opEnabled, ServerCfg {server, enabled, operator = Just opId, roles})
+        Nothing ->
+          (True, ServerCfg {server, enabled, operator = Nothing, roles = allRoles})
+
+matchingHost :: Text -> TransportHost -> Bool
+matchingHost d = \case
+  THDomainName h -> d `T.isSuffixOf` T.pack h
+  _ -> False
+
+operatorDomains :: [ServerOperator] -> [(Text, ServerOperator)]
+operatorDomains = foldr (\op ds -> foldr (\d -> ((d, op) :)) ds (serverDomains op)) []
+
+groupByOperator :: ([ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [UserOperatorServers]
+groupByOperator (ops, smpSrvs, xftpSrvs) = do
+  ss <- mapM (\op -> (serverDomains op,) <$> newIORef (UserOperatorServers (Just op) [] [])) ops
+  custom <- newIORef $ UserOperatorServers Nothing [] []
+  mapM_ (addServer ss custom addSMP) (reverse smpSrvs)
+  mapM_ (addServer ss custom addXFTP) (reverse xftpSrvs)
+  opSrvs <- mapM (readIORef . snd) ss
+  customSrvs <- readIORef custom
+  pure $ opSrvs <> [customSrvs]
+  where
+    addServer :: [([Text], IORef UserOperatorServers)] -> IORef UserOperatorServers -> (UserServer p -> UserOperatorServers -> UserOperatorServers) -> UserServer p -> IO ()
+    addServer ss custom add srv = 
+      let v = maybe custom snd $ find (\(ds, _) -> any (\d -> any (matchingHost d) (srvHost srv)) ds) ss
+       in atomicModifyIORef'_ v $ add srv
+    addSMP srv s@UserOperatorServers {smpServers} = (s :: UserOperatorServers) {smpServers = srv : smpServers}
+    addXFTP srv s@UserOperatorServers {xftpServers} = (s :: UserOperatorServers) {xftpServers = srv : xftpServers}
 
 data UserServersError
-  = USEStorageMissing
-  | USEProxyMissing
-  | USEDuplicateSMP {server :: AProtoServerWithAuth}
-  | USEDuplicateXFTP {server :: AProtoServerWithAuth}
+  = USEStorageMissing {protocol :: AProtocolType}
+  | USEProxyMissing {protocol :: AProtocolType}
+  | USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: AProtoServerWithAuth, duplicateHost :: TransportHost}
   deriving (Show)
 
-validateUserServers :: NonEmpty UserServers -> [UserServersError]
-validateUserServers userServers =
-  let storageMissing_ = if any (canUseForRole storage) userServers then [] else [USEStorageMissing]
-      proxyMissing_ = if any (canUseForRole proxy) userServers then [] else [USEProxyMissing]
-
-      allSMPServers = map (\ServerCfg {server} -> server) $ concatMap (\UserServers {smpServers} -> smpServers) userServers
-      duplicateSMPServers = findDuplicatesByHost allSMPServers
-      duplicateSMPErrors = map (USEDuplicateSMP . AProtoServerWithAuth SPSMP) duplicateSMPServers
-
-      allXFTPServers = map (\ServerCfg {server} -> server) $ concatMap (\UserServers {xftpServers} -> xftpServers) userServers
-      duplicateXFTPServers = findDuplicatesByHost allXFTPServers
-      duplicateXFTPErrors = map (USEDuplicateXFTP . AProtoServerWithAuth SPXFTP) duplicateXFTPServers
-   in storageMissing_ <> proxyMissing_ <> duplicateSMPErrors <> duplicateXFTPErrors
+validateUserServers :: NonEmpty UpdatedUserOperatorServers -> [UserServersError]
+validateUserServers uss =
+  missingRolesErr SPSMP storage USEStorageMissing
+    <> missingRolesErr SPSMP proxy USEProxyMissing
+    <> missingRolesErr SPXFTP storage USEStorageMissing
+    <> duplicatServerErrs SPSMP
+    <> duplicatServerErrs SPXFTP
   where
-    canUseForRole :: (ServerRoles -> Bool) -> UserServers -> Bool
-    canUseForRole roleSel UserServers {operator, smpServers, xftpServers} = case operator of
-      Just ServerOperator {roles} -> roleSel roles
-      Nothing -> not (null smpServers) && not (null xftpServers)
-    findDuplicatesByHost :: [ProtoServerWithAuth p] -> [ProtoServerWithAuth p]
-    findDuplicatesByHost servers =
-      let allHosts = concatMap (L.toList . host . protoServer) servers
-          hostCounts = M.fromListWith (+) [(host, 1 :: Int) | host <- allHosts]
-          duplicateHosts = M.keys $ M.filter (> 1) hostCounts
-       in filter (\srv -> any (`elem` duplicateHosts) (L.toList $ host . protoServer $ srv)) servers
+    missingRolesErr :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> (ServerRoles -> Bool) -> (AProtocolType -> UserServersError) -> [UserServersError]
+    missingRolesErr p roleSel err = [err (AProtocolType p) | not hasRole]
+      where
+        hasRole =
+          any (\(AUS _ UserServer {deleted, enabled}) -> enabled && not deleted) $
+            concatMap (`updatedServers` p) $ filter roleEnabled (L.toList uss)
+        roleEnabled UpdatedUserOperatorServers {operator} =
+          maybe True (\ServerOperator {enabled, roles} -> enabled && roleSel roles) operator
+    duplicatServerErrs :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [UserServersError]
+    duplicatServerErrs p = mapMaybe duplicateErr_ srvs
+      where
+        srvs =
+          filter (\(AUS _ UserServer {deleted}) -> not deleted) $
+            concatMap (`updatedServers` p) (L.toList uss)
+        duplicateErr_ (AUS _ srv@UserServer {server}) =
+          USEDuplicateServer (AProtocolType p) (AProtoServerWithAuth p server)
+            <$> find (`S.member` duplicateHosts) (srvHost srv)
+        duplicateHosts = snd $ foldl' addHost (S.empty, S.empty) allHosts
+        allHosts = concatMap (\(AUS _ srv) -> L.toList $ srvHost srv) srvs
+        addHost (hs, dups) h
+          | h `S.member` hs = (hs, S.insert h dups)
+          | otherwise = (S.insert h hs, dups)
+
+instance ToJSON (DBEntityId' s) where
+  toEncoding = \case
+    DBEntityId i -> toEncoding i
+    DBNewEntity -> JE.null_
+  toJSON = \case
+    DBEntityId i -> toJSON i
+    DBNewEntity -> J.Null
+
+instance DBStoredI s => FromJSON (DBEntityId' s) where
+  parseJSON v = case (v, sdbStored @s) of
+    (J.Null, SDBNew) -> pure DBNewEntity
+    (J.Number n, SDBStored) -> case floatingOrInteger n of
+      Left (_ :: Double) -> fail "bad DBEntityId"
+      Right i -> pure $ DBEntityId (fromInteger i)
+    _ -> fail "bad DBEntityId"
+  omittedField = case sdbStored @s of
+    SDBStored -> Nothing
+    SDBNew -> Just DBNewEntity
 
 $(JQ.deriveJSON defaultJSON ''UsageConditions)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CA") ''ConditionsAcceptance)
 
-$(JQ.deriveJSON defaultJSON ''ServerOperator)
+instance ToJSON (ServerOperator' s) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerOperator')
+  toJSON = $(JQ.mkToJSON defaultJSON ''ServerOperator')
 
-$(JQ.deriveJSON defaultJSON ''OperatorEnabled)
+instance DBStoredI s => FromJSON (ServerOperator' s) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''ServerOperator')
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "UCA") ''UsageConditionsAction)
 
-$(JQ.deriveJSON defaultJSON ''UserServers)
+instance ProtocolTypeI p => ToJSON (UserServer' s p) where
+  toEncoding = $(JQ.mkToEncoding defaultJSON ''UserServer')
+  toJSON = $(JQ.mkToJSON defaultJSON ''UserServer')
+
+instance (DBStoredI s, ProtocolTypeI p) => FromJSON (UserServer' s p) where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''UserServer')
+
+instance ProtocolTypeI p => FromJSON (AUserServer p) where
+  parseJSON v = (AUS SDBStored <$> parseJSON v) <|> (AUS SDBNew <$> parseJSON v)
+
+$(JQ.deriveJSON defaultJSON ''UserOperatorServers)
+
+instance FromJSON UpdatedUserOperatorServers where
+  parseJSON = $(JQ.mkParseJSON defaultJSON ''UpdatedUserOperatorServers)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USE") ''UserServersError)

src/Simplex/Chat/Operators/Conditions.hs

@@ -9,7 +9,7 @@ import qualified Data.Text as T
 stripFrontMatter :: Text -> Text
 stripFrontMatter =
   T.unlines
-    . dropWhile ("# " `T.isPrefixOf`) -- strip title
+    -- . dropWhile ("# " `T.isPrefixOf`) -- strip title
     . dropWhile (T.all isSpace)
     . dropWhile fm
     . (\ls -> let ls' = dropWhile (not . fm) ls in if null ls' then ls else ls')

src/Simplex/Chat/Stats.hs

@@ -7,7 +7,6 @@ module Simplex.Chat.Stats where
 
 import qualified Data.Aeson.TH as J
 import Data.List (partition)
-import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
@@ -131,7 +130,7 @@ data NtfServerSummary = NtfServerSummary
 -- - users are passed to exclude hidden users from totalServersSummary;
 -- - if currentUser is hidden, it should be accounted in totalServersSummary;
 -- - known is set only in user level summaries based on passed userSMPSrvs and userXFTPSrvs
-toPresentedServersSummary :: AgentServersSummary -> [User] -> User -> NonEmpty SMPServer -> NonEmpty XFTPServer -> [NtfServer] -> PresentedServersSummary
+toPresentedServersSummary :: AgentServersSummary -> [User] -> User -> [SMPServer] -> [XFTPServer] -> [NtfServer] -> PresentedServersSummary
 toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrvs userNtfSrvs = do
   let (userSMPSrvsSumms, allSMPSrvsSumms) = accSMPSrvsSummaries
       (userSMPCurr, userSMPPrev, userSMPProx) = smpSummsIntoCategories userSMPSrvsSumms

src/Simplex/Chat/Store/Profiles.hs

@@ -1,5 +1,8 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -47,9 +50,13 @@ module Simplex.Chat.Store.Profiles
     getContactWithoutConnViaAddress,
     updateUserAddressAutoAccept,
     getProtocolServers,
+    getUpdateUserServers,
     -- overwriteOperatorsAndServers,
     overwriteProtocolServers,
+    insertProtocolServer,
+    getUpdateServerOperators,
     getServerOperators,
+    getUserServers,
     setServerOperators,
     getCurrentUsageConditions,
     getLatestAcceptedConditions,
@@ -77,10 +84,11 @@ import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (fromMaybe)
-import Data.Text (Text, splitOn)
+import Data.Text (Text)
+import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
-import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..))
+import Database.SQLite.Simple (NamedParam (..), Only (..), Query, (:.) (..))
 import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Call
 import Simplex.Chat.Messages
@@ -92,7 +100,7 @@ import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
-import Simplex.Messaging.Agent.Env.SQLite (OperatorId, ServerCfg (..), ServerRoles (..))
+import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
 import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
@@ -100,7 +108,7 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON)
-import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
+import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode, UserProtocol)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
 
@@ -524,177 +532,282 @@ updateUserAddressAutoAccept db user@User {userId} autoAccept = do
       Just AutoAccept {acceptIncognito, autoReply} -> (True, acceptIncognito, autoReply)
       _ -> (False, False, Nothing)
 
-getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
-getProtocolServers db User {userId} =
-  map toServerCfg
+getUpdateUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => DB.Connection -> SProtocolType p -> NonEmpty PresetOperator -> NonEmpty (NewUserServer p) -> User -> IO [UserServer p]
+getUpdateUserServers db p presetOps randomSrvs user = do
+  ts <- getCurrentTime
+  srvs <- getProtocolServers db p user
+  let srvs' = L.toList $ updatedUserServers p presetOps randomSrvs srvs
+  mapM (upsertServer ts) srvs'
+  where
+    upsertServer :: UTCTime -> AUserServer p -> IO (UserServer p)
+    upsertServer ts (AUS _ s@UserServer {serverId}) = case serverId of
+      DBNewEntity -> insertProtocolServer db p user ts s
+      DBEntityId _ -> updateProtocolServer db p ts s $> s
+
+getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> IO [UserServer p]
+getProtocolServers db p User {userId} =
+  map toUserServer
     <$> DB.query
       db
       [sql|
-        SELECT s.host, s.port, s.key_hash, s.basic_auth, s.server_operator_id, s.preset, s.tested, s.enabled, o.role_storage, o.role_proxy
-        FROM protocol_servers s
-        LEFT JOIN server_operators o USING (server_operator_id)
-        WHERE s.user_id = ? AND s.protocol = ?
+        SELECT smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled
+        FROM protocol_servers
+        WHERE user_id = ? AND protocol = ?
       |]
-      (userId, decodeLatin1 $ strEncode protocol)
+      (userId, decodeLatin1 $ strEncode p)
   where
-    protocol = protocolTypeI @p
-    toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Maybe OperatorId, Bool, Maybe Bool, Bool, Maybe Bool, Maybe Bool) -> ServerCfg p
-    toServerCfg (host, port, keyHash, auth_, operator, preset, tested, enabled, storage_, proxy_) =
-      let server = ProtoServerWithAuth (ProtocolServer protocol host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
-          roles = ServerRoles {storage = fromMaybe True storage_, proxy = fromMaybe True proxy_}
-       in ServerCfg {server, operator, preset, tested, enabled, roles}
+    toUserServer :: (DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> UserServer p
+    toUserServer (serverId, host, port, keyHash, auth_, preset, tested, enabled) =
+      let server = ProtoServerWithAuth (ProtocolServer p host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
+       in UserServer {serverId, server, preset, tested, enabled, deleted = False}
 
 -- TODO remove
 -- overwriteOperatorsAndServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> Maybe [ServerOperator] -> [ServerCfg p] -> ExceptT StoreError IO [ServerCfg p]
 -- overwriteOperatorsAndServers db user@User {userId} operators_ servers = do
-overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()
-overwriteProtocolServers db User {userId} servers =
+overwriteProtocolServers :: ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> [UserServer p] -> ExceptT StoreError IO ()
+overwriteProtocolServers db p User {userId} servers =
   -- liftIO $ mapM_ (updateServerOperators_ db) operators_
   checkConstraint SEUniqueID . ExceptT $ do
     currentTs <- getCurrentTime
-    DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND protocol = ? " (userId, protocol)
-    forM_ servers $ \ServerCfg {server, preset, tested, enabled} -> do
-      let ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_ = server
+    DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND protocol = ? " (userId, decodeLatin1 $ strEncode p)
+    forM_ servers $ \UserServer {serverId, server, preset, tested, enabled} -> do
       DB.execute
         db
         [sql|
           INSERT INTO protocol_servers
-            (protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
-          VALUES (?,?,?,?,?,?,?,?,?,?,?)
+            (server_id, protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
+          VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
         |]
-        ((protocol, host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_) :. (preset, tested, enabled, userId, currentTs, currentTs))
-    -- Right <$> getProtocolServers db user
+        (Only serverId :. serverColumns p server :. (preset, tested, enabled, userId, currentTs, currentTs))
     pure $ Right ()
-  where
-    protocol = decodeLatin1 $ strEncode $ protocolTypeI @p
+
+insertProtocolServer :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> UTCTime -> NewUserServer p -> IO (UserServer p)
+insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, tested, enabled} = do
+  DB.execute
+    db
+    [sql|
+      INSERT INTO protocol_servers
+        (protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
+      VALUES (?,?,?,?,?,?,?,?,?,?,?)
+    |]
+    (serverColumns p server :. (preset, tested, enabled, userId, ts, ts))
+  sId <- insertedRowId db
+  pure (srv :: NewUserServer p) {serverId = DBEntityId sId}
+
+updateProtocolServer :: ProtocolTypeI p => DB.Connection -> SProtocolType p -> UTCTime -> UserServer p -> IO ()
+updateProtocolServer db p ts UserServer {serverId, server, preset, tested, enabled} =
+  DB.execute
+    db
+    [sql|
+      UPDATE protocol_servers
+      SET protocol = ?, host = ?, port = ?, key_hash = ?, basic_auth = ?,
+          preset = ?, tested = ?, enabled = ?, updated_at = ?
+      WHERE smp_server_id = ?
+    |]
+    (serverColumns p server :. (preset, tested, enabled, ts, serverId))
+
+serverColumns :: ProtocolTypeI p => SProtocolType p -> ProtoServerWithAuth p -> (Text, NonEmpty TransportHost, String, C.KeyHash, Maybe Text)
+serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) =
+  let protocol = decodeLatin1 $ strEncode p
+      auth = safeDecodeUtf8 . unBasicAuth <$> auth_
+   in (protocol, host, port, keyHash, auth)
 
 getServerOperators :: DB.Connection -> ExceptT StoreError IO ([ServerOperator], Maybe UsageConditionsAction)
 getServerOperators db = do
-  now <- liftIO getCurrentTime
-  currentConditions <- getCurrentUsageConditions db
-  latestAcceptedConditions <- getLatestAcceptedConditions db
-  operators <-
-    liftIO $
-      map (toOperator now currentConditions latestAcceptedConditions)
-        <$> DB.query_
-          db
-          [sql|
-            SELECT
-              so.server_operator_id, so.server_operator_tag, so.trade_name, so.legal_name,
-              so.server_domains, so.enabled, so.role_storage, so.role_proxy,
-              AcceptedConditions.conditions_commit, AcceptedConditions.accepted_at
-            FROM server_operators so
-            LEFT JOIN (
-              SELECT server_operator_id, conditions_commit, accepted_at, MAX(operator_usage_conditions_id)
-              FROM operator_usage_conditions
-              GROUP BY server_operator_id
-            ) AcceptedConditions ON AcceptedConditions.server_operator_id = so.server_operator_id
-          |]
-  pure (operators, usageConditionsAction operators currentConditions now)
-  where
-    toOperator ::
-      UTCTime ->
-      UsageConditions ->
-      Maybe UsageConditions ->
-      ( (OperatorId, Maybe OperatorTag, Text, Maybe Text, Text, Bool, Bool, Bool)
-          :. (Maybe Text, Maybe UTCTime)
-      ) ->
-      ServerOperator
-    toOperator
-      now
-      UsageConditions {conditionsCommit = currentCommit, createdAt, notifiedAt}
-      latestAcceptedConditions_
-      ( (operatorId, operatorTag, tradeName, legalName, domains, enabled, storage, proxy)
-          :. (operatorCommit_, acceptedAt_)
-        ) =
-        let roles = ServerRoles {storage, proxy}
-            serverDomains = splitOn "," domains
-            conditionsAcceptance = case (latestAcceptedConditions_, operatorCommit_) of
-              -- no conditions were ever accepted for any operator(s)
-              -- (shouldn't happen as there should always be record for SimpleX Chat)
-              (Nothing, _) -> CARequired Nothing
-              -- no conditions were ever accepted for this operator
-              (_, Nothing) -> CARequired Nothing
-              (Just UsageConditions {conditionsCommit = latestAcceptedCommit}, Just operatorCommit)
-                | latestAcceptedCommit == currentCommit ->
-                    if operatorCommit == latestAcceptedCommit
-                      then -- current conditions were accepted for operator
-                        CAAccepted acceptedAt_
-                      else -- current conditions were NOT accepted for operator, but were accepted for other operator(s)
-                        CARequired Nothing
-                | otherwise ->
-                    if operatorCommit == latestAcceptedCommit
-                      then -- new conditions available, latest accepted conditions were accepted for operator
-                        CARequired $ conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
-                      else -- new conditions available, latest accepted conditions were NOT accepted for operator (were accepted for other operator(s))
-                        CARequired Nothing
-         in ServerOperator {operatorId, operatorTag, tradeName, legalName, serverDomains, conditionsAcceptance, enabled, roles}
+  currentConds <- getCurrentUsageConditions db
+  liftIO $ do
+    now <- getCurrentTime
+    latestAcceptedConds_ <- getLatestAcceptedConditions db
+    let getConds op = (\ca -> op {conditionsAcceptance = ca}) <$> getOperatorConditions_ db op currentConds latestAcceptedConds_ now
+    operators <- mapM getConds =<< getServerOperators_ db
+    pure (operators, usageConditionsAction operators currentConds now)
 
-setServerOperators :: DB.Connection -> NonEmpty OperatorEnabled -> ExceptT StoreError IO ([ServerOperator], Maybe UsageConditionsAction)
-setServerOperators db operatorsEnabled = do
-  liftIO $ forM_ operatorsEnabled $ \OperatorEnabled {operatorId, enabled, roles = ServerRoles {storage, proxy}} ->
-    DB.execute
-      db
-      "UPDATE server_operators SET enabled = ?, role_storage = ?, role_proxy = ? WHERE server_operator_id = ?"
-      (enabled, storage, proxy, operatorId)
-  getServerOperators db
+getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([ServerOperator], [UserServer 'PSMP],  [UserServer 'PXFTP])
+getUserServers db user =
+  (,,)
+    <$> (fst <$> getServerOperators db)
+    <*> liftIO (getProtocolServers db SPSMP user)
+    <*> liftIO (getProtocolServers db SPXFTP user)
+
+setServerOperators :: DB.Connection -> NonEmpty ServerOperator -> IO ()
+setServerOperators db ops = do
+  currentTs <- getCurrentTime
+  mapM_ (updateServerOperator db currentTs) ops
+
+updateServerOperator :: DB.Connection -> UTCTime -> ServerOperator -> IO ()
+updateServerOperator db currentTs ServerOperator {operatorId, enabled, roles = ServerRoles {storage, proxy}} =
+  DB.execute
+    db
+    [sql|
+      UPDATE server_operators
+      SET enabled = ?, role_storage = ?, role_proxy = ?, updated_at = ?
+      WHERE server_operator_id = ?
+    |]
+    (enabled, storage, proxy, operatorId, currentTs)
+
+getUpdateServerOperators :: DB.Connection -> NonEmpty PresetOperator -> Bool -> IO [ServerOperator]
+getUpdateServerOperators db presetOps newUser = do
+  conds <- map toUsageConditions <$> DB.query_ db usageCondsQuery
+  now <- getCurrentTime
+  let (acceptForSimplex_, currentConds, condsToAdd) = usageConditionsToAdd newUser now conds
+  mapM_ insertConditions condsToAdd
+  latestAcceptedConds_ <- getLatestAcceptedConditions db
+  ops <- updatedServerOperators presetOps <$> getServerOperators_ db
+  forM ops $ \(ASO _ op) ->
+    case operatorId op of
+      DBNewEntity -> do
+        op' <- insertOperator op
+        case (operatorTag op', acceptForSimplex_) of
+          (Just OTSimplex, Just cond) -> autoAcceptConditions op' cond
+          _ -> pure op'
+      DBEntityId _ -> do
+        updateOperator op
+        getOperatorConditions_ db op currentConds latestAcceptedConds_ now >>= \case
+          CARequired Nothing | operatorTag op == Just OTSimplex -> autoAcceptConditions op currentConds
+          CARequired (Just ts) | ts < now -> autoAcceptConditions op currentConds
+          ca -> pure op {conditionsAcceptance = ca}
+  where
+    insertConditions UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt} =
+      DB.execute
+        db
+        [sql|
+          INSERT INTO usage_conditions
+            (usage_conditions_id, conditions_commit, notified_at, created_at)
+          VALUES (?,?,?,?)
+        |]
+        (conditionsId, conditionsCommit, notifiedAt, createdAt)
+    updateOperator :: ServerOperator -> IO ()
+    updateOperator ServerOperator {operatorId, tradeName, legalName, serverDomains, enabled, roles = ServerRoles {storage, proxy}} =
+      DB.execute
+        db
+        [sql|
+          UPDATE server_operators
+          SET trade_name = ?, legal_name = ?, server_domains = ?, enabled = ?, role_storage = ?, role_proxy = ?
+          WHERE server_operator_id = ?
+        |]
+        (tradeName, legalName, T.intercalate "," serverDomains, enabled, storage, proxy, operatorId)
+    insertOperator :: NewServerOperator -> IO ServerOperator
+    insertOperator op@ServerOperator {operatorTag, tradeName, legalName, serverDomains, enabled, roles = ServerRoles {storage, proxy}} = do
+      DB.execute
+        db
+        [sql|
+          INSERT INTO server_operators
+            (server_operator_tag, trade_name, legal_name, server_domains, enabled, role_storage, role_proxy)
+          VALUES (?,?,?,?,?,?,?)
+        |]
+        (operatorTag, tradeName, legalName, T.intercalate "," serverDomains, enabled, storage, proxy)
+      opId <- insertedRowId db
+      pure op {operatorId = DBEntityId opId}
+    autoAcceptConditions op UsageConditions {conditionsCommit} =
+      acceptConditions_ db op conditionsCommit Nothing
+        $> op {conditionsAcceptance = CAAccepted Nothing}
+
+serverOperatorQuery :: Query
+serverOperatorQuery =
+  [sql|
+    SELECT server_operator_id, server_operator_tag, trade_name, legal_name,
+      server_domains, enabled, role_storage, role_proxy
+    FROM server_operators
+  |]
+
+getServerOperators_ :: DB.Connection -> IO [ServerOperator]
+getServerOperators_ db = map toServerOperator <$> DB.query_ db serverOperatorQuery
+
+toServerOperator :: (DBEntityId, Maybe OperatorTag, Text, Maybe Text, Text, Bool, Bool, Bool) -> ServerOperator
+toServerOperator (operatorId, operatorTag, tradeName, legalName, domains, enabled, storage, proxy) =
+  ServerOperator
+    { operatorId,
+      operatorTag,
+      tradeName,
+      legalName,
+      serverDomains = T.splitOn "," domains,
+      conditionsAcceptance = CARequired Nothing,
+      enabled,
+      roles = ServerRoles {storage, proxy}
+    }
+
+getOperatorConditions_ :: DB.Connection -> ServerOperator -> UsageConditions -> Maybe UsageConditions -> UTCTime -> IO ConditionsAcceptance
+getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {conditionsCommit = currentCommit, createdAt, notifiedAt} latestAcceptedConds_ now = do
+  case latestAcceptedConds_ of
+    Nothing -> pure $ CARequired Nothing -- no conditions accepted by any operator
+    Just UsageConditions {conditionsCommit = latestAcceptedCommit} -> do
+      operatorAcceptedConds_ <-
+        maybeFirstRow id $
+          DB.query
+            db
+            [sql|
+              SELECT conditions_commit, accepted_at
+              FROM operator_usage_conditions
+              WHERE server_operator_id = ?
+              ORDER BY operator_usage_conditions_id DESC
+              LIMIT 1
+            |]
+            (Only operatorId)
+      pure $ case operatorAcceptedConds_ of
+        Just (operatorCommit, acceptedAt_)
+          | operatorCommit /= latestAcceptedCommit -> CARequired Nothing -- TODO should we consider this operator disabled?
+          | currentCommit /= latestAcceptedCommit -> CARequired $ conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
+          | otherwise -> CAAccepted acceptedAt_
+        _ -> CARequired Nothing -- no conditions were accepted for this operator
 
 getCurrentUsageConditions :: DB.Connection -> ExceptT StoreError IO UsageConditions
 getCurrentUsageConditions db =
   ExceptT . firstRow toUsageConditions SEUsageConditionsNotFound $
-    DB.query_
-      db
-      [sql|
-        SELECT usage_conditions_id, conditions_commit, notified_at, created_at
-        FROM usage_conditions
-        ORDER BY usage_conditions_id DESC LIMIT 1
-      |]
+    DB.query_ db (usageCondsQuery <> " DESC LIMIT 1")
+
+usageCondsQuery :: Query
+usageCondsQuery =
+  [sql|
+    SELECT usage_conditions_id, conditions_commit, notified_at, created_at
+    FROM usage_conditions
+    ORDER BY usage_conditions_id
+  |]
 
 toUsageConditions :: (Int64, Text, Maybe UTCTime, UTCTime) -> UsageConditions
 toUsageConditions (conditionsId, conditionsCommit, notifiedAt, createdAt) =
   UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt}
 
-getLatestAcceptedConditions :: DB.Connection -> ExceptT StoreError IO (Maybe UsageConditions)
-getLatestAcceptedConditions db = do
-  (latestAcceptedCommit_ :: Maybe Text) <-
-    liftIO $
-      maybeFirstRow fromOnly $
-        DB.query_
-          db
-          [sql|
+getLatestAcceptedConditions :: DB.Connection -> IO (Maybe UsageConditions)
+getLatestAcceptedConditions db =
+  maybeFirstRow toUsageConditions $
+    DB.query_
+      db
+      [sql|
+        SELECT usage_conditions_id, conditions_commit, notified_at, created_at
+        FROM usage_conditions
+        WHERE conditions_commit = (
           SELECT conditions_commit
           FROM operator_usage_conditions
           ORDER BY accepted_at DESC
           LIMIT 1
-        |]
-  forM latestAcceptedCommit_ $ \latestAcceptedCommit ->
-    ExceptT . firstRow toUsageConditions SEUsageConditionsNotFound $
-      DB.query
-        db
-        [sql|
-          SELECT usage_conditions_id, conditions_commit, notified_at, created_at
-          FROM usage_conditions
-          WHERE conditions_commit = ?
-        |]
-        (Only latestAcceptedCommit)
+        )
+      |]
 
 setConditionsNotified :: DB.Connection -> Int64 -> UTCTime -> IO ()
-setConditionsNotified db conditionsId notifiedAt =
-  DB.execute db "UPDATE usage_conditions SET notified_at = ? WHERE usage_conditions_id = ?" (notifiedAt, conditionsId)
+setConditionsNotified db condId notifiedAt =
+  DB.execute db "UPDATE usage_conditions SET notified_at = ? WHERE usage_conditions_id = ?" (notifiedAt, condId)
 
-acceptConditions :: DB.Connection -> Int64 -> NonEmpty ServerOperator -> UTCTime -> ExceptT StoreError IO ([ServerOperator], Maybe UsageConditionsAction)
-acceptConditions db conditionsId operators acceptedAt = do
-  UsageConditions {conditionsCommit} <- getUsageConditionsById_ db conditionsId
-  liftIO $ forM_ operators $ \ServerOperator {operatorId, operatorTag} ->
-    DB.execute
-      db
-      [sql|
-        INSERT INTO operator_usage_conditions
-          (server_operator_id, server_operator_tag, conditions_commit, accepted_at)
-        VALUES (?,?,?,?)
-      |]
-      (operatorId, operatorTag, conditionsCommit, acceptedAt)
-  getServerOperators db
+acceptConditions :: DB.Connection -> Int64 -> NonEmpty Int64 -> UTCTime -> ExceptT StoreError IO ()
+acceptConditions db condId opIds acceptedAt = do
+  UsageConditions {conditionsCommit} <- getUsageConditionsById_ db condId
+  operators <- mapM getServerOperator_ opIds
+  let ts = Just acceptedAt
+  liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit ts
+  where
+    getServerOperator_ opId =
+      ExceptT $ firstRow toServerOperator (SEOperatorNotFound opId) $
+        DB.query db (serverOperatorQuery <> " WHERE operator_id = ?") (Only opId)
+
+acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> Maybe UTCTime -> IO ()
+acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt =
+  DB.execute
+    db
+    [sql|
+      INSERT INTO operator_usage_conditions
+        (server_operator_id, server_operator_tag, conditions_commit, accepted_at)
+      VALUES (?,?,?,?)
+    |]
+    (operatorId, operatorTag, conditionsCommit, acceptedAt)
 
 getUsageConditionsById_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UsageConditions
 getUsageConditionsById_ db conditionsId =
@@ -708,83 +821,22 @@ getUsageConditionsById_ db conditionsId =
       |]
       (Only conditionsId)
 
-setUserServers :: DB.Connection -> User -> NonEmpty UserServers -> ExceptT StoreError IO ()
-setUserServers db User {userId} userServers = do
-  currentTs <- liftIO getCurrentTime
-  forM_ userServers $ do
-    \UserServers {operator, smpServers, xftpServers} -> do
-      forM_ operator $ \op -> liftIO $ updateOperator currentTs op
-      overwriteServers currentTs operator smpServers
-      overwriteServers currentTs operator xftpServers
+setUserServers :: DB.Connection -> User -> NonEmpty UpdatedUserOperatorServers -> ExceptT StoreError IO ()
+setUserServers db user@User {userId} userServers = checkConstraint SEUniqueID $ liftIO $ do
+  ts <- getCurrentTime
+  forM_ userServers $ \UpdatedUserOperatorServers {operator, smpServers, xftpServers} -> do
+    mapM_ (updateServerOperator db ts) operator
+    mapM_ (upsertOrDelete SPSMP ts) smpServers
+    mapM_ (upsertOrDelete SPXFTP ts) xftpServers
   where
-    updateOperator :: UTCTime -> ServerOperator -> IO ()
-    updateOperator currentTs ServerOperator {operatorId, enabled, roles = ServerRoles {storage, proxy}} =
-      DB.execute
-        db
-        [sql|
-          UPDATE server_operators
-          SET enabled = ?, role_storage = ?, role_proxy = ?, updated_at = ?
-          WHERE server_operator_id = ?
-        |]
-        (enabled, storage, proxy, operatorId, currentTs)
-    overwriteServers :: forall p. ProtocolTypeI p => UTCTime -> Maybe ServerOperator -> [ServerCfg p] -> ExceptT StoreError IO ()
-    overwriteServers currentTs serverOperator servers =
-      checkConstraint SEUniqueID . ExceptT $ do
-        case serverOperator of
-          Nothing ->
-            DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND server_operator_id IS NULL AND protocol = ?" (userId, protocol)
-          Just ServerOperator {operatorId} ->
-            DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND server_operator_id = ? AND protocol = ?" (userId, operatorId, protocol)
-        forM_ servers $ \ServerCfg {server, operator, preset, tested, enabled} -> do
-          let ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_ = server
-          DB.execute
-            db
-            [sql|
-              INSERT INTO protocol_servers
-                (protocol, host, port, key_hash, basic_auth, operator, preset, tested, enabled, user_id, created_at, updated_at)
-              VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
-            |]
-            ((protocol, host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_, operator) :. (preset, tested, enabled, userId, currentTs, currentTs))
-        pure $ Right ()
-      where
-        protocol = decodeLatin1 $ strEncode $ protocolTypeI @p
-
--- updateServerOperators_ :: DB.Connection -> [ServerOperator] -> IO [ServerOperator]
--- updateServerOperators_ db operators = do
---   DB.execute_ db "DELETE FROM server_operators WHERE preset = 0"
---   let (existing, new) = partition (isJust . operatorId) operators
---   existing' <- mapM (\op -> upsertExisting op $> op) existing
---   new' <- mapM insertNew new
---   pure $ existing' <> new'
---   where
---     upsertExisting ServerOperator {operatorId, name, preset, enabled, roles = ServerRoles {storage, proxy}}
---       | preset =
---           DB.execute
---             db
---             [sql|
---               UPDATE server_operators
---               SET enabled = ?, role_storage = ?, role_proxy = ?
---               WHERE server_operator_id = ?
---             |]
---             (enabled, storage, proxy, operatorId)
---       | otherwise =
---           DB.execute
---             db
---             [sql|
---               INSERT INTO server_operators (server_operator_id, name, preset, enabled, role_storage, role_proxy)
---               VALUES (?,?,?,?,?,?)
---             |]
---             (operatorId, name, preset, enabled, storage, proxy)
---     insertNew op@ServerOperator {name, preset, enabled, roles = ServerRoles {storage, proxy}} = do
---       DB.execute
---         db
---         [sql|
---           INSERT INTO server_operators (name, preset, enabled, role_storage, role_proxy)
---           VALUES (?,?,?,?,?)
---         |]
---         (name, preset, enabled, storage, proxy)
---       opId <- insertedRowId db
---       pure op {operatorId = Just opId}
+    upsertOrDelete :: ProtocolTypeI p => SProtocolType p -> UTCTime -> AUserServer p -> IO ()
+    upsertOrDelete p ts (AUS _ s@UserServer {serverId, deleted}) = case serverId of
+      DBNewEntity
+        | deleted -> pure ()
+        | otherwise -> void $ insertProtocolServer db p user ts s
+      DBEntityId srvId
+        | deleted -> DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, False)
+        | otherwise -> updateProtocolServer db p ts s
 
 createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
 createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do

src/Simplex/Chat/Store/Shared.hs

@@ -127,6 +127,7 @@ data StoreError
   | SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
   | SERemoteCtrlDuplicateCA
   | SEProhibitedDeleteUser {userId :: UserId, contactId :: ContactId}
+  | SEOperatorNotFound {serverOperatorId :: Int64}
   | SEUsageConditionsNotFound
   deriving (Show, Exception)
 

src/Simplex/Chat/Terminal.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Chat.Terminal where
@@ -13,15 +14,15 @@ import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Database.SQLite.Simple (SQLError (..))
 import qualified Database.SQLite.Simple as DB
-import Simplex.Chat (defaultChatConfig, operatorSimpleXChat)
+import Simplex.Chat (_defaultNtfServers, defaultChatConfig, operatorSimpleXChat)
 import Simplex.Chat.Controller
 import Simplex.Chat.Core
 import Simplex.Chat.Help (chatWelcome)
+import Simplex.Chat.Operators
 import Simplex.Chat.Options
 import Simplex.Chat.Terminal.Input
 import Simplex.Chat.Terminal.Output
 import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
-import Simplex.Messaging.Agent.Env.SQLite (allRoles, presetServerCfg)
 import Simplex.Messaging.Client (NetworkConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig)
 import Simplex.Messaging.Util (raceAny_)
 import System.IO (hFlush, hSetEcho, stdin, stdout)
@@ -29,20 +30,24 @@ import System.IO (hFlush, hSetEcho, stdin, stdout)
 terminalChatConfig :: ChatConfig
 terminalChatConfig =
   defaultChatConfig
-    { defaultServers =
-        DefaultAgentServers
-          { smp =
-              L.fromList $
-                map
-                  (presetServerCfg True allRoles operatorSimpleXChat)
-                  [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
-                    "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
-                    "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
-                  ],
-            useSMP = 3,
-            ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
-            xftp = L.map (presetServerCfg True allRoles operatorSimpleXChat) defaultXFTPServers,
-            useXFTP = L.length defaultXFTPServers,
+    { presetServers =
+        PresetServers
+          { operators =
+              [ PresetOperator
+                  { operator = Just operatorSimpleXChat,
+                    smp =
+                      map
+                        (presetServer True)
+                        [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
+                          "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
+                          "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
+                        ],
+                    useSMP = 3,
+                    xftp = map (presetServer True) $ L.toList defaultXFTPServers,
+                    useXFTP = 3
+                  }
+              ],
+            ntf = _defaultNtfServers,
             netCfg =
               defaultNetworkConfig
                 { smpProxyMode = SPMUnknown,

src/Simplex/Chat/Terminal/Main.hs

@@ -10,7 +10,7 @@ import Data.Maybe (fromMaybe)
 import Data.Time.Clock (getCurrentTime)
 import Data.Time.LocalTime (getCurrentTimeZone)
 import Network.Socket
-import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatResponse (..), DefaultAgentServers (DefaultAgentServers, netCfg), SimpleNetCfg (..), currentRemoteHost, versionNumber, versionString)
+import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatResponse (..), PresetServers (..), SimpleNetCfg (..), currentRemoteHost, versionNumber, versionString)
 import Simplex.Chat.Core
 import Simplex.Chat.Options
 import Simplex.Chat.Terminal
@@ -56,7 +56,7 @@ simplexChatCLI' cfg opts@ChatOpts {chatCmd, chatCmdLog, chatCmdDelay, chatServer
           putStrLn $ serializeChatResponse (rh, Just user) ts tz rh r
 
 welcome :: ChatConfig -> ChatOpts -> IO ()
-welcome ChatConfig {defaultServers = DefaultAgentServers {netCfg}} ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, simpleNetCfg = SimpleNetCfg {socksProxy, socksMode, smpProxyMode_, smpProxyFallback_}}} =
+welcome ChatConfig {presetServers = PresetServers {netCfg}} ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, simpleNetCfg = SimpleNetCfg {socksProxy, socksMode, smpProxyMode_, smpProxyFallback_}}} =
   mapM_
     putStrLn
     [ versionString versionNumber,

src/Simplex/Chat/View.hs

@@ -19,12 +19,13 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace, toUpper)
 import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (foldl', groupBy, intercalate, intersperse, partition, sortOn)
+import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
+import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
@@ -54,7 +55,7 @@ import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
 import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
-import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..), ServerCfg (..))
+import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..), ServerRoles (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
 import Simplex.Messaging.Client (SMPProxyFallback, SMPProxyMode (..), SocksMode (..))
@@ -96,10 +97,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRChats chats -> viewChats ts tz chats
   CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat]
   CRApiParsedMarkdown ft -> [viewJSON ft]
-  CRUserProtoServers u userServers operators  -> ttyUser u $ viewUserServers userServers operators testView
   CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
-  CRServerOperators {} -> []
-  CRUserServers {} -> []
+  CRServerOperators ops ca -> viewServerOperators ops ca 
+  CRUserServers u uss -> ttyUser u $ concatMap viewUserServers uss <> (if testView then [] else serversUserHelp)
   CRUserServersValidation _ -> []
   CRUsageConditions {} -> []
   CRChatItemTTL u ttl -> ttyUser u $ viewChatItemTTL ttl
@@ -1214,27 +1214,31 @@ viewUserPrivacy User {userId} User {userId = userId', localDisplayName = n', sho
     "profile is " <> if isJust viewPwdHash then "hidden" else "visible"
   ]
 
-viewUserServers :: AUserProtoServers -> [ServerOperator] -> Bool -> [StyledString]
-viewUserServers (AUPS UserProtoServers {serverProtocol = p, protoServers, presetServers}) operators testView =
-  customServers
-    <> if testView
-      then []
-      else
-        [ "",
-          "use " <> highlight (srvCmd <> " test <srv>") <> " to test " <> pName <> " server connection",
-          "use " <> highlight (srvCmd <> " <srv1[,srv2,...]>") <> " to configure " <> pName <> " servers",
-          "use " <> highlight (srvCmd <> " default") <> " to remove configured " <> pName <> " servers and use presets"
-        ]
-          <> case p of
-            SPSMP -> ["(chat option " <> highlight' "-s" <> " (" <> highlight' "--server" <> ") has precedence over saved SMP servers for chat session)"]
-            SPXFTP -> ["(chat option " <> highlight' "-xftp-servers" <> " has precedence over saved XFTP servers for chat session)"]
+viewUserServers :: UserOperatorServers -> [StyledString]
+viewUserServers (UserOperatorServers _ [] []) = []
+viewUserServers UserOperatorServers {operator, smpServers, xftpServers} =
+  [plain $ maybe "Your servers" shortViewOperator operator]
+    <> viewServers SPSMP smpServers
+    <> viewServers SPXFTP xftpServers
   where
-    srvCmd = "/" <> strEncode p
-    pName = protocolName p
-    customServers =
-      if null protoServers
-        then ("no " <> pName <> " servers saved, using presets: ") : viewServers operators presetServers
-        else viewServers operators protoServers
+    viewServers :: ProtocolTypeI p => SProtocolType p -> [UserServer p] -> [StyledString]
+    viewServers _ [] = []
+    viewServers p srvs = ["  " <> protocolName p <> " servers"] <> map (plain . ("    " <> ) . viewServer) srvs
+      where
+        viewServer UserServer {server, preset, tested, enabled} = safeDecodeUtf8 (strEncode server) <> serverInfo
+          where
+            serverInfo = if null serverInfo_ then "" else parens $ T.intercalate ", " serverInfo_
+            serverInfo_ = ["preset" | preset] <> testedInfo <> ["disabled" | not enabled]
+            testedInfo = maybe [] (\t -> ["test: " <> if t then "passed" else "failed"]) tested
+
+serversUserHelp :: [StyledString]
+serversUserHelp =
+  [ "",
+    "use " <> highlight' "/smp test <srv>" <> " to test SMP server connection",
+    "use " <> highlight' "/smp <srv1[,srv2,...]>" <> " to configure SMP servers",
+    "or the same commands starting from /xftp for XFTP servers",
+    "chat options " <> highlight' "-s" <> " (" <> highlight' "--server" <> ") and " <> highlight' "--xftp-servers" <> " have precedence over preset servers for new user profiles"
+  ]
 
 protocolName :: ProtocolTypeI p => SProtocolType p -> StyledString
 protocolName = plain . map toUpper . T.unpack . decodeLatin1 . strEncode
@@ -1255,6 +1259,53 @@ viewServerTestResult (AProtoServerWithAuth p _) = \case
   where
     pName = protocolName p
 
+viewServerOperators :: [ServerOperator] -> Maybe UsageConditionsAction -> [StyledString]
+viewServerOperators ops ca = map (plain . viewOperator) ops <> maybe [] viewConditionsAction ca
+
+viewOperator :: ServerOperator' s -> Text
+viewOperator op@ServerOperator {tradeName, legalName, serverDomains, conditionsAcceptance} =
+  viewOpIdTag op
+    <> tradeName
+    <> maybe "" parens legalName
+    <> (", domains: "  <> T.intercalate ", " serverDomains)
+    <> (", conditions: " <> viewOpConditions conditionsAcceptance)
+    <> (", " <> viewOpEnabled op)
+
+shortViewOperator :: ServerOperator -> Text
+shortViewOperator op@ServerOperator {operatorId = DBEntityId opId, tradeName} =
+  tshow opId <> ". " <> tradeName <> parens (viewOpEnabled op)
+
+viewOpIdTag :: ServerOperator' s -> Text
+viewOpIdTag ServerOperator {operatorId, operatorTag} = case operatorId of
+  DBEntityId i -> tshow i <> " - " <> tag
+  DBNewEntity -> tag
+  where
+    tag = maybe "" textEncode operatorTag <> ". "
+
+viewOpConditions :: ConditionsAcceptance -> Text
+viewOpConditions = \case
+  CAAccepted ts -> viewCond "accepted" ts
+  CARequired ts -> viewCond "required" ts
+  where
+    viewCond w ts = w <> maybe "" (parens . tshow) ts
+
+viewOpEnabled :: ServerOperator' s -> Text
+viewOpEnabled ServerOperator {enabled, roles = ServerRoles {storage, proxy}}
+  | enabled && storage && proxy = "enabled"
+  | enabled && storage = "enabled storage"
+  | enabled && proxy = "enabled proxy"
+  | otherwise = "disabled"
+
+viewConditionsAction :: UsageConditionsAction -> [StyledString]
+viewConditionsAction = \case
+  UCAReview {operators, deadline, showNotice} | showNotice -> case deadline of
+    Just ts -> [plain $ "New conditions will be accepted at " <> tshow ts <> " for " <> ops]
+    Nothing -> [plain $ "New conditions have to be accepted for " <> ops]
+    where
+      ops = T.intercalate ", " $ map legalName_ operators
+      legalName_ ServerOperator {tradeName, legalName} = fromMaybe tradeName legalName
+  _ -> []
+
 viewChatItemTTL :: Maybe Int64 -> [StyledString]
 viewChatItemTTL = \case
   Nothing -> ["old messages are not being deleted"]
@@ -1331,11 +1382,11 @@ viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
   ["receiving messages via: " <> viewRcvQueuesInfo rcvQueuesInfo | not $ null rcvQueuesInfo]
     <> ["sending messages via: " <> viewSndQueuesInfo sndQueuesInfo | not $ null sndQueuesInfo]
 
-viewServers :: ProtocolTypeI p => [ServerOperator] -> NonEmpty (ServerCfg p) -> [StyledString]
-viewServers operators = map (plain . (\ServerCfg {server, operator} -> B.unpack (strEncode server) <> viewOperator operator)) . L.toList
-  where
-    ops :: Map (Maybe Int64) Text = foldl' (\m ServerOperator {operatorId, tradeName} -> M.insert (Just operatorId) tradeName m) M.empty operators
-    viewOperator = maybe "" $ \op -> " (operator " <> maybe (show op) T.unpack (M.lookup (Just op) ops) <> ")"
+-- viewServers :: ProtocolTypeI p => [ServerOperator] -> NonEmpty (ServerCfg p) -> [StyledString]
+-- viewServers operators = map (plain . (\ServerCfg {server, operator} -> B.unpack (strEncode server) <> viewOperator operator)) . L.toList
+--   where
+--     ops :: Map (Maybe DBEntityId) Text = foldl' (\m ServerOperator {operatorId, tradeName} -> M.insert (Just operatorId) tradeName m) M.empty operators
+--     viewOperator = maybe "" $ \op -> " (operator " <> maybe (show op) T.unpack (M.lookup (Just op) ops) <> ")"
 
 viewRcvQueuesInfo :: [RcvQueueInfo] -> StyledString
 viewRcvQueuesInfo = plain . intercalate ", " . map showQueueInfo
@@ -1934,7 +1985,9 @@ viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCo
       then [versionString version, updateStr, "simplexmq: " <> simplexmqVersion <> parens simplexmqCommit]
       else [versionString version, updateStr]
   where
-    parens s = " (" <> s <> ")"
+
+parens :: (IsString a, Semigroup a) => a -> a
+parens s = " (" <> s <> ")"
 
 viewRemoteHosts :: [RemoteHostInfo] -> [StyledString]
 viewRemoteHosts = \case

tests/ChatClient.hs

@@ -25,9 +25,10 @@ import Data.Maybe (isNothing)
 import qualified Data.Text as T
 import Network.Socket
 import Simplex.Chat
-import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), defaultSimpleNetCfg)
+import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), PresetServers (..), defaultSimpleNetCfg)
 import Simplex.Chat.Core
 import Simplex.Chat.Options
+import Simplex.Chat.Operators (PresetOperator (..), presetServer)
 import Simplex.Chat.Protocol (currentChatVersion, pqEncryptionCompressionVersion)
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Profiles
@@ -94,8 +95,8 @@ testCoreOpts =
     { dbFilePrefix = "./simplex_v1",
       dbKey = "",
       -- dbKey = "this is a pass-phrase to encrypt the database",
-      smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],
-      xftpServers = ["xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002"],
+      smpServers = [],
+      xftpServers = [],
       simpleNetCfg = defaultSimpleNetCfg,
       logLevel = CLLImportant,
       logConnections = False,
@@ -149,6 +150,18 @@ testCfg :: ChatConfig
 testCfg =
   defaultChatConfig
     { agentConfig = testAgentCfg,
+      presetServers =
+        (presetServers defaultChatConfig)
+          { operators =
+              [ PresetOperator
+                  { operator = Nothing,
+                    smp = map (presetServer True) ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],
+                    useSMP = 1,
+                    xftp = map (presetServer True) ["xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002"],
+                    useXFTP = 1
+                  }
+              ]
+          },
       showReceipts = False,
       testView = True,
       tbqSize = 16

tests/ChatTests/Direct.hs

@@ -25,7 +25,7 @@ import Database.SQLite.Simple (Only (..))
 import Simplex.Chat.AppSettings (defaultAppSettings)
 import qualified Simplex.Chat.AppSettings as AS
 import Simplex.Chat.Call
-import Simplex.Chat.Controller (ChatConfig (..), DefaultAgentServers (..))
+import Simplex.Chat.Controller (ChatConfig (..), PresetServers (..))
 import Simplex.Chat.Messages (ChatItemId)
 import Simplex.Chat.Options
 import Simplex.Chat.Protocol (supportedChatVRange)
@@ -334,8 +334,8 @@ testRetryConnectingClientTimeout tmp = do
               { quotaExceededTimeout = 1,
                 messageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
               },
-          defaultServers =
-            let def@DefaultAgentServers {netCfg} = defaultServers testCfg
+          presetServers =
+            let def@PresetServers {netCfg} = presetServers testCfg
              in def {netCfg = (netCfg :: NetworkConfig) {tcpTimeout = 10}}
         }
     opts' =
@@ -1141,17 +1141,32 @@ testGetSetSMPServers :: HasCallStack => FilePath -> IO ()
 testGetSetSMPServers =
   testChat2 aliceProfile bobProfile $
     \alice _ -> do
-      alice #$> ("/_servers 1 smp", id, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001")
+      alice ##> "/_servers 1"
+      alice <## "Your servers"
+      alice <## "  SMP servers"
+      alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset)"
+      alice <## "  XFTP servers"
+      alice <## "    xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 (preset)"      
       alice #$> ("/smp smp://1234-w==@smp1.example.im", id, "ok")
-      alice #$> ("/smp", id, "smp://1234-w==@smp1.example.im")
+      alice ##> "/smp"
+      alice <## "Your servers"
+      alice <## "  SMP servers"
+      alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset, disabled)"
+      alice <## "    smp://1234-w==@smp1.example.im"
       alice #$> ("/smp smp://1234-w==:password@smp1.example.im", id, "ok")
-      alice #$> ("/smp", id, "smp://1234-w==:password@smp1.example.im")
+      -- alice #$> ("/smp", id, "smp://1234-w==:password@smp1.example.im")
+      alice ##> "/smp"
+      alice <## "Your servers"
+      alice <## "  SMP servers"
+      alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset, disabled)"
+      alice <## "    smp://1234-w==:password@smp1.example.im"
       alice #$> ("/smp smp://2345-w==@smp2.example.im smp://3456-w==@smp3.example.im:5224", id, "ok")
       alice ##> "/smp"
-      alice <## "smp://2345-w==@smp2.example.im"
-      alice <## "smp://3456-w==@smp3.example.im:5224"
-      alice #$> ("/smp default", id, "ok")
-      alice #$> ("/smp", id, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001")
+      alice <## "Your servers"
+      alice <## "  SMP servers"
+      alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset, disabled)"
+      alice <## "    smp://2345-w==@smp2.example.im"
+      alice <## "    smp://3456-w==@smp3.example.im:5224"
 
 testTestSMPServerConnection :: HasCallStack => FilePath -> IO ()
 testTestSMPServerConnection =
@@ -1172,17 +1187,31 @@ testGetSetXFTPServers :: HasCallStack => FilePath -> IO ()
 testGetSetXFTPServers =
   testChat2 aliceProfile bobProfile $
     \alice _ -> withXFTPServer $ do
-      alice #$> ("/_servers 1 xftp", id, "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002")
+      alice ##> "/_servers 1"
+      alice <## "Your servers"
+      alice <## "  SMP servers"
+      alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset)"
+      alice <## "  XFTP servers"
+      alice <## "    xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 (preset)"
       alice #$> ("/xftp xftp://1234-w==@xftp1.example.im", id, "ok")
-      alice #$> ("/xftp", id, "xftp://1234-w==@xftp1.example.im")
+      alice ##> "/xftp"
+      alice <## "Your servers"
+      alice <## "  XFTP servers"
+      alice <## "    xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 (preset, disabled)"
+      alice <## "    xftp://1234-w==@xftp1.example.im"
       alice #$> ("/xftp xftp://1234-w==:password@xftp1.example.im", id, "ok")
-      alice #$> ("/xftp", id, "xftp://1234-w==:password@xftp1.example.im")
+      alice ##> "/xftp"
+      alice <## "Your servers"
+      alice <## "  XFTP servers"
+      alice <## "    xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 (preset, disabled)"
+      alice <## "    xftp://1234-w==:password@xftp1.example.im"
       alice #$> ("/xftp xftp://2345-w==@xftp2.example.im xftp://3456-w==@xftp3.example.im:5224", id, "ok")
       alice ##> "/xftp"
-      alice <## "xftp://2345-w==@xftp2.example.im"
-      alice <## "xftp://3456-w==@xftp3.example.im:5224"
-      alice #$> ("/xftp default", id, "ok")
-      alice #$> ("/xftp", id, "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002")
+      alice <## "Your servers"
+      alice <## "  XFTP servers"
+      alice <## "    xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 (preset, disabled)"
+      alice <## "    xftp://2345-w==@xftp2.example.im"
+      alice <## "    xftp://3456-w==@xftp3.example.im:5224"
 
 testTestXFTPServer :: HasCallStack => FilePath -> IO ()
 testTestXFTPServer =
@@ -1800,11 +1829,17 @@ testCreateUserSameServers =
   where
     checkCustomServers alice = do
       alice ##> "/smp"
-      alice <## "smp://2345-w==@smp2.example.im"
-      alice <## "smp://3456-w==@smp3.example.im:5224"
+      alice <## "Your servers"
+      alice <## "  SMP servers"
+      alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset, disabled)"
+      alice <## "    smp://2345-w==@smp2.example.im"
+      alice <## "    smp://3456-w==@smp3.example.im:5224"
       alice ##> "/xftp"
-      alice <## "xftp://2345-w==@xftp2.example.im"
-      alice <## "xftp://3456-w==@xftp3.example.im:5224"
+      alice <## "Your servers"
+      alice <## "  XFTP servers"
+      alice <## "    xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 (preset, disabled)"
+      alice <## "    xftp://2345-w==@xftp2.example.im"
+      alice <## "    xftp://3456-w==@xftp3.example.im:5224"
 
 testDeleteUser :: HasCallStack => FilePath -> IO ()
 testDeleteUser =

tests/ChatTests/Groups.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PostfixOperators #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module ChatTests.Groups where
 

tests/ChatTests/Profiles.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PostfixOperators #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module ChatTests.Profiles where
 
@@ -1733,7 +1734,16 @@ testChangePCCUserDiffSrv tmp = do
         -- Create new user with different servers
         alice ##> "/create user alisa"
         showActiveUser alice "alisa"
-        alice #$> ("/smp smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003", id, "ok")
+        alice ##> "/smp"
+        alice <## "Your servers"
+        alice <## "  SMP servers"
+        alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset)"
+        alice #$> ("/smp smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@127.0.0.1:7003", id, "ok")
+        alice ##> "/smp"
+        alice <## "Your servers"
+        alice <## "  SMP servers"
+        alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 (preset, disabled)"
+        alice <## "    smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@127.0.0.1:7003"
         alice ##> "/user alice"
         showActiveUser alice "alice (Alice)"
         -- Change connection to newly created user and use the newly created connection

tests/RandomServers.hs

@@ -1,53 +1,64 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module RandomServers where
 
 import Control.Monad (replicateM)
+import Data.Foldable (foldMap')
+import Data.List (sortOn)
+import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
-import Simplex.Chat (cfgServers, cfgServersToUse, defaultChatConfig, randomServers)
-import Simplex.Chat.Controller (ChatConfig (..))
-import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..))
+import Data.Monoid (Sum (..))
+import Simplex.Chat (defaultChatConfig, randomPresetServers)
+import Simplex.Chat.Controller (ChatConfig (..), PresetServers (..))
+import Simplex.Chat.Operators (DBEntityId' (..), NewUserServer, UserServer' (..), operatorServers, operatorServersToUse)
+import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SProtocolType (..), UserProtocol)
 import Test.Hspec
 
 randomServersTests :: Spec
 randomServersTests = describe "choosig random servers" $ do
-  it "should choose 4 random SMP servers and keep the rest disabled" testRandomSMPServers
-  it "should keep all 6 XFTP servers" testRandomXFTPServers
+  it "should choose 4 + 3 random SMP servers and keep the rest disabled" testRandomSMPServers
+  it "should choose 3 + 3 random XFTP servers and keep the rest disabled" testRandomXFTPServers
 
 deriving instance Eq ServerRoles
 
-deriving instance Eq (ServerCfg p)
+deriving instance Eq (DBEntityId' s)
+
+deriving instance Eq (UserServer' s p)
 
 testRandomSMPServers :: IO ()
 testRandomSMPServers = do
   [srvs1, srvs2, srvs3] <-
     replicateM 3 $
-      checkEnabled SPSMP 4 False =<< randomServers SPSMP defaultChatConfig
+      checkEnabled SPSMP 7 False =<< randomPresetServers SPSMP (presetServers defaultChatConfig)
   (srvs1 == srvs2 && srvs2 == srvs3) `shouldBe` False -- && to avoid rare failures
 
 testRandomXFTPServers :: IO ()
 testRandomXFTPServers = do
   [srvs1, srvs2, srvs3] <-
     replicateM 3 $
-      checkEnabled SPXFTP 6 True =<< randomServers SPXFTP defaultChatConfig
-  (srvs1 == srvs2 && srvs2 == srvs3) `shouldBe` True
+      checkEnabled SPXFTP 6 False =<< randomPresetServers SPXFTP (presetServers defaultChatConfig)
+  (srvs1 == srvs2 && srvs2 == srvs3) `shouldBe` False -- && to avoid rare failures
 
-checkEnabled :: UserProtocol p => SProtocolType p -> Int -> Bool -> (L.NonEmpty (ServerCfg p), [ServerCfg p]) -> IO [ServerCfg p]
-checkEnabled p n allUsed (srvs, _) = do
-  let def = defaultServers defaultChatConfig
-      cfgSrvs = L.sortWith server' $ cfgServers p def
-      toUse = cfgServersToUse p def
-  srvs == cfgSrvs `shouldBe` allUsed
-  L.map enable srvs `shouldBe` L.map enable cfgSrvs
-  let enbldSrvs = L.filter (\ServerCfg {enabled} -> enabled) srvs
+checkEnabled :: UserProtocol p => SProtocolType p -> Int -> Bool -> NonEmpty (NewUserServer p) -> IO [NewUserServer p]
+checkEnabled p n allUsed srvs = do
+  let srvs' = sortOn server' $ L.toList srvs
+      PresetServers {operators = presetOps} = presetServers defaultChatConfig
+      presetSrvs = sortOn server' $ concatMap (operatorServers p) presetOps
+      Sum toUse = foldMap' (Sum . operatorServersToUse p) presetOps
+  srvs' == presetSrvs `shouldBe` allUsed
+  map enable srvs' `shouldBe` map enable presetSrvs
+  let enbldSrvs = filter (\UserServer {enabled} -> enabled) srvs'
   toUse `shouldBe` n
   length enbldSrvs `shouldBe` n
   pure enbldSrvs
   where
-    server' ServerCfg {server = ProtoServerWithAuth srv _} = srv
-    enable :: forall p. ServerCfg p -> ServerCfg p
-    enable srv = (srv :: ServerCfg p) {enabled = False}
+    server' UserServer {server = ProtoServerWithAuth srv _} = srv
+    enable :: forall p. NewUserServer p -> NewUserServer p
+    enable srv = (srv :: NewUserServer p) {enabled = False}