Files
simplex-chat/src/Simplex/Chat/Terminal.hs
2023-12-30 10:02:55 +00:00

73 lines
3.1 KiB
Haskell

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Terminal where
import Control.Exception (handle, throwIO)
import Control.Monad
import qualified Data.ByteArray as BA
import qualified Data.List.NonEmpty as L
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Database.SQLite.Simple (SQLError (..))
import qualified Database.SQLite.Simple as DB
import Simplex.Chat (defaultChatConfig)
import Simplex.Chat.Controller
import Simplex.Chat.Core
import Simplex.Chat.Help (chatWelcome)
import Simplex.Chat.Options
import Simplex.Chat.Terminal.Input
import Simplex.Chat.Terminal.Output
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.Messaging.Client (defaultNetworkConfig)
import Simplex.Messaging.Util (raceAny_)
import System.IO (hFlush, hSetEcho, stdin, stdout)
terminalChatConfig :: ChatConfig
terminalChatConfig =
defaultChatConfig
{ defaultServers =
DefaultAgentServers
{ smp =
L.fromList
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
],
ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
xftp = defaultXFTPServers,
netCfg = defaultNetworkConfig
},
deviceNameForRemote = "SimpleX CLI"
}
simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
simplexChatTerminal cfg options t = run options
where
run opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbKey}} =
handle checkDBKeyError . simplexChatCore cfg opts $ \u cc -> do
ct <- newChatTerminal t opts
when (firstTime cc) . printToTerminal ct $ chatWelcome u
runChatTerminal ct cc opts
where
checkDBKeyError :: SQLError -> IO ()
checkDBKeyError e = case sqlError e of
DB.ErrorNotADatabase -> do
putStrLn $ "Database file is invalid or " <> if BA.null dbKey then "encrypted." else "you passed an incorrect encryption key."
run =<< getKeyOpts
_ -> throwIO e
getKeyOpts :: IO ChatOpts
getKeyOpts = do
putStr "Enter database encryption key (Ctrl-C to exit):"
hFlush stdout
hSetEcho stdin False
key <- getLine
hSetEcho stdin True
putStrLn ""
pure opts {coreOptions = coreOptions {dbKey = BA.convert $ encodeUtf8 $ T.pack key}}
runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal ct cc opts = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc opts, runInputLoop ct cc]