core: choose random servers for the first user profile, use the same servers for other profiles (#4584)

* core: choose random servers for the first user profile, use the same servers for other profiles

* update ui clients

apps/ios/Shared/Model/SimpleXAPI.swift

@@ -137,8 +137,8 @@ func apiGetActiveUser(ctrl: chat_ctrl? = nil) throws -> User? {
     }
 }
 
-func apiCreateActiveUser(_ p: Profile?, sameServers: Bool = false, pastTimestamp: Bool = false, ctrl: chat_ctrl? = nil) throws -> User {
+func apiCreateActiveUser(_ p: Profile?, pastTimestamp: Bool = false, ctrl: chat_ctrl? = nil) throws -> User {
-    let r = chatSendCmdSync(.createActiveUser(profile: p, sameServers: sameServers, pastTimestamp: pastTimestamp), ctrl)
+    let r = chatSendCmdSync(.createActiveUser(profile: p, pastTimestamp: pastTimestamp), ctrl)
     if case let .activeUser(user) = r { return user }
     throw r
 }

apps/ios/SimpleXChat/APITypes.swift

@@ -15,7 +15,7 @@ public let jsonEncoder = getJSONEncoder()
 
 public enum ChatCommand {
     case showActiveUser
-    case createActiveUser(profile: Profile?, sameServers: Bool, pastTimestamp: Bool)
+    case createActiveUser(profile: Profile?, pastTimestamp: Bool)
     case listUsers
     case apiSetActiveUser(userId: Int64, viewPwd: String?)
     case setAllContactReceipts(enable: Bool)
@@ -156,8 +156,8 @@ public enum ChatCommand {
         get {
             switch self {
             case .showActiveUser: return "/u"
-            case let .createActiveUser(profile, sameServers, pastTimestamp):
+            case let .createActiveUser(profile, pastTimestamp):
-                let user = NewUser(profile: profile, sameServers: sameServers, pastTimestamp: pastTimestamp)
+                let user = NewUser(profile: profile, pastTimestamp: pastTimestamp)
                 return "/_create user \(encodeJSON(user))"
             case .listUsers: return "/users"
             case let .apiSetActiveUser(userId, viewPwd): return "/_user \(userId)\(maybePwd(viewPwd))"
@@ -1097,7 +1097,6 @@ public enum GroupLinkPlan: Decodable, Hashable {
 
 struct NewUser: Encodable, Hashable {
     var profile: Profile?
-    var sameServers: Bool
     var pastTimestamp: Bool
 }
 

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

@@ -657,8 +657,8 @@ object ChatController {
     return null
   }
 
-  suspend fun apiCreateActiveUser(rh: Long?, p: Profile?, sameServers: Boolean = false, pastTimestamp: Boolean = false, ctrl: ChatCtrl? = null): User? {
+  suspend fun apiCreateActiveUser(rh: Long?, p: Profile?, pastTimestamp: Boolean = false, ctrl: ChatCtrl? = null): User? {
-    val r = sendCmd(rh, CC.CreateActiveUser(p, sameServers = sameServers, pastTimestamp = pastTimestamp), ctrl)
+    val r = sendCmd(rh, CC.CreateActiveUser(p, pastTimestamp = pastTimestamp), ctrl)
     if (r is CR.ActiveUser) return r.user.updateRemoteHostId(rh)
     else if (
       r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorStore && r.chatError.storeError is StoreError.DuplicateName ||
@@ -2824,7 +2824,7 @@ class SharedPreference<T>(val get: () -> T, set: (T) -> Unit) {
 sealed class CC {
   class Console(val cmd: String): CC()
   class ShowActiveUser: CC()
-  class CreateActiveUser(val profile: Profile?, val sameServers: Boolean, val pastTimestamp: Boolean): CC()
+  class CreateActiveUser(val profile: Profile?, val pastTimestamp: Boolean): CC()
   class ListUsers: CC()
   class ApiSetActiveUser(val userId: Long, val viewPwd: String?): CC()
   class SetAllContactReceipts(val enable: Boolean): CC()
@@ -2962,7 +2962,7 @@ sealed class CC {
     is Console -> cmd
     is ShowActiveUser -> "/u"
     is CreateActiveUser -> {
-      val user = NewUser(profile, sameServers = sameServers, pastTimestamp = pastTimestamp)
+      val user = NewUser(profile, pastTimestamp = pastTimestamp)
       "/_create user ${json.encodeToString(user)}"
     }
     is ListUsers -> "/users"
@@ -3293,7 +3293,6 @@ fun onOff(b: Boolean): String = if (b) "on" else "off"
 @Serializable
 data class NewUser(
   val profile: Profile?,
-  val sameServers: Boolean,
   val pastTimestamp: Boolean
 )
 

simplex-chat.cabal

@@ -593,6 +593,7 @@ test-suite simplex-chat-test
       MessageBatching
       MobileTests
       ProtocolTests
+      RandomServers
       RemoteTests
       SchemaDump
       ValidNames

src/Simplex/Chat.hs

@@ -148,8 +148,10 @@ defaultChatConfig =
       defaultServers =
         DefaultAgentServers
           { smp = _defaultSMPServers,
+            useSMP = 4,
             ntf = _defaultNtfServers,
             xftp = L.map (presetServerCfg True) defaultXFTPServers,
+            useXFTP = L.length defaultXFTPServers,
             netCfg = defaultNetworkConfig
           },
       tbqSize = 1024,
@@ -178,7 +180,13 @@ _defaultSMPServers =
   L.fromList $
     map
       (presetServerCfg True)
-      [ "smp://h--vW7ZSkXPeOUpfxlFGgauQmXNFOzGoizak7Ult7cw=@smp15.simplex.im,oauu4bgijybyhczbnxtlggo6hiubahmeutaqineuyy23aojpih3dajad.onion",
+      [ "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",
@@ -188,13 +196,7 @@ _defaultSMPServers =
         (presetServerCfg 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",
+          "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
-          "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"
         ]
 
 _defaultNtfServers :: [NtfServer]
@@ -380,11 +382,31 @@ withFileLock name = withEntityLock name . CLFile
 useServers :: UserProtocol p => ChatConfig -> SProtocolType p -> [ServerCfg p] -> NonEmpty (ServerCfg p)
 useServers ChatConfig {defaultServers} p = fromMaybe (cfgServers p defaultServers) . nonEmpty
 
-cfgServers :: UserProtocol p => SProtocolType p -> (DefaultAgentServers -> NonEmpty (ServerCfg p))
+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')
+  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
+
 -- enableSndFiles has no effect when mainApp is True
 startChatController :: Bool -> Bool -> CM' (Async ())
 startChatController mainApp enableSndFiles = do
@@ -523,7 +545,7 @@ processChatCommand cmd =
 processChatCommand' :: VersionRangeChat -> ChatCommand -> CM ChatResponse
 processChatCommand' vr = \case
   ShowActiveUser -> withUser' $ pure . CRActiveUser
-  CreateActiveUser NewUser {profile, sameServers, pastTimestamp} -> do
+  CreateActiveUser NewUser {profile, pastTimestamp} -> do
     forM_ profile $ \Profile {displayName} -> checkValidName displayName
     p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile
     u <- asks currentUser
@@ -549,12 +571,10 @@ processChatCommand' vr = \case
           createContact db user simplexStatusContactProfile
           createContact db user simplexTeamContactProfile
       chooseServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> CM (NonEmpty (ServerCfg p), [ServerCfg p])
-      chooseServers protocol
+      chooseServers protocol =
-        | sameServers =
         asks currentUser >>= readTVarIO >>= \case
-              Nothing -> throwChatError CENoActiveUser
+          Nothing -> asks config >>= liftIO . randomServers protocol
           Just user -> chosenServers =<< withFastStore' (`getProtocolServers` user)
-        | otherwise = chosenServers []
         where
           chosenServers servers = do
             cfg <- asks config
@@ -7914,10 +7934,9 @@ chatCommandP =
     onOffP = ("on" $> True) <|> ("off" $> False)
     profileNames = (,) <$> displayName <*> fullNameP
     newUserP = do
-      sameServers <- "same_servers=" *> onOffP <* A.space <|> pure False
       (cName, fullName) <- profileNames
       let profile = Just Profile {displayName = cName, fullName, image = Nothing, contactLink = Nothing, preferences = Nothing}
-      pure NewUser {profile, sameServers, pastTimestamp = False}
+      pure NewUser {profile, pastTimestamp = False}
     jsonP :: J.FromJSON a => Parser a
     jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
     groupProfile = do

src/Simplex/Chat/Controller.hs

@@ -174,8 +174,10 @@ defaultChatHooks =
 
 data DefaultAgentServers = DefaultAgentServers
   { smp :: NonEmpty (ServerCfg 'PSMP),
+    useSMP :: Int,
     ntf :: [NtfServer],
     xftp :: NonEmpty (ServerCfg 'PXFTP),
+    useXFTP :: Int,
     netCfg :: NetworkConfig
   }
 

src/Simplex/Chat/Core.hs

@@ -105,7 +105,7 @@ createActiveUser cc = do
     loop = do
       displayName <- T.pack <$> getWithPrompt "display name"
       let profile = Just Profile {displayName, fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
-      execChatCommand' (CreateActiveUser NewUser {profile, sameServers = False, pastTimestamp = False}) `runReaderT` cc >>= \case
+      execChatCommand' (CreateActiveUser NewUser {profile, pastTimestamp = False}) `runReaderT` cc >>= \case
         CRActiveUser user -> pure user
         r -> do
           ts <- getCurrentTime

src/Simplex/Chat/Terminal.hs

@@ -39,8 +39,10 @@ terminalChatConfig =
                     "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) defaultXFTPServers,
+            useXFTP = L.length defaultXFTPServers,
             netCfg =
               defaultNetworkConfig
                 { smpProxyMode = SPMUnknown,

src/Simplex/Chat/Types.hs

@@ -124,7 +124,6 @@ data User = User
 
 data NewUser = NewUser
   { profile :: Maybe Profile,
-    sameServers :: Bool,
     pastTimestamp :: Bool
   }
   deriving (Show)

tests/ChatTests/Direct.hs

@@ -97,7 +97,6 @@ chatDirectTests = do
     it "create second user" testCreateSecondUser
     it "multiple users subscribe and receive messages after restart" testUsersSubscribeAfterRestart
     it "both users have contact link" testMultipleUserAddresses
-    it "create user with default servers" testCreateUserDefaultServers
     it "create user with same servers" testCreateUserSameServers
     it "delete user" testDeleteUser
     it "users have different chat item TTL configuration, chat items expire" testUsersDifferentCIExpirationTTL
@@ -1488,39 +1487,6 @@ testMultipleUserAddresses =
       showActiveUser alice "alice (Alice)"
       alice @@@ [("@bob", "hey alice")]
 
-testCreateUserDefaultServers :: HasCallStack => FilePath -> IO ()
-testCreateUserDefaultServers =
-  testChat2 aliceProfile bobProfile $
-    \alice _ -> do
-      alice #$> ("/smp smp://2345-w==@smp2.example.im smp://3456-w==@smp3.example.im:5224", id, "ok")
-      alice #$> ("/xftp xftp://2345-w==@xftp2.example.im xftp://3456-w==@xftp3.example.im:5224", id, "ok")
-      checkCustomServers alice
-
-      alice ##> "/create user alisa"
-      showActiveUser alice "alisa"
-
-      alice #$> ("/smp", id, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001")
-      alice #$> ("/xftp", id, "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002")
-
-      -- with same_servers=off
-      alice ##> "/user alice"
-      showActiveUser alice "alice (Alice)"
-      checkCustomServers alice
-
-      alice ##> "/create user same_servers=off alisa2"
-      showActiveUser alice "alisa2"
-
-      alice #$> ("/smp", id, "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001")
-      alice #$> ("/xftp", id, "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002")
-  where
-    checkCustomServers alice = do
-      alice ##> "/smp"
-      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"
-
 testCreateUserSameServers :: HasCallStack => FilePath -> IO ()
 testCreateUserSameServers =
   testChat2 aliceProfile bobProfile $
@@ -1529,7 +1495,7 @@ testCreateUserSameServers =
       alice #$> ("/xftp xftp://2345-w==@xftp2.example.im xftp://3456-w==@xftp3.example.im:5224", id, "ok")
       checkCustomServers alice
 
-      alice ##> "/create user same_servers=on alisa"
+      alice ##> "/create user alisa"
       showActiveUser alice "alisa"
 
       checkCustomServers alice

tests/RandomServers.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module RandomServers where
+
+import Control.Monad (replicateM)
+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 (..))
+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
+
+deriving instance Eq (ServerCfg p)
+
+testRandomSMPServers :: IO ()
+testRandomSMPServers = do
+  [srvs1, srvs2, srvs3] <-
+    replicateM 3 $
+      checkEnabled SPSMP 4 False =<< randomServers SPSMP 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 :: 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
+  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}

tests/Test.hs

@@ -10,6 +10,7 @@ import MarkdownTests
 import MessageBatching
 import MobileTests
 import ProtocolTests
+import RandomServers
 import RemoteTests
 import SchemaDump
 import Test.Hspec hiding (it)
@@ -30,6 +31,7 @@ main = do
     around tmpBracket $ describe "WebRTC encryption" webRTCTests
     describe "Valid names" validNameTests
     describe "Message batching" batchingTests
+    describe "Random servers" randomServersTests
     around testBracket $ do
       describe "Mobile API Tests" mobileTests
       describe "SimpleX chat client" chatTests