diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs index bb81911913..6b31a62dce 100644 --- a/apps/simplex-bot-advanced/Main.hs +++ b/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 diff --git a/apps/simplex-bot/Main.hs b/apps/simplex-bot/Main.hs index 1c322dbc18..2228070039 100644 --- a/apps/simplex-bot/Main.hs +++ b/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) diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index 0a94c77935..821bc2a270 100644 --- a/apps/simplex-chat/Main.hs +++ b/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 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index cc6cab47b2..2bd6bdfd00 100644 --- a/src/Simplex/Chat.hs +++ b/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 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index f43b42b449..9eca5c606a 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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, diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index 4b1a6b8a4a..c1bfcc8bbd 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/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