terminal: change default servers (#633)

This commit is contained in:
Evgeny Poberezkin 2022-05-11 16:52:08 +01:00 committed by GitHub
parent 0262ab53bf
commit 885a4ea972
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 44 additions and 22 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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