{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}

module Simplex.Chat.Terminal.Main where

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM
import Control.Monad
import Data.Maybe (fromMaybe)
import Network.Socket
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatError, ChatEvent (..), PresetServers (..), SimpleNetCfg (..), currentRemoteHost, versionNumber, versionString)
import Simplex.Chat.Core
import Simplex.Chat.Options
import Simplex.Chat.Options.DB
import Simplex.Chat.Terminal
import Simplex.Chat.View (ChatResponseEvent, smpProxyModeStr)
import Simplex.Messaging.Client (NetworkConfig (..), SocksMode (..))
import System.Directory (getAppUserDataDirectory)
import System.Exit (exitFailure)
import System.Terminal (withTerminal)

simplexChatCLI :: ChatConfig -> Maybe (ServiceName -> ChatConfig -> ChatOpts -> IO ()) -> IO ()
simplexChatCLI :: ChatConfig
-> Maybe (String -> ChatConfig -> ChatOpts -> IO ()) -> IO ()
simplexChatCLI ChatConfig
cfg Maybe (String -> ChatConfig -> ChatOpts -> IO ())
server_ = do
  String
appDir <- String -> IO String
getAppUserDataDirectory String
"simplex"
  ChatOpts
opts <- String -> String -> IO ChatOpts
getChatOpts String
appDir String
"simplex_v1"
  ChatConfig
-> ChatOpts
-> Maybe (String -> ChatConfig -> ChatOpts -> IO ())
-> IO ()
simplexChatCLI' ChatConfig
cfg ChatOpts
opts Maybe (String -> ChatConfig -> ChatOpts -> IO ())
server_

simplexChatCLI' :: ChatConfig -> ChatOpts -> Maybe (ServiceName -> ChatConfig -> ChatOpts -> IO ()) -> IO ()
simplexChatCLI' :: ChatConfig
-> ChatOpts
-> Maybe (String -> ChatConfig -> ChatOpts -> IO ())
-> IO ()
simplexChatCLI' ChatConfig
cfg opts :: ChatOpts
opts@ChatOpts {String
chatCmd :: String
chatCmd :: ChatOpts -> String
chatCmd, ChatCmdLog
chatCmdLog :: ChatCmdLog
chatCmdLog :: ChatOpts -> ChatCmdLog
chatCmdLog, Int
chatCmdDelay :: Int
chatCmdDelay :: ChatOpts -> Int
chatCmdDelay, Maybe String
chatServerPort :: Maybe String
chatServerPort :: ChatOpts -> Maybe String
chatServerPort} Maybe (String -> ChatConfig -> ChatOpts -> IO ())
server_ = do
  if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
chatCmd
    then case Maybe String
chatServerPort of
      Just String
chatPort -> case Maybe (String -> ChatConfig -> ChatOpts -> IO ())
server_ of
        Just String -> ChatConfig -> ChatOpts -> IO ()
server -> String -> ChatConfig -> ChatOpts -> IO ()
server String
chatPort ChatConfig
cfg ChatOpts
opts
        Maybe (String -> ChatConfig -> ChatOpts -> IO ())
Nothing -> String -> IO ()
putStrLn String
"Not allowed to run as a WebSockets server" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure
      Maybe String
_ -> IO ()
runCLI
    else ChatConfig
-> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
simplexChatCore ChatConfig
cfg ChatOpts
opts User -> ChatController -> IO ()
runCommand
  where
    runCLI :: IO ()
runCLI = do
      ChatConfig -> ChatOpts -> IO ()
welcome ChatConfig
cfg ChatOpts
opts
      LocalTerminal
t <- (LocalTerminal -> IO LocalTerminal) -> IO LocalTerminal
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(LocalTerminal -> m a) -> m a
withTerminal LocalTerminal -> IO LocalTerminal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ChatConfig -> ChatOpts -> LocalTerminal -> IO ()
forall t. WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
simplexChatTerminal ChatConfig
cfg ChatOpts
opts LocalTerminal
t
    runCommand :: User -> ChatController -> IO ()
runCommand User
user ChatController
cc = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatCmdLog
chatCmdLog ChatCmdLog -> ChatCmdLog -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatCmdLog
CCLNone) (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> (IO () -> IO ()) -> IO () -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        (Maybe RemoteHostId
_, Either ChatError ChatEvent
r) <- STM (Maybe RemoteHostId, Either ChatError ChatEvent)
-> IO (Maybe RemoteHostId, Either ChatError ChatEvent)
forall a. STM a -> IO a
atomically (STM (Maybe RemoteHostId, Either ChatError ChatEvent)
 -> IO (Maybe RemoteHostId, Either ChatError ChatEvent))
-> (TBQueue (Maybe RemoteHostId, Either ChatError ChatEvent)
    -> STM (Maybe RemoteHostId, Either ChatError ChatEvent))
-> TBQueue (Maybe RemoteHostId, Either ChatError ChatEvent)
-> IO (Maybe RemoteHostId, Either ChatError ChatEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TBQueue (Maybe RemoteHostId, Either ChatError ChatEvent)
-> STM (Maybe RemoteHostId, Either ChatError ChatEvent)
forall a. TBQueue a -> STM a
readTBQueue (TBQueue (Maybe RemoteHostId, Either ChatError ChatEvent)
 -> IO (Maybe RemoteHostId, Either ChatError ChatEvent))
-> TBQueue (Maybe RemoteHostId, Either ChatError ChatEvent)
-> IO (Maybe RemoteHostId, Either ChatError ChatEvent)
forall a b. (a -> b) -> a -> b
$ ChatController
-> TBQueue (Maybe RemoteHostId, Either ChatError ChatEvent)
outputQ ChatController
cc
        case Either ChatError ChatEvent
r of
          Right CEvtNewChatItems {} -> Either ChatError ChatEvent -> IO ()
forall r. ChatResponseEvent r => Either ChatError r -> IO ()
printResponse Either ChatError ChatEvent
r
          Either ChatError ChatEvent
_ -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatCmdLog
chatCmdLog ChatCmdLog -> ChatCmdLog -> Bool
forall a. Eq a => a -> a -> Bool
== ChatCmdLog
CCLAll) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Either ChatError ChatEvent -> IO ()
forall r. ChatResponseEvent r => Either ChatError r -> IO ()
printResponse Either ChatError ChatEvent
r
      ChatController -> String -> IO (Either ChatError ChatResponse)
sendChatCmdStr ChatController
cc String
chatCmd IO (Either ChatError ChatResponse)
-> (Either ChatError ChatResponse -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ChatError ChatResponse -> IO ()
forall r. ChatResponseEvent r => Either ChatError r -> IO ()
printResponse
      Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
chatCmdDelay Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
      where
        printResponse :: ChatResponseEvent r => Either ChatError r -> IO ()
        printResponse :: forall r. ChatResponseEvent r => Either ChatError r -> IO ()
printResponse Either ChatError r
r = do
          Maybe RemoteHostId
rh <- TVar (Maybe RemoteHostId) -> IO (Maybe RemoteHostId)
forall a. TVar a -> IO a
readTVarIO (TVar (Maybe RemoteHostId) -> IO (Maybe RemoteHostId))
-> TVar (Maybe RemoteHostId) -> IO (Maybe RemoteHostId)
forall a b. (a -> b) -> a -> b
$ ChatController -> TVar (Maybe RemoteHostId)
currentRemoteHost ChatController
cc
          (Maybe RemoteHostId, Maybe User)
-> ChatConfig -> Either ChatError r -> IO ()
forall r.
ChatResponseEvent r =>
(Maybe RemoteHostId, Maybe User)
-> ChatConfig -> Either ChatError r -> IO ()
printResponseEvent (Maybe RemoteHostId
rh, User -> Maybe User
forall a. a -> Maybe a
Just User
user) ChatConfig
cfg Either ChatError r
r

welcome :: ChatConfig -> ChatOpts -> IO ()
welcome :: ChatConfig -> ChatOpts -> IO ()
welcome ChatConfig {presetServers :: ChatConfig -> PresetServers
presetServers = PresetServers {NetworkConfig
netCfg :: NetworkConfig
netCfg :: PresetServers -> NetworkConfig
netCfg}} ChatOpts {coreOptions :: ChatOpts -> CoreChatOpts
coreOptions = CoreChatOpts {ChatDbOpts
dbOptions :: ChatDbOpts
dbOptions :: CoreChatOpts -> ChatDbOpts
dbOptions, simpleNetCfg :: CoreChatOpts -> SimpleNetCfg
simpleNetCfg = SimpleNetCfg {Maybe SocksProxyWithAuth
socksProxy :: Maybe SocksProxyWithAuth
socksProxy :: SimpleNetCfg -> Maybe SocksProxyWithAuth
socksProxy, SocksMode
socksMode :: SocksMode
socksMode :: SimpleNetCfg -> SocksMode
socksMode, Maybe SMPProxyMode
smpProxyMode_ :: Maybe SMPProxyMode
smpProxyMode_ :: SimpleNetCfg -> Maybe SMPProxyMode
smpProxyMode_, Maybe SMPProxyFallback
smpProxyFallback_ :: Maybe SMPProxyFallback
smpProxyFallback_ :: SimpleNetCfg -> Maybe SMPProxyFallback
smpProxyFallback_}}} =
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    String -> IO ()
putStrLn
    [ String -> String
versionString String
versionNumber,
      String
"db: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChatDbOpts -> String
dbString ChatDbOpts
dbOptions,
      String
-> (SocksProxyWithAuth -> String)
-> Maybe SocksProxyWithAuth
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        String
"direct network connection - use `/network` command or `-x` CLI option to connect via SOCKS5 at :9050"
        ((\String
sp -> String
"using SOCKS5 proxy " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if SocksMode
socksMode SocksMode -> SocksMode -> Bool
forall a. Eq a => a -> a -> Bool
== SocksMode
SMOnion then String
" for onion servers ONLY." else String
" for ALL servers.") (String -> String)
-> (SocksProxyWithAuth -> String) -> SocksProxyWithAuth -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocksProxyWithAuth -> String
forall a. Show a => a -> String
show)
        Maybe SocksProxyWithAuth
socksProxy,
      SMPProxyMode -> SMPProxyFallback -> String
smpProxyModeStr
        (SMPProxyMode -> Maybe SMPProxyMode -> SMPProxyMode
forall a. a -> Maybe a -> a
fromMaybe (NetworkConfig -> SMPProxyMode
smpProxyMode NetworkConfig
netCfg) Maybe SMPProxyMode
smpProxyMode_)
        (SMPProxyFallback -> Maybe SMPProxyFallback -> SMPProxyFallback
forall a. a -> Maybe a -> a
fromMaybe (NetworkConfig -> SMPProxyFallback
smpProxyFallback NetworkConfig
netCfg) Maybe SMPProxyFallback
smpProxyFallback_),
      String
"type \"/help\" or \"/h\" for usage info"
    ]