diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 3965b6087..1306f26ea 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -133,14 +133,12 @@ createChatDatabase filePrefix key yesToMigrations = do newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts} sendToast = do - servers <- resolveServers defaultServers - let servers' = servers {netCfg = networkConfig} - config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = servers'} + let config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers} sendNotification = fromMaybe (const $ pure ()) sendToast firstTime = dbNew chatStore activeTo <- newTVarIO ActiveNone currentUser <- newTVarIO user - smpAgent <- getSMPAgentClient aCfg {database = AgentDB agentStore} servers' + smpAgent <- getSMPAgentClient aCfg {database = AgentDB agentStore} =<< agentServers config agentAsync <- newTVarIO Nothing idsDrg <- newTVarIO =<< drgNew inputQ <- newTBQueueIO tbqSize @@ -157,18 +155,20 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen expireCIs <- newTVarIO False pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIsAsync, expireCIs} where - resolveServers :: InitialAgentServers -> IO InitialAgentServers - resolveServers ss = case nonEmpty smpServers of - Just smpServers' -> pure ss {smp = L.map (\ServerCfg {server} -> server) smpServers'} - _ -> case user of - Just user' -> do - userSmpServers <- withTransaction chatStore (`getSMPServers` user') - pure ss {smp = activeAgentServers cfg userSmpServers} - _ -> pure ss + configServers :: InitialAgentServers + configServers = + let smp' = fromMaybe (smp defaultServers) (nonEmpty smpServers) + in defaultServers {smp = smp', netCfg = networkConfig} + agentServers :: ChatConfig -> IO InitialAgentServers + agentServers config@ChatConfig {defaultServers = ss@InitialAgentServers {smp}} = do + smp' <- maybe (pure smp) userServers user + pure ss {smp = smp'} + where + userServers user' = activeAgentServers config <$> withTransaction chatStore (`getSMPServers` user') activeAgentServers :: ChatConfig -> [ServerCfg] -> NonEmpty SMPServerWithAuth -activeAgentServers ChatConfig {defaultServers = InitialAgentServers {smp = defaultSMPServers}} = - fromMaybe defaultSMPServers +activeAgentServers ChatConfig {defaultServers = InitialAgentServers {smp}} = + fromMaybe smp . nonEmpty . map (\ServerCfg {server} -> server) . filter (\ServerCfg {enabled} -> enabled) @@ -3219,12 +3219,12 @@ chatCommandP = "/_members #" *> (APIListMembers <$> A.decimal), -- /smp_servers is deprecated, use /smp and /_smp "/smp_servers default" $> SetUserSMPServers (SMPServersConfig []), - "/smp_servers " *> (SetUserSMPServers . SMPServersConfig <$> smpServersP), + "/smp_servers " *> (SetUserSMPServers . SMPServersConfig . map toServerCfg <$> smpServersP), "/smp_servers" $> GetUserSMPServers, "/smp default" $> SetUserSMPServers (SMPServersConfig []), "/smp test " *> (TestSMPServer <$> strP), "/_smp " *> (SetUserSMPServers <$> jsonP), - "/smp " *> (SetUserSMPServers . SMPServersConfig <$> smpServersP), + "/smp " *> (SetUserSMPServers . SMPServersConfig . map toServerCfg <$> smpServersP), "/smp" $> GetUserSMPServers, "/_ttl " *> (APISetChatItemTTL <$> ciTTLDecimal), "/ttl " *> (APISetChatItemTTL <$> ciTTL), @@ -3373,6 +3373,7 @@ chatCommandP = onOffP (Just <$> (AutoAccept <$> (" incognito=" *> onOffP <|> pure False) <*> optional (A.space *> msgContentP))) (pure Nothing) + toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True} adminContactReq :: ConnReqContact adminContactReq = diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index 36119ebf6..e933ac2a3 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -16,17 +16,17 @@ import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteString.Char8 as B import Options.Applicative import Simplex.Chat.Controller (updateStr, versionStr) -import Simplex.Chat.Types (ServerCfg (..)) import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (parseAll) +import Simplex.Messaging.Protocol (SMPServerWithAuth) import Simplex.Messaging.Transport.Client (SocksProxy, defaultSocksProxy) import System.FilePath (combine) data ChatOpts = ChatOpts { dbFilePrefix :: String, dbKey :: String, - smpServers :: [ServerCfg], + smpServers :: [SMPServerWithAuth], networkConfig :: NetworkConfig, logConnections :: Bool, logServerHosts :: Bool, @@ -155,7 +155,7 @@ fullNetworkConfig socksProxy tcpTimeout = let tcpConnectTimeout = (tcpTimeout * 3) `div` 2 in defaultNetworkConfig {socksProxy, tcpTimeout, tcpConnectTimeout} -parseSMPServers :: ReadM [ServerCfg] +parseSMPServers :: ReadM [SMPServerWithAuth] parseSMPServers = eitherReader $ parseAll smpServersP . B.pack parseSocksProxy :: ReadM (Maybe SocksProxy) @@ -167,10 +167,8 @@ parseServerPort = eitherReader $ parseAll serverPortP . B.pack serverPortP :: A.Parser (Maybe String) serverPortP = Just . B.unpack <$> A.takeWhile A.isDigit -smpServersP :: A.Parser [ServerCfg] -smpServersP = (toServerCfg <$> strP) `A.sepBy1` A.char ';' - where - toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True} +smpServersP :: A.Parser [SMPServerWithAuth] +smpServersP = strP `A.sepBy1` A.char ';' getChatOpts :: FilePath -> FilePath -> IO ChatOpts getChatOpts appDir defaultDbFileName = diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 57b80a109..11ab2771d 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -25,7 +25,7 @@ import Simplex.Chat.Options import Simplex.Chat.Store import Simplex.Chat.Terminal import Simplex.Chat.Terminal.Output (newChatTerminal) -import Simplex.Chat.Types (Profile, ServerCfg (..), User (..)) +import Simplex.Chat.Types (Profile, User (..)) import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultNetworkConfig) @@ -51,7 +51,7 @@ testOpts = { dbFilePrefix = undefined, dbKey = "", -- dbKey = "this is a pass-phrase to encrypt the database", - smpServers = [ServerCfg "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:5001" False Nothing True], + smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:5001"], networkConfig = defaultNetworkConfig, logConnections = False, logServerHosts = False,