{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

module Simplex.Chat.Terminal where

import Control.Monad
import qualified Data.List.NonEmpty as L
import Simplex.Chat (defaultChatConfig)
import Simplex.Chat.Controller
import Simplex.Chat.Core
import Simplex.Chat.Help (chatWelcome)
import Simplex.Chat.Library.Commands (_defaultNtfServers)
import Simplex.Chat.Operators
import Simplex.Chat.Operators.Presets (operatorSimpleXChat)
import Simplex.Chat.Options
import Simplex.Chat.Terminal.Input
import Simplex.Chat.Terminal.Output
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.Messaging.Client (NetworkConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig)
import Simplex.Messaging.Util (raceAny_)
#if !defined(dbPostgres)
import Control.Exception (handle, throwIO)
import qualified Data.ByteArray as BA
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.Options.DB
import System.IO (hFlush, hSetEcho, stdin, stdout)
#endif

terminalChatConfig :: ChatConfig
terminalChatConfig :: ChatConfig
terminalChatConfig =
  ChatConfig
defaultChatConfig
    { presetServers =
        PresetServers
          { operators =
              [ PresetOperator
                  { operator = Just operatorSimpleXChat,
                    smp =
                      map
                        (presetServer True)
                        [ "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"
                        ],
                    useSMP = 3,
                    xftp = map (presetServer True) $ L.toList defaultXFTPServers,
                    useXFTP = 3
                  }
              ],
            ntf = _defaultNtfServers,
            netCfg =
              defaultNetworkConfig
                { smpProxyMode = SPMUnknown,
                  smpProxyFallback = SPFAllowProtected
                }
          },
      deviceNameForRemote = "SimpleX CLI"
    }

simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
simplexChatTerminal :: forall t. WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
simplexChatTerminal ChatConfig
cfg ChatOpts
options t
t = ChatOpts -> IO ()
run ChatOpts
options
  where
#if defined(dbPostgres)
    run opts =
      simplexChatCore cfg opts $ \u cc -> do
        ct <- newChatTerminal t opts
        when (firstTime cc) . printToTerminal ct $ chatWelcome u
        runChatTerminal ct cc opts
#else
    run :: ChatOpts -> IO ()
run opts :: ChatOpts
opts@ChatOpts {coreOptions :: ChatOpts -> CoreChatOpts
coreOptions = coreOptions :: CoreChatOpts
coreOptions@CoreChatOpts {ChatDbOpts
dbOptions :: ChatDbOpts
dbOptions :: CoreChatOpts -> ChatDbOpts
dbOptions}} =
      (SQLError -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SQLError -> IO ()
checkDBKeyError (IO () -> IO ())
-> ((User -> ChatController -> IO ()) -> IO ())
-> (User -> ChatController -> IO ())
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatConfig
-> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
simplexChatCore ChatConfig
cfg ChatOpts
opts ((User -> ChatController -> IO ()) -> IO ())
-> (User -> ChatController -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \User
u ChatController
cc -> do
        ChatTerminal
ct <- t -> ChatOpts -> IO ChatTerminal
forall t. WithTerminal t => t -> ChatOpts -> IO ChatTerminal
newChatTerminal t
t ChatOpts
opts
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatController -> Bool
firstTime ChatController
cc) (IO () -> IO ())
-> ([StyledString] -> IO ()) -> [StyledString] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatTerminal -> [StyledString] -> IO ()
printToTerminal ChatTerminal
ct ([StyledString] -> IO ()) -> [StyledString] -> IO ()
forall a b. (a -> b) -> a -> b
$ User -> [StyledString]
chatWelcome User
u
        ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal ChatTerminal
ct ChatController
cc ChatOpts
opts
      where
        checkDBKeyError :: SQLError -> IO ()
        checkDBKeyError :: SQLError -> IO ()
checkDBKeyError SQLError
e = case SQLError -> Error
sqlError SQLError
e of
          Error
DB.ErrorNotADatabase -> do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Database file is invalid or " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if ScrubbedBytes -> Bool
forall a. ByteArrayAccess a => a -> Bool
BA.null (ChatDbOpts -> ScrubbedBytes
dbKey ChatDbOpts
dbOptions) then String
"encrypted." else String
"you passed an incorrect encryption key."
            ChatOpts -> IO ()
run (ChatOpts -> IO ()) -> IO ChatOpts -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ChatOpts
getKeyOpts
          Error
_ -> SQLError -> IO ()
forall e a. Exception e => e -> IO a
throwIO SQLError
e
        getKeyOpts :: IO ChatOpts
        getKeyOpts :: IO ChatOpts
getKeyOpts = do
          String -> IO ()
putStr String
"Enter database encryption key (Ctrl-C to exit):"
          Handle -> IO ()
hFlush Handle
stdout
          Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
False
          String
key <- IO String
getLine
          Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
True
          String -> IO ()
putStrLn String
""
          ChatOpts -> IO ChatOpts
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatOpts
opts {coreOptions = coreOptions {dbOptions = dbOptions {dbKey = BA.convert $ encodeUtf8 $ T.pack key}}}
#endif

runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal ChatTerminal
ct ChatController
cc ChatOpts
opts = [IO ()] -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => [m a] -> m ()
raceAny_ [ChatTerminal -> ChatController -> IO ()
runTerminalInput ChatTerminal
ct ChatController
cc, ChatTerminal -> ChatController -> ChatOpts -> IO ()
runTerminalOutput ChatTerminal
ct ChatController
cc ChatOpts
opts, ChatTerminal -> ChatController -> IO ()
runInputLoop ChatTerminal
ct ChatController
cc]