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
This commit is contained in:
Evgeny 2024-08-06 16:13:36 +01:00 committed by GitHub
parent f6ee6338c4
commit 7441ed9892
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
12 changed files with 106 additions and 66 deletions

View file

@ -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 } if case let .activeUser(user) = r { return user }
throw r throw r
} }

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -105,7 +105,7 @@ createActiveUser cc = do
loop = do loop = do
displayName <- T.pack <$> getWithPrompt "display name" displayName <- T.pack <$> getWithPrompt "display name"
let profile = Just Profile {displayName, fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing} 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 CRActiveUser user -> pure user
r -> do r -> do
ts <- getCurrentTime ts <- getCurrentTime

View file

@ -39,8 +39,10 @@ terminalChatConfig =
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.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"
], ],
useSMP = 3,
ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"], ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
xftp = L.map (presetServerCfg True) defaultXFTPServers, xftp = L.map (presetServerCfg True) defaultXFTPServers,
useXFTP = L.length defaultXFTPServers,
netCfg = netCfg =
defaultNetworkConfig defaultNetworkConfig
{ smpProxyMode = SPMUnknown, { smpProxyMode = SPMUnknown,

View file

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

View file

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

51
tests/RandomServers.hs Normal file
View file

@ -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}

View file

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