mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 20:29:53 +00:00
terminal: change default servers (#633)
This commit is contained in:
parent
0262ab53bf
commit
885a4ea972
6 changed files with 44 additions and 22 deletions
|
@ -11,12 +11,12 @@ import Control.Concurrent.Async
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Simplex.Chat
|
|
||||||
import Simplex.Chat.Bot
|
import Simplex.Chat.Bot
|
||||||
import Simplex.Chat.Controller
|
import Simplex.Chat.Controller
|
||||||
import Simplex.Chat.Core
|
import Simplex.Chat.Core
|
||||||
import Simplex.Chat.Messages
|
import Simplex.Chat.Messages
|
||||||
import Simplex.Chat.Options
|
import Simplex.Chat.Options
|
||||||
|
import Simplex.Chat.Terminal (terminalChatConfig)
|
||||||
import Simplex.Chat.Types
|
import Simplex.Chat.Types
|
||||||
import System.Directory (getAppUserDataDirectory)
|
import System.Directory (getAppUserDataDirectory)
|
||||||
import Text.Read
|
import Text.Read
|
||||||
|
@ -24,7 +24,7 @@ import Text.Read
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
opts <- welcomeGetOpts
|
opts <- welcomeGetOpts
|
||||||
simplexChatCore defaultChatConfig opts Nothing mySquaringBot
|
simplexChatCore terminalChatConfig opts Nothing mySquaringBot
|
||||||
|
|
||||||
welcomeGetOpts :: IO ChatOpts
|
welcomeGetOpts :: IO ChatOpts
|
||||||
welcomeGetOpts = do
|
welcomeGetOpts = do
|
||||||
|
|
|
@ -2,18 +2,18 @@
|
||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Simplex.Chat
|
|
||||||
import Simplex.Chat.Bot
|
import Simplex.Chat.Bot
|
||||||
import Simplex.Chat.Controller (versionNumber)
|
import Simplex.Chat.Controller (versionNumber)
|
||||||
import Simplex.Chat.Core
|
import Simplex.Chat.Core
|
||||||
import Simplex.Chat.Options
|
import Simplex.Chat.Options
|
||||||
|
import Simplex.Chat.Terminal (terminalChatConfig)
|
||||||
import System.Directory (getAppUserDataDirectory)
|
import System.Directory (getAppUserDataDirectory)
|
||||||
import Text.Read
|
import Text.Read
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
opts <- welcomeGetOpts
|
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 ->
|
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
|
case readMaybe msg :: Maybe Integer of
|
||||||
Just n -> msg <> " * " <> msg <> " = " <> show (n * n)
|
Just n -> msg <> " * " <> msg <> " = " <> show (n * n)
|
||||||
|
|
|
@ -3,7 +3,6 @@
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
import Control.Concurrent (threadDelay)
|
||||||
import Simplex.Chat
|
|
||||||
import Simplex.Chat.Controller (versionNumber)
|
import Simplex.Chat.Controller (versionNumber)
|
||||||
import Simplex.Chat.Core
|
import Simplex.Chat.Core
|
||||||
import Simplex.Chat.Options
|
import Simplex.Chat.Options
|
||||||
|
@ -20,8 +19,8 @@ main = do
|
||||||
then do
|
then do
|
||||||
welcome opts
|
welcome opts
|
||||||
t <- withTerminal pure
|
t <- withTerminal pure
|
||||||
simplexChatTerminal defaultChatConfig opts t
|
simplexChatTerminal terminalChatConfig opts t
|
||||||
else simplexChatCore defaultChatConfig opts Nothing $ \_ cc -> do
|
else simplexChatCore terminalChatConfig opts Nothing $ \_ cc -> do
|
||||||
r <- sendChatCmd cc chatCmd
|
r <- sendChatCmd cc chatCmd
|
||||||
putStrLn $ serializeChatResponse r
|
putStrLn $ serializeChatResponse r
|
||||||
threadDelay $ chatCmdDelay opts * 1000000
|
threadDelay $ chatCmdDelay opts * 1000000
|
||||||
|
|
|
@ -86,6 +86,7 @@ defaultChatConfig =
|
||||||
},
|
},
|
||||||
dbPoolSize = 1,
|
dbPoolSize = 1,
|
||||||
yesToMigrations = False,
|
yesToMigrations = False,
|
||||||
|
defaultServers = InitialAgentServers {smp = _defaultSMPServers, ntf = _defaultNtfServers},
|
||||||
tbqSize = 64,
|
tbqSize = 64,
|
||||||
fileChunkSize = 15780,
|
fileChunkSize = 15780,
|
||||||
subscriptionConcurrency = 16,
|
subscriptionConcurrency = 16,
|
||||||
|
@ -93,30 +94,29 @@ defaultChatConfig =
|
||||||
testView = False
|
testView = False
|
||||||
}
|
}
|
||||||
|
|
||||||
defaultSMPServers :: NonEmpty SMPServer
|
_defaultSMPServers :: NonEmpty SMPServer
|
||||||
defaultSMPServers =
|
_defaultSMPServers =
|
||||||
L.fromList
|
L.fromList
|
||||||
[ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im",
|
[ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im",
|
||||||
"smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im",
|
"smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im",
|
||||||
"smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im"
|
"smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im"
|
||||||
]
|
]
|
||||||
|
|
||||||
defaultNtfServers :: [NtfServer]
|
_defaultNtfServers :: [NtfServer]
|
||||||
defaultNtfServers = ["smp://ZH1Dkt2_EQRbxUUyjLlcUjg1KAhBrqfvE0xfn7Ki0Zg=@ntf1.simplex.im"]
|
_defaultNtfServers = ["smp://ZH1Dkt2_EQRbxUUyjLlcUjg1KAhBrqfvE0xfn7Ki0Zg=@ntf1.simplex.im"]
|
||||||
|
|
||||||
logCfg :: LogConfig
|
logCfg :: LogConfig
|
||||||
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
|
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
|
||||||
|
|
||||||
newChatController :: SQLiteStore -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController
|
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
|
let f = chatStoreFile dbFilePrefix
|
||||||
config = cfg {subscriptionEvents = logConnections}
|
config = cfg {subscriptionEvents = logConnections}
|
||||||
sendNotification = fromMaybe (const $ pure ()) sendToast
|
sendNotification = fromMaybe (const $ pure ()) sendToast
|
||||||
activeTo <- newTVarIO ActiveNone
|
activeTo <- newTVarIO ActiveNone
|
||||||
firstTime <- not <$> doesFileExist f
|
firstTime <- not <$> doesFileExist f
|
||||||
currentUser <- newTVarIO user
|
currentUser <- newTVarIO user
|
||||||
initialSMPServers <- resolveServers
|
servers <- resolveServers defaultServers
|
||||||
let servers = InitialAgentServers {smp = initialSMPServers, ntf = defaultNtfServers}
|
|
||||||
smpAgent <- getSMPAgentClient aCfg {dbFile = dbFilePrefix <> "_agent.db"} servers
|
smpAgent <- getSMPAgentClient aCfg {dbFile = dbFilePrefix <> "_agent.db"} servers
|
||||||
agentAsync <- newTVarIO Nothing
|
agentAsync <- newTVarIO Nothing
|
||||||
idsDrg <- newTVarIO =<< drgNew
|
idsDrg <- newTVarIO =<< drgNew
|
||||||
|
@ -130,12 +130,14 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize} Ch
|
||||||
filesFolder <- newTVarIO Nothing
|
filesFolder <- newTVarIO Nothing
|
||||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder}
|
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder}
|
||||||
where
|
where
|
||||||
resolveServers :: IO (NonEmpty SMPServer)
|
resolveServers :: InitialAgentServers -> IO InitialAgentServers
|
||||||
resolveServers = case user of
|
resolveServers ss@InitialAgentServers {smp = defaultSMPServers} = case nonEmpty smpServers of
|
||||||
Nothing -> pure $ if null smpServers then defaultSMPServers else L.fromList smpServers
|
Just smpServers' -> pure ss {smp = smpServers'}
|
||||||
Just usr -> do
|
_ -> case user of
|
||||||
userSmpServers <- getSMPServers chatStore usr
|
Just usr -> do
|
||||||
pure . fromMaybe defaultSMPServers . nonEmpty $ if null smpServers then userSmpServers else smpServers
|
userSmpServers <- getSMPServers chatStore usr
|
||||||
|
pure ss {smp = fromMaybe defaultSMPServers $ nonEmpty userSmpServers}
|
||||||
|
_ -> pure ss
|
||||||
|
|
||||||
runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m ()
|
runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m ()
|
||||||
runChatController = race_ notificationSubscriber . agentSubscriber
|
runChatController = race_ notificationSubscriber . agentSubscriber
|
||||||
|
@ -482,6 +484,7 @@ processChatCommand = \case
|
||||||
GetUserSMPServers -> CRUserSMPServers <$> withUser (\user -> withStore (`getSMPServers` user))
|
GetUserSMPServers -> CRUserSMPServers <$> withUser (\user -> withStore (`getSMPServers` user))
|
||||||
SetUserSMPServers smpServers -> withUser $ \user -> withChatLock $ do
|
SetUserSMPServers smpServers -> withUser $ \user -> withChatLock $ do
|
||||||
withStore $ \st -> overwriteSMPServers st user smpServers
|
withStore $ \st -> overwriteSMPServers st user smpServers
|
||||||
|
ChatConfig {defaultServers = InitialAgentServers {smp = defaultSMPServers}} <- asks config
|
||||||
withAgent $ \a -> setSMPServers a (fromMaybe defaultSMPServers (nonEmpty smpServers))
|
withAgent $ \a -> setSMPServers a (fromMaybe defaultSMPServers (nonEmpty smpServers))
|
||||||
pure CRCmdOk
|
pure CRCmdOk
|
||||||
ChatHelp section -> pure $ CRChatHelp section
|
ChatHelp section -> pure $ CRChatHelp section
|
||||||
|
@ -759,7 +762,7 @@ processChatCommand = \case
|
||||||
removeFile fsFilePath `E.catch` \(_ :: E.SomeException) ->
|
removeFile fsFilePath `E.catch` \(_ :: E.SomeException) ->
|
||||||
removePathForcibly fsFilePath `E.catch` \(_ :: E.SomeException) -> pure ()
|
removePathForcibly fsFilePath `E.catch` \(_ :: E.SomeException) -> pure ()
|
||||||
cancelFiles :: User -> [(Int64, ACIFileStatus)] -> m ()
|
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) $
|
unless (ciFileEnded status) $
|
||||||
case dir of
|
case dir of
|
||||||
SMDSnd -> do
|
SMDSnd -> do
|
||||||
|
|
|
@ -33,7 +33,7 @@ import Simplex.Chat.Protocol
|
||||||
import Simplex.Chat.Store (StoreError)
|
import Simplex.Chat.Store (StoreError)
|
||||||
import Simplex.Chat.Types
|
import Simplex.Chat.Types
|
||||||
import Simplex.Messaging.Agent (AgentClient)
|
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.Protocol
|
||||||
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
|
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
|
||||||
import qualified Simplex.Messaging.Crypto as C
|
import qualified Simplex.Messaging.Crypto as C
|
||||||
|
@ -57,6 +57,7 @@ data ChatConfig = ChatConfig
|
||||||
{ agentConfig :: AgentConfig,
|
{ agentConfig :: AgentConfig,
|
||||||
dbPoolSize :: Int,
|
dbPoolSize :: Int,
|
||||||
yesToMigrations :: Bool,
|
yesToMigrations :: Bool,
|
||||||
|
defaultServers :: InitialAgentServers,
|
||||||
tbqSize :: Natural,
|
tbqSize :: Natural,
|
||||||
fileChunkSize :: Integer,
|
fileChunkSize :: Integer,
|
||||||
subscriptionConcurrency :: Int,
|
subscriptionConcurrency :: Int,
|
||||||
|
|
|
@ -1,9 +1,12 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Simplex.Chat.Terminal where
|
module Simplex.Chat.Terminal where
|
||||||
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
|
import qualified Data.List.NonEmpty as L
|
||||||
|
import Simplex.Chat (defaultChatConfig)
|
||||||
import Simplex.Chat.Controller
|
import Simplex.Chat.Controller
|
||||||
import Simplex.Chat.Core
|
import Simplex.Chat.Core
|
||||||
import Simplex.Chat.Help (chatWelcome)
|
import Simplex.Chat.Help (chatWelcome)
|
||||||
|
@ -11,8 +14,24 @@ import Simplex.Chat.Options
|
||||||
import Simplex.Chat.Terminal.Input
|
import Simplex.Chat.Terminal.Input
|
||||||
import Simplex.Chat.Terminal.Notification
|
import Simplex.Chat.Terminal.Notification
|
||||||
import Simplex.Chat.Terminal.Output
|
import Simplex.Chat.Terminal.Output
|
||||||
|
import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers (..))
|
||||||
import Simplex.Messaging.Util (raceAny_)
|
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 :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
|
||||||
simplexChatTerminal cfg opts t = do
|
simplexChatTerminal cfg opts t = do
|
||||||
sendToast <- initializeNotifications
|
sendToast <- initializeNotifications
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue