2022-04-10 17:13:06 +01:00
|
|
|
{-# 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 (..))
|
|
|
|
import Simplex.Chat.Store
|
|
|
|
import Simplex.Chat.Types
|
|
|
|
import UnliftIO.Async
|
|
|
|
|
|
|
|
simplexChatCore :: ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> (User -> ChatController -> IO ()) -> IO ()
|
2022-06-16 20:00:51 +01:00
|
|
|
simplexChatCore cfg@ChatConfig {yesToMigrations} opts sendToast chat
|
2022-04-10 17:13:06 +01:00
|
|
|
| logAgent opts = do
|
|
|
|
setLogLevel LogInfo -- LogError
|
|
|
|
withGlobalLogging logCfg initRun
|
|
|
|
| otherwise = initRun
|
|
|
|
where
|
|
|
|
initRun = do
|
|
|
|
let f = chatStoreFile $ dbFilePrefix opts
|
2022-06-16 20:00:51 +01:00
|
|
|
st <- createStore f yesToMigrations
|
2022-04-10 17:13:06 +01:00
|
|
|
u <- getCreateActiveUser st
|
|
|
|
cc <- newChatController st (Just u) cfg opts sendToast
|
2022-06-06 16:23:47 +01:00
|
|
|
runSimplexChat opts u cc chat
|
2022-04-10 17:13:06 +01:00
|
|
|
|
2022-06-06 16:23:47 +01:00
|
|
|
runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
|
|
|
|
runSimplexChat ChatOpts {maintenance} u cc chat
|
|
|
|
| maintenance = wait =<< async (chat u cc)
|
|
|
|
| otherwise = do
|
|
|
|
a1 <- async $ chat u cc
|
2022-06-21 11:25:12 +01:00
|
|
|
a2 <- runReaderT (startChatController u True) cc
|
2022-06-06 16:23:47 +01:00
|
|
|
waitEither_ a1 a2
|
2022-04-10 17:13:06 +01:00
|
|
|
|
|
|
|
sendChatCmd :: ChatController -> String -> IO ChatResponse
|
|
|
|
sendChatCmd cc s = runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc
|