From 35a1ce49038b5009d71398bc66c6ba3e0b29e432 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sat, 18 Feb 2023 17:39:16 +0000 Subject: [PATCH] core: separate core options to use in bots (#1937) * core: separate core options to use in bots * ci: install pkg-config for mac --- .github/workflows/build.yml | 4 ++ apps/simplex-bot-advanced/Main.hs | 2 +- apps/simplex-bot/Main.hs | 2 +- apps/simplex-broadcast-bot/Main.hs | 6 +-- apps/simplex-broadcast-bot/Options.hs | 20 +++++++-- apps/simplex-chat/Main.hs | 2 +- src/Simplex/Chat.hs | 2 +- src/Simplex/Chat/Core.hs | 6 +-- src/Simplex/Chat/Mobile.hs | 29 +++++++------ src/Simplex/Chat/Options.hs | 60 +++++++++++++++++---------- tests/ChatClient.hs | 30 ++++++++------ tests/ChatTests/Direct.hs | 4 +- 12 files changed, 103 insertions(+), 64 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index fb9d271a4b..acf5b6f51e 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -91,6 +91,10 @@ jobs: echo " extra-lib-dirs: /usr/local/opt/openssl@1.1/lib" >> cabal.project.local echo " flags: +openssl" >> cabal.project.local + - name: Install pkg-config for Mac + if: matrix.os == 'macos-latest' + run: brew install pkg-config + - name: Unix prepare cabal.project.local for Ubuntu if: matrix.os == 'ubuntu-20.04' || matrix.os == 'ubuntu-18.04' shell: bash diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs index 5507234c36..1a2c06d617 100644 --- a/apps/simplex-bot-advanced/Main.hs +++ b/apps/simplex-bot-advanced/Main.hs @@ -28,7 +28,7 @@ main = do welcomeGetOpts :: IO ChatOpts welcomeGetOpts = do appDir <- getAppUserDataDirectory "simplex" - opts@ChatOpts {dbFilePrefix} <- getChatOpts appDir "simplex_bot" + opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getChatOpts appDir "simplex_bot" putStrLn $ "SimpleX Chat Bot v" ++ versionNumber putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db" pure opts diff --git a/apps/simplex-bot/Main.hs b/apps/simplex-bot/Main.hs index 95905070a7..d4ad9f9079 100644 --- a/apps/simplex-bot/Main.hs +++ b/apps/simplex-bot/Main.hs @@ -25,7 +25,7 @@ welcomeMessage = "Hello! I am a simple squaring bot.\nIf you send me a number, I welcomeGetOpts :: IO ChatOpts welcomeGetOpts = do appDir <- getAppUserDataDirectory "simplex" - opts@ChatOpts {dbFilePrefix} <- getChatOpts appDir "simplex_bot" + opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getChatOpts appDir "simplex_bot" putStrLn $ "SimpleX Chat Bot v" ++ versionNumber putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db" pure opts diff --git a/apps/simplex-broadcast-bot/Main.hs b/apps/simplex-broadcast-bot/Main.hs index 1897232b97..3a42b21e66 100644 --- a/apps/simplex-broadcast-bot/Main.hs +++ b/apps/simplex-broadcast-bot/Main.hs @@ -23,13 +23,13 @@ import System.Directory (getAppUserDataDirectory) main :: IO () main = do - opts@BroadcastBotOpts {chatOptions} <- welcomeGetOpts - simplexChatCore terminalChatConfig chatOptions Nothing $ broadcastBot opts + opts <- welcomeGetOpts + simplexChatCore terminalChatConfig (mkChatOpts opts) Nothing $ broadcastBot opts welcomeGetOpts :: IO BroadcastBotOpts welcomeGetOpts = do appDir <- getAppUserDataDirectory "simplex" - opts@BroadcastBotOpts {chatOptions = ChatOpts {dbFilePrefix}} <- getBroadcastBotOpts appDir "simplex_status_bot" + opts@BroadcastBotOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getBroadcastBotOpts appDir "simplex_status_bot" putStrLn $ "SimpleX Chat Bot v" ++ versionNumber putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db" pure opts diff --git a/apps/simplex-broadcast-bot/Options.hs b/apps/simplex-broadcast-bot/Options.hs index 953d340242..e6c20a4276 100644 --- a/apps/simplex-broadcast-bot/Options.hs +++ b/apps/simplex-broadcast-bot/Options.hs @@ -14,7 +14,7 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Options.Applicative import Simplex.Chat.Controller (updateStr, versionNumber, versionString) -import Simplex.Chat.Options +import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts, coreChatOptsP) import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Util (safeDecodeUtf8) @@ -25,7 +25,7 @@ data Publisher = Publisher deriving (Eq) data BroadcastBotOpts = BroadcastBotOpts - { chatOptions :: ChatOpts, + { coreOptions :: CoreChatOpts, publishers :: [Publisher], welcomeMessage :: String, prohibitedMessage :: String @@ -42,7 +42,7 @@ publisherNames = T.unpack . T.intercalate ", " . map (("@" <>) . localDisplayNam broadcastBotOpts :: FilePath -> FilePath -> Parser BroadcastBotOpts broadcastBotOpts appDir defaultDbFileName = do - chatOptions <- chatOptsP appDir defaultDbFileName + coreOptions <- coreChatOptsP appDir defaultDbFileName publishers <- option parsePublishers @@ -68,7 +68,7 @@ broadcastBotOpts appDir defaultDbFileName = do ) pure BroadcastBotOpts - { chatOptions, + { coreOptions, publishers, welcomeMessage = fromMaybe (defaultWelcomeMessage publishers) welcomeMessage_, prohibitedMessage = fromMaybe (defaultProhibitedMessage publishers) prohibitedMessage_ @@ -95,3 +95,15 @@ getBroadcastBotOpts appDir defaultDbFileName = versionStr = versionString versionNumber versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version") versionAndUpdate = versionStr <> "\n" <> updateStr + +mkChatOpts :: BroadcastBotOpts -> ChatOpts +mkChatOpts BroadcastBotOpts {coreOptions} = + ChatOpts + { coreOptions, + chatCmd = "", + chatCmdDelay = 3, + chatServerPort = Nothing, + optFilesFolder = Nothing, + allowInstantFiles = True, + maintenance = False + } diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs index 0b4a7bbe55..06ed0759d9 100644 --- a/apps/simplex-chat/Main.hs +++ b/apps/simplex-chat/Main.hs @@ -33,7 +33,7 @@ main = do threadDelay $ chatCmdDelay opts * 1000000 welcome :: ChatOpts -> IO () -welcome ChatOpts {dbFilePrefix, networkConfig} = +welcome ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, networkConfig}} = mapM_ putStrLn [ versionString versionNumber, diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index bac1018dbd..363371af85 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -139,7 +139,7 @@ createChatDatabase filePrefix key yesToMigrations = do pure ChatDatabase {chatStore, agentStore} newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController -newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles} ChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, tbqSize, optFilesFolder, allowInstantFiles} sendToast = do +newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'} sendNotification = fromMaybe (const $ pure ()) sendToast diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index a458c0f76f..83bed16bf3 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -9,13 +9,13 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Simplex.Chat import Simplex.Chat.Controller -import Simplex.Chat.Options (ChatOpts (..)) +import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..)) import Simplex.Chat.Types import UnliftIO.Async simplexChatCore :: ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> (User -> ChatController -> IO ()) -> IO () -simplexChatCore cfg@ChatConfig {yesToMigrations} opts@ChatOpts {dbFilePrefix, dbKey} sendToast chat - | logAgent opts = do +simplexChatCore cfg@ChatConfig {yesToMigrations} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} sendToast chat + | logAgent = do setLogLevel LogInfo -- LogError withGlobalLogging logCfg initRun | otherwise = initRun diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 2de9921b24..36c21088b3 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -122,18 +122,21 @@ cChatParseMarkdown s = newCAString . chatParseMarkdown =<< peekCAString s cChatParseServer :: CString -> IO CJSONString cChatParseServer s = newCAString . chatParseServer =<< peekCAString s -mobileChatOpts :: ChatOpts -mobileChatOpts = +mobileChatOpts :: String -> String -> ChatOpts +mobileChatOpts dbFilePrefix dbKey = ChatOpts - { dbFilePrefix = undefined, - dbKey = "", - smpServers = [], - networkConfig = defaultNetworkConfig, - logLevel = CLLImportant, - logConnections = False, - logServerHosts = True, - logAgent = False, - tbqSize = 64, + { coreOptions = + CoreChatOpts + { dbFilePrefix, + dbKey, + smpServers = [], + networkConfig = defaultNetworkConfig, + logLevel = CLLImportant, + logConnections = False, + logServerHosts = True, + logAgent = False, + tbqSize = 64 + }, chatCmd = "", chatCmdDelay = 3, chatServerPort = Nothing, @@ -172,7 +175,7 @@ chatMigrateInit dbFilePrefix dbKey = runExceptT $ do where initialize st db = do user_ <- getActiveUser_ st - newChatController db user_ defaultMobileConfig mobileChatOpts {dbFilePrefix, dbKey} Nothing + newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix dbKey) Nothing migrate createStore dbFile = ExceptT $ (Right <$> createStore dbFile dbKey True) @@ -209,7 +212,7 @@ chatInitKey :: String -> String -> IO ChatController chatInitKey dbFilePrefix dbKey = do db@ChatDatabase {chatStore} <- createChatDatabase dbFilePrefix dbKey True user_ <- getActiveUser_ chatStore - newChatController db user_ defaultMobileConfig mobileChatOpts {dbFilePrefix, dbKey} Nothing + newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix dbKey) Nothing chatSendCmd :: ChatController -> String -> IO JSONString chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index 1d9a297165..749c90c1df 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -7,7 +7,9 @@ module Simplex.Chat.Options ( ChatOpts (..), + CoreChatOpts (..), chatOptsP, + coreChatOptsP, getChatOpts, smpServersP, fullNetworkConfig, @@ -27,15 +29,7 @@ import Simplex.Messaging.Transport.Client (SocksProxy, defaultSocksProxy) import System.FilePath (combine) data ChatOpts = ChatOpts - { dbFilePrefix :: String, - dbKey :: String, - smpServers :: [SMPServerWithAuth], - networkConfig :: NetworkConfig, - logLevel :: ChatLogLevel, - logConnections :: Bool, - logServerHosts :: Bool, - logAgent :: Bool, - tbqSize :: Natural, + { coreOptions :: CoreChatOpts, chatCmd :: String, chatCmdDelay :: Int, chatServerPort :: Maybe String, @@ -44,8 +38,20 @@ data ChatOpts = ChatOpts maintenance :: Bool } -chatOptsP :: FilePath -> FilePath -> Parser ChatOpts -chatOptsP appDir defaultDbFileName = do +data CoreChatOpts = CoreChatOpts + { dbFilePrefix :: String, + dbKey :: String, + smpServers :: [SMPServerWithAuth], + networkConfig :: NetworkConfig, + logLevel :: ChatLogLevel, + logConnections :: Bool, + logServerHosts :: Bool, + logAgent :: Bool, + tbqSize :: Natural + } + +coreChatOptsP :: FilePath -> FilePath -> Parser CoreChatOpts +coreChatOptsP appDir defaultDbFileName = do dbFilePrefix <- strOption ( long "database" @@ -129,6 +135,25 @@ chatOptsP appDir defaultDbFileName = do <> value 64 <> showDefault ) + pure + CoreChatOpts + { dbFilePrefix, + dbKey, + smpServers, + networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel == CLLDebug), + logLevel, + logConnections = logConnections || logLevel <= CLLInfo, + logServerHosts = logServerHosts || logLevel <= CLLInfo, + logAgent = logAgent || logLevel == CLLDebug, + tbqSize + } + where + useTcpTimeout p t = 1000000 * if t > 0 then t else maybe 5 (const 10) p + defaultDbFilePath = combine appDir defaultDbFileName + +chatOptsP :: FilePath -> FilePath -> Parser ChatOpts +chatOptsP appDir defaultDbFileName = do + coreOptions <- coreChatOptsP appDir defaultDbFileName chatCmd <- strOption ( long "execute" @@ -177,15 +202,7 @@ chatOptsP appDir defaultDbFileName = do ) pure ChatOpts - { dbFilePrefix, - dbKey, - smpServers, - networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel == CLLDebug), - logLevel, - logConnections = logConnections || logLevel <= CLLInfo, - logServerHosts = logServerHosts || logLevel <= CLLInfo, - logAgent = logAgent || logLevel == CLLDebug, - tbqSize, + { coreOptions, chatCmd, chatCmdDelay, chatServerPort, @@ -193,9 +210,6 @@ chatOptsP appDir defaultDbFileName = do allowInstantFiles, maintenance } - where - useTcpTimeout p t = 1000000 * if t > 0 then t else maybe 5 (const 10) p - defaultDbFilePath = combine appDir defaultDbFileName fullNetworkConfig :: Maybe SocksProxy -> Int -> Bool -> NetworkConfig fullNetworkConfig socksProxy tcpTimeout logTLSErrors = diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index b3ad01cb19..cdbf91ee22 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -49,16 +49,19 @@ serverPort = "7001" testOpts :: ChatOpts testOpts = ChatOpts - { dbFilePrefix = undefined, - dbKey = "", - -- dbKey = "this is a pass-phrase to encrypt the database", - smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"], - networkConfig = defaultNetworkConfig, - logLevel = CLLImportant, - logConnections = False, - logServerHosts = False, - logAgent = False, - tbqSize = 64, + { coreOptions = + CoreChatOpts + { dbFilePrefix = undefined, + dbKey = "", + -- dbKey = "this is a pass-phrase to encrypt the database", + smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"], + networkConfig = defaultNetworkConfig, + logLevel = CLLImportant, + logConnections = False, + logServerHosts = False, + logAgent = False, + tbqSize = 64 + }, chatCmd = "", chatCmdDelay = 3, chatServerPort = Nothing, @@ -67,6 +70,9 @@ testOpts = maintenance = False } +getTestOpts :: Bool -> String -> ChatOpts +getTestOpts maintenance dbKey = testOpts {maintenance, coreOptions = (coreOptions testOpts) {dbKey}} + termSettings :: VirtualTerminalSettings termSettings = VirtualTerminalSettings @@ -109,13 +115,13 @@ testCfgV1 :: ChatConfig testCfgV1 = testCfg {agentConfig = testAgentCfgV1} createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC -createTestChat tmp cfg opts@ChatOpts {dbKey} dbPrefix profile = do +createTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefix profile = do db@ChatDatabase {chatStore} <- createChatDatabase (tmp dbPrefix) dbKey False Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True startTestChat_ db cfg opts user startTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> IO TestCC -startTestChat tmp cfg opts@ChatOpts {dbKey} dbPrefix = do +startTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefix = do db@ChatDatabase {chatStore} <- createChatDatabase (tmp dbPrefix) dbKey False Just user <- find activeUser <$> withTransaction chatStore getUsers startTestChat_ db cfg opts user diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 7754ccf2e7..56af5048ca 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -758,7 +758,7 @@ testDatabaseEncryption tmp = do alice <## "ok" alice ##> "/_start" alice <## "error: chat store changed, please restart chat" - withTestChatOpts tmp testOpts {maintenance = True, dbKey = "mykey"} "alice" $ \alice -> do + withTestChatOpts tmp (getTestOpts True "mykey") "alice" $ \alice -> do alice ##> "/_start" alice <## "chat started" testChatWorking alice bob @@ -770,7 +770,7 @@ testDatabaseEncryption tmp = do alice <## "ok" alice ##> "/_db encryption {\"currentKey\":\"nextkey\",\"newKey\":\"anotherkey\"}" alice <## "ok" - withTestChatOpts tmp testOpts {maintenance = True, dbKey = "anotherkey"} "alice" $ \alice -> do + withTestChatOpts tmp (getTestOpts True "anotherkey") "alice" $ \alice -> do alice ##> "/_start" alice <## "chat started" testChatWorking alice bob