mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-03 17:55:52 +00:00
d3059afc99
* core: forward notifications about message processing (for iOS notifications) * simplexmq * the option to keep database key, to allow re-opening the database * export new init with keepKey and reopen DB api * stop remote ctrl when suspending chat * ios: close/re-open db on suspend/activate * allow activating chat without restoring (for NSE) * update NSE to suspend/activate (does not work) * simplexmq * suspend chat and close database when last notification in the process is processed * stop reading notifications on message markers * replace async stream with cancellable concurrent queue * better synchronization of app and NSE * remove outside of task * remove unused var * whitespace * more debug logging, handle cancelled read after dequeue * comments * more comments
47 lines
1.7 KiB
Haskell
47 lines
1.7 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
module Simplex.Chat.Core where
|
|
|
|
import Control.Logger.Simple
|
|
import Control.Monad.Reader
|
|
import qualified Data.Text as T
|
|
import Data.Text.Encoding (encodeUtf8)
|
|
import Simplex.Chat
|
|
import Simplex.Chat.Controller
|
|
import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
|
|
import Simplex.Chat.Types
|
|
import System.Exit (exitFailure)
|
|
import UnliftIO.Async
|
|
|
|
simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
|
|
simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} chat =
|
|
case logAgent of
|
|
Just level -> do
|
|
setLogLevel level
|
|
withGlobalLogging logCfg initRun
|
|
_ -> initRun
|
|
where
|
|
initRun = createChatDatabase dbFilePrefix dbKey False confirmMigrations >>= either exit run
|
|
exit e = do
|
|
putStrLn $ "Error opening database: " <> show e
|
|
exitFailure
|
|
run db@ChatDatabase {chatStore} = do
|
|
u <- getCreateActiveUser chatStore testView
|
|
cc <- newChatController db (Just u) cfg opts
|
|
runSimplexChat opts u cc chat
|
|
|
|
runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
|
|
runSimplexChat ChatOpts {maintenance} u cc chat
|
|
| maintenance = wait =<< async (chat u cc)
|
|
| otherwise = do
|
|
a1 <- runReaderT (startChatController True True True) cc
|
|
a2 <- async $ chat u cc
|
|
waitEither_ a1 a2
|
|
|
|
sendChatCmdStr :: ChatController -> String -> IO ChatResponse
|
|
sendChatCmdStr cc s = runReaderT (execChatCommand Nothing . encodeUtf8 $ T.pack s) cc
|
|
|
|
sendChatCmd :: ChatController -> ChatCommand -> IO ChatResponse
|
|
sendChatCmd cc cmd = runReaderT (execChatCommand' cmd) cc
|