terminal: change default servers (#633)

apps/simplex-bot-advanced/Main.hs

@@ -11,12 +11,12 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Monad.Reader
 import qualified Data.Text as T
-import Simplex.Chat
 import Simplex.Chat.Bot
 import Simplex.Chat.Controller
 import Simplex.Chat.Core
 import Simplex.Chat.Messages
 import Simplex.Chat.Options
+import Simplex.Chat.Terminal (terminalChatConfig)
 import Simplex.Chat.Types
 import System.Directory (getAppUserDataDirectory)
 import Text.Read
@@ -24,7 +24,7 @@ import Text.Read
 main :: IO ()
 main = do
   opts <- welcomeGetOpts
-  simplexChatCore defaultChatConfig opts Nothing mySquaringBot
+  simplexChatCore terminalChatConfig opts Nothing mySquaringBot
 
 welcomeGetOpts :: IO ChatOpts
 welcomeGetOpts = do

apps/simplex-bot/Main.hs

@@ -2,18 +2,18 @@
 
 module Main where
 
-import Simplex.Chat
 import Simplex.Chat.Bot
 import Simplex.Chat.Controller (versionNumber)
 import Simplex.Chat.Core
 import Simplex.Chat.Options
+import Simplex.Chat.Terminal (terminalChatConfig)
 import System.Directory (getAppUserDataDirectory)
 import Text.Read
 
 main :: IO ()
 main = do
   opts <- welcomeGetOpts
-  simplexChatCore defaultChatConfig opts Nothing $
+  simplexChatCore terminalChatConfig opts Nothing $
     chatBotRepl "Hello! I am a simple squaring bot - if you send me a number, I will calculate its square" $ \msg ->
       case readMaybe msg :: Maybe Integer of
         Just n -> msg <> " * " <> msg <> " = " <> show (n * n)

apps/simplex-chat/Main.hs

@@ -3,7 +3,6 @@
 module Main where
 
 import Control.Concurrent (threadDelay)
-import Simplex.Chat
 import Simplex.Chat.Controller (versionNumber)
 import Simplex.Chat.Core
 import Simplex.Chat.Options
@@ -20,8 +19,8 @@ main = do
     then do
       welcome opts
       t <- withTerminal pure
-      simplexChatTerminal defaultChatConfig opts t
-    else simplexChatCore defaultChatConfig opts Nothing $ \_ cc -> do
+      simplexChatTerminal terminalChatConfig opts t
+    else simplexChatCore terminalChatConfig opts Nothing $ \_ cc -> do
       r <- sendChatCmd cc chatCmd
       putStrLn $ serializeChatResponse r
       threadDelay $ chatCmdDelay opts * 1000000

src/Simplex/Chat.hs

@@ -86,6 +86,7 @@ defaultChatConfig =
           },
       dbPoolSize = 1,
       yesToMigrations = False,
+      defaultServers = InitialAgentServers {smp = _defaultSMPServers, ntf = _defaultNtfServers},
       tbqSize = 64,
       fileChunkSize = 15780,
       subscriptionConcurrency = 16,
@@ -93,30 +94,29 @@ defaultChatConfig =
       testView = False
     }
 
-defaultSMPServers :: NonEmpty SMPServer
-defaultSMPServers =
+_defaultSMPServers :: NonEmpty SMPServer
+_defaultSMPServers =
   L.fromList
     [ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im",
       "smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im",
       "smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im"
     ]
 
-defaultNtfServers :: [NtfServer]
-defaultNtfServers = ["smp://ZH1Dkt2_EQRbxUUyjLlcUjg1KAhBrqfvE0xfn7Ki0Zg=@ntf1.simplex.im"]
+_defaultNtfServers :: [NtfServer]
+_defaultNtfServers = ["smp://ZH1Dkt2_EQRbxUUyjLlcUjg1KAhBrqfvE0xfn7Ki0Zg=@ntf1.simplex.im"]
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 newChatController :: SQLiteStore -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
-newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize} ChatOpts {dbFilePrefix, smpServers, logConnections} sendToast = do
+newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {dbFilePrefix, smpServers, logConnections} sendToast = do
   let f = chatStoreFile dbFilePrefix
       config = cfg {subscriptionEvents = logConnections}
       sendNotification = fromMaybe (const $ pure ()) sendToast
   activeTo <- newTVarIO ActiveNone
   firstTime <- not <$> doesFileExist f
   currentUser <- newTVarIO user
-  initialSMPServers <- resolveServers
-  let servers = InitialAgentServers {smp = initialSMPServers, ntf = defaultNtfServers}
+  servers <- resolveServers defaultServers
   smpAgent <- getSMPAgentClient aCfg {dbFile = dbFilePrefix <> "_agent.db"} servers
   agentAsync <- newTVarIO Nothing
   idsDrg <- newTVarIO =<< drgNew
@@ -130,12 +130,14 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize} Ch
   filesFolder <- newTVarIO Nothing
   pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder}
   where
-    resolveServers :: IO (NonEmpty SMPServer)
-    resolveServers = case user of
-      Nothing -> pure $ if null smpServers then defaultSMPServers else L.fromList smpServers
-      Just usr -> do
-        userSmpServers <- getSMPServers chatStore usr
-        pure . fromMaybe defaultSMPServers . nonEmpty $ if null smpServers then userSmpServers else smpServers
+    resolveServers :: InitialAgentServers -> IO InitialAgentServers
+    resolveServers ss@InitialAgentServers {smp = defaultSMPServers} = case nonEmpty smpServers of
+      Just smpServers' -> pure ss {smp = smpServers'}
+      _ -> case user of
+        Just usr -> do
+          userSmpServers <- getSMPServers chatStore usr
+          pure ss {smp = fromMaybe defaultSMPServers $ nonEmpty userSmpServers}
+        _ -> pure ss
 
 runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m ()
 runChatController = race_ notificationSubscriber . agentSubscriber
@@ -482,6 +484,7 @@ processChatCommand = \case
   GetUserSMPServers -> CRUserSMPServers <$> withUser (\user -> withStore (`getSMPServers` user))
   SetUserSMPServers smpServers -> withUser $ \user -> withChatLock $ do
     withStore $ \st -> overwriteSMPServers st user smpServers
+    ChatConfig {defaultServers = InitialAgentServers {smp = defaultSMPServers}} <- asks config
     withAgent $ \a -> setSMPServers a (fromMaybe defaultSMPServers (nonEmpty smpServers))
     pure CRCmdOk
   ChatHelp section -> pure $ CRChatHelp section
@@ -759,7 +762,7 @@ processChatCommand = \case
           removeFile fsFilePath `E.catch` \(_ :: E.SomeException) ->
             removePathForcibly fsFilePath `E.catch` \(_ :: E.SomeException) -> pure ()
     cancelFiles :: User -> [(Int64, ACIFileStatus)] -> m ()
-    cancelFiles user files = forM_ files $ \ (fileId, AFS dir status) ->
+    cancelFiles user files = forM_ files $ \(fileId, AFS dir status) ->
       unless (ciFileEnded status) $
         case dir of
           SMDSnd -> do

src/Simplex/Chat/Controller.hs

@@ -33,7 +33,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Store (StoreError)
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent (AgentClient)
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, InitialAgentServers)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import qualified Simplex.Messaging.Crypto as C
@@ -57,6 +57,7 @@ data ChatConfig = ChatConfig
   { agentConfig :: AgentConfig,
     dbPoolSize :: Int,
     yesToMigrations :: Bool,
+    defaultServers :: InitialAgentServers,
     tbqSize :: Natural,
     fileChunkSize :: Integer,
     subscriptionConcurrency :: Int,

src/Simplex/Chat/Terminal.hs

@@ -1,9 +1,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Simplex.Chat.Terminal where
 
 import Control.Monad.Except
+import qualified Data.List.NonEmpty as L
+import Simplex.Chat (defaultChatConfig)
 import Simplex.Chat.Controller
 import Simplex.Chat.Core
 import Simplex.Chat.Help (chatWelcome)
@@ -11,8 +14,24 @@ import Simplex.Chat.Options
 import Simplex.Chat.Terminal.Input
 import Simplex.Chat.Terminal.Notification
 import Simplex.Chat.Terminal.Output
+import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers (..))
 import Simplex.Messaging.Util (raceAny_)
 
+terminalChatConfig :: ChatConfig
+terminalChatConfig =
+  defaultChatConfig
+    { defaultServers =
+        InitialAgentServers
+          { smp =
+              L.fromList
+                [ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im",
+                  "smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im",
+                  "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im"
+                ],
+            ntf = ["smp://ZH1Dkt2_EQRbxUUyjLlcUjg1KAhBrqfvE0xfn7Ki0Zg=@ntf1.simplex.im"]
+          }
+    }
+
 simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
 simplexChatTerminal cfg opts t = do
   sendToast <- initializeNotifications