{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module Simplex.FileTransfer.Server.Main
  ( xftpServerCLI,
    xftpServerCLI_,
  ) where

import Control.Monad (unless, when)
import Data.Either (fromRight)
import Data.Functor (($>))
import Data.Ini (lookupValue, readIniFile)
import Data.Int (Int64)
import Data.List (find)
import qualified Data.List.NonEmpty as L
import Data.Maybe (fromMaybe, isJust)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.Socket (HostName)
import Options.Applicative
import Simplex.FileTransfer.Chunks
import Simplex.FileTransfer.Description (FileSize (..))
import Simplex.FileTransfer.Server (runXFTPServer)
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), XFTPStoreConfig, AFStoreType (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration, readFileStoreType, runWithStoreConfig, checkFileStoreMode, importToDatabase, exportFromDatabase)
import Simplex.FileTransfer.Transport (alpnSupportedXFTPhandshakes, supportedFileServerVRange)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
import Simplex.Messaging.Server.CLI
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Server.Information (ServerPublicInfo (..))
import Simplex.Messaging.Server.Main (serverPublicInfo, printSourceCode)
import Simplex.Messaging.Server.Web (EmbeddedWebParams (..), WebHttpsParams (..))
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.HTTP2 (httpALPN)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), mkTransportServerConfig)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath (combine)
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
import Text.Read (readMaybe)

xftpServerCLI :: FilePath -> FilePath -> IO ()
xftpServerCLI :: [Char] -> [Char] -> IO ()
xftpServerCLI = (forall s.
 XFTPServerConfig s
 -> Maybe ServerPublicInfo
 -> Maybe TransportHost
 -> [Char]
 -> IO ())
-> (EmbeddedWebParams -> IO ()) -> [Char] -> [Char] -> IO ()
xftpServerCLI_ (\XFTPServerConfig s
_ Maybe ServerPublicInfo
_ Maybe TransportHost
_ [Char]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\EmbeddedWebParams
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

xftpServerCLI_ ::
  (forall s. XFTPServerConfig s -> Maybe ServerPublicInfo -> Maybe TransportHost -> FilePath -> IO ()) ->
  (EmbeddedWebParams -> IO ()) ->
  FilePath ->
  FilePath ->
  IO ()
xftpServerCLI_ :: (forall s.
 XFTPServerConfig s
 -> Maybe ServerPublicInfo
 -> Maybe TransportHost
 -> [Char]
 -> IO ())
-> (EmbeddedWebParams -> IO ()) -> [Char] -> [Char] -> IO ()
xftpServerCLI_ forall s.
XFTPServerConfig s
-> Maybe ServerPublicInfo -> Maybe TransportHost -> [Char] -> IO ()
generateSite EmbeddedWebParams -> IO ()
serveStaticFiles [Char]
cfgPath [Char]
logPath = do
  Parser CliCommand -> [Char] -> IO CliCommand
forall cmd. Parser cmd -> [Char] -> IO cmd
getCliCommand' ([Char] -> [Char] -> [Char] -> Parser CliCommand
cliCommandP [Char]
cfgPath [Char]
logPath [Char]
iniFile) [Char]
serverVersion IO CliCommand -> (CliCommand -> 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
>>= \case
    Init InitOptions
opts ->
      [Char] -> IO Bool
doesFileExist [Char]
iniFile IO Bool -> (Bool -> 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
>>= \case
        Bool
True -> [Char] -> IO ()
forall a. [Char] -> IO a
exitError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: server is already initialized (" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
iniFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" exists).\nRun `" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
executableName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" start`."
        Bool
_ -> InitOptions -> IO ()
initializeServer InitOptions
opts
    OnlineCert CertOptions
certOpts ->
      [Char] -> IO Bool
doesFileExist [Char]
iniFile IO Bool -> (Bool -> 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
>>= \case
        Bool
True -> [Char] -> CertOptions -> IO ()
genOnline [Char]
cfgPath CertOptions
certOpts
        Bool
_ -> [Char] -> IO ()
forall a. [Char] -> IO a
exitError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: server is not initialized (" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
iniFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" does not exist).\nRun `" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
executableName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" init`."
    Start StartOptions
opts ->
      [Char] -> IO Bool
doesFileExist [Char]
iniFile IO Bool -> (Bool -> 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
>>= \case
        Bool
True -> [Char] -> IO (Either [Char] Ini)
readIniFile [Char]
iniFile IO (Either [Char] Ini) -> (Either [Char] Ini -> 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
>>= ([Char] -> IO ()) -> (Ini -> IO ()) -> Either [Char] Ini -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO ()
forall a. [Char] -> IO a
exitError (StartOptions -> Ini -> IO ()
runServer StartOptions
opts)
        Bool
_ -> [Char] -> IO ()
forall a. [Char] -> IO a
exitError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: server is not initialized (" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
iniFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" does not exist).\nRun `" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
executableName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" init`."
    Database StoreCmd
cmd ->
      [Char] -> IO Bool
doesFileExist [Char]
iniFile IO Bool -> (Bool -> 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
>>= \case
        Bool
True -> [Char] -> IO (Either [Char] Ini)
readIniFile [Char]
iniFile IO (Either [Char] Ini) -> (Either [Char] Ini -> 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
>>= ([Char] -> IO ()) -> (Ini -> IO ()) -> Either [Char] Ini -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO ()
forall a. [Char] -> IO a
exitError (StoreCmd -> Ini -> IO ()
runDatabaseCmd StoreCmd
cmd)
        Bool
_ -> [Char] -> IO ()
forall a. [Char] -> IO a
exitError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: server is not initialized (" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
iniFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" does not exist).\nRun `" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
executableName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" init`."
    CliCommand
Delete -> do
      [Char] -> [Char] -> IO ()
confirmOrExit
        [Char]
"WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
        [Char]
"Server NOT deleted"
      [Char] -> IO ()
deleteDirIfExists [Char]
cfgPath
      [Char] -> IO ()
deleteDirIfExists [Char]
logPath
      [Char] -> IO ()
putStrLn [Char]
"Deleted configuration and log files"
  where
    iniFile :: [Char]
iniFile = [Char] -> [Char] -> [Char]
combine [Char]
cfgPath [Char]
"file-server.ini"
    serverVersion :: [Char]
serverVersion = [Char]
"SimpleX XFTP server v" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
simplexmqVersionCommit
    defaultServerPort :: [Char]
defaultServerPort = [Char]
"443"
    executableName :: [Char]
executableName = [Char]
"file-server"
    storeLogFilePath :: [Char]
storeLogFilePath = [Char] -> [Char] -> [Char]
combine [Char]
logPath [Char]
"file-server-store.log"
    defaultStaticPath :: [Char]
defaultStaticPath = [Char] -> [Char] -> [Char]
combine [Char]
logPath [Char]
"www"
    runDatabaseCmd :: StoreCmd -> Ini -> IO ()
runDatabaseCmd StoreCmd
cmd Ini
ini = case StoreCmd
cmd of
      StoreCmd
SCImport -> do
        Bool
storeLogExists <- [Char] -> IO Bool
doesFileExist [Char]
storeLogFilePath
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
storeLogExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
exitError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: store log file " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
storeLogFilePath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" does not exist."
        [Char] -> [Char] -> IO ()
confirmOrExit
          ([Char]
"Import store log " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
storeLogFilePath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" to PostgreSQL database?")
          [Char]
"Import cancelled."
        [Char] -> Ini -> MigrationConfirmation -> IO ()
importToDatabase [Char]
storeLogFilePath Ini
ini MigrationConfirmation
MCYesUp
      StoreCmd
SCExport -> do
        Bool
storeLogExists <- [Char] -> IO Bool
doesFileExist [Char]
storeLogFilePath
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
storeLogExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
exitError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: store log file " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
storeLogFilePath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" already exists."
        [Char] -> [Char] -> IO ()
confirmOrExit
          ([Char]
"Export PostgreSQL database to store log " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
storeLogFilePath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"?")
          [Char]
"Export cancelled."
        [Char] -> Ini -> MigrationConfirmation -> IO ()
exportFromDatabase [Char]
storeLogFilePath Ini
ini MigrationConfirmation
MCConsole
    initializeServer :: InitOptions -> IO ()
initializeServer InitOptions {Bool
enableStoreLog :: Bool
$sel:enableStoreLog:InitOptions :: InitOptions -> Bool
enableStoreLog, SignAlgorithm
signAlgorithm :: SignAlgorithm
$sel:signAlgorithm:InitOptions :: InitOptions -> SignAlgorithm
signAlgorithm, [Char]
ip :: [Char]
$sel:ip:InitOptions :: InitOptions -> [Char]
ip, Maybe [Char]
fqdn :: Maybe [Char]
$sel:fqdn:InitOptions :: InitOptions -> Maybe [Char]
fqdn, [Char]
filesPath :: [Char]
$sel:filesPath:InitOptions :: InitOptions -> [Char]
filesPath, FileSize Int64
fileSizeQuota :: FileSize Int64
$sel:fileSizeQuota:InitOptions :: InitOptions -> FileSize Int64
fileSizeQuota, $sel:webStaticPath:InitOptions :: InitOptions -> Maybe [Char]
webStaticPath = Maybe [Char]
webStaticPath_} = do
      [Char] -> IO ()
clearDirIfExists [Char]
cfgPath
      [Char] -> IO ()
clearDirIfExists [Char]
logPath
      Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
cfgPath
      Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
logPath
      let x509cfg :: X509Config
x509cfg = X509Config
defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
      ByteString
fp <- [Char] -> X509Config -> IO ByteString
createServerX509 [Char]
cfgPath X509Config
x509cfg
      let host :: [Char]
host = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe (if [Char]
ip [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"127.0.0.1" then [Char]
"<hostnames>" else [Char]
ip) Maybe [Char]
fqdn
          srv :: ProtoServerWithAuth 'PXFTP
srv = ProtocolServer 'PXFTP
-> Maybe BasicAuth -> ProtoServerWithAuth 'PXFTP
forall (p :: ProtocolType).
ProtocolServer p -> Maybe BasicAuth -> ProtoServerWithAuth p
ProtoServerWithAuth (NonEmpty TransportHost
-> [Char] -> KeyHash -> ProtocolServer 'PXFTP
XFTPServer [[Char] -> TransportHost
THDomainName [Char]
host] [Char]
"" (ByteString -> KeyHash
C.KeyHash ByteString
fp)) Maybe BasicAuth
forall a. Maybe a
Nothing
      [Char] -> Text -> IO ()
T.writeFile [Char]
iniFile (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
iniFileContent [Char]
host
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Server initialized, you can modify configuration in " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
iniFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
".\nRun `" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
executableName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" start` to start server."
      [Char] -> X509Config -> IO ()
warnCAPrivateKeyFile [Char]
cfgPath X509Config
x509cfg
      [Char] -> ProtoServerWithAuth 'PXFTP -> IO ()
forall (p :: ProtocolType).
ProtocolTypeI p =>
[Char] -> ProtoServerWithAuth p -> IO ()
printServiceInfo [Char]
serverVersion ProtoServerWithAuth 'PXFTP
srv
      where
        iniFileContent :: [Char] -> Text
iniFileContent [Char]
host =
          Text
"[INFORMATION]\n\
          \# AGPLv3 license requires that you make any source code modifications\n\
          \# available to the end users of the server.\n\
          \# LICENSE: https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE\n\
          \# Include correct source code URI in case the server source code is modified in any way.\n\
          \# source_code = https://github.com/simplex-chat/simplexmq\n\
          \\n\
          \# Declaring all below information is optional, any of these fields can be omitted.\n\
          \# server_country = ISO-3166 2-letter code\n\
          \# operator = entity (organization or person name)\n\
          \# operator_country = ISO-3166 2-letter code\n\
          \# website =\n\
          \# admin_simplex = SimpleX address\n\
          \# admin_email =\n\
          \# complaints_simplex = SimpleX address\n\
          \# complaints_email =\n\
          \# hosting = entity (organization or person name)\n\
          \# hosting_country = ISO-3166 2-letter code\n\
          \# hosting_type = virtual\n\
          \\n\
          \[STORE_LOG]\n\
          \# The server uses STM memory for persistence,\n\
          \# that will be lost on restart (e.g., as with redis).\n\
          \# This option enables saving memory to append only log,\n\
          \# and restoring it when the server is started.\n\
          \# Log is compacted on start (deleted objects are removed).\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"enable = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
onOff Bool
enableStoreLog Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"# File storage mode: `memory` or `database` (PostgreSQL).\n\
               \store_files = memory\n\n\
               \# Database connection settings for PostgreSQL database (`store_files = database`).\n\
               \# db_connection = postgresql://xftp@/xftp_server_store\n\
               \# db_schema = xftp_server\n\
               \# db_pool_size = 10\n\n\
               \# Write database changes to store log file\n\
               \# db_store_log = off\n\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"# Expire files after the specified number of hours.\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"expire_files_hours = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
defFileExpirationHours Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"log_stats = off\n\
               \\n\
               \# Log interval for real-time Prometheus metrics\n\
               \# prometheus_interval = 60\n\
               \\n\
               \[AUTH]\n\
               \# Set new_files option to off to completely prohibit uploading new files.\n\
               \# This can be useful when you want to decommission the server, but still allow downloading the existing files.\n\
               \new_files = on\n\
               \\n\
               \# Use create_password option to enable basic auth to upload new files.\n\
               \# The password should be used as part of server address in client configuration:\n\
               \# xftp://fingerprint:password@host1,host2\n\
               \# The password will not be shared with file recipients, you must share it only\n\
               \# with the users who you want to allow uploading files to your server.\n\
               \# create_password = password to upload files (any printable ASCII characters without whitespace, '@', ':' and '/')\n\
               \\n\
               \# control_port_admin_password =\n\
               \# control_port_user_password =\n\
               \\n\
               \[TRANSPORT]\n\
               \# host is only used to print server address on start\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"host = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"port = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
defaultServerPort Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"log_tls_errors = off\n\
               \# control_port = 5226\n\
               \\n\
               \[FILES]\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"path = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
filesPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"storage_quota = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
safeDecodeUtf8 (FileSize Int64 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileSize Int64
fileSizeQuota) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
               \[INACTIVE_CLIENTS]\n\
               \# TTL and interval to check inactive clients\n\
               \disconnect = off\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"# ttl = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (ExpirationConfig -> Int64
ttl ExpirationConfig
defaultInactiveClientExpiration) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"# check_interval = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (ExpirationConfig -> Int64
checkInterval ExpirationConfig
defaultInactiveClientExpiration) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
               \[WEB]\n\
               \# Set path to generate static mini-site for server information\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
"static_path = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
defaultStaticPath Maybe [Char]
webStaticPath_) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"# Run an embedded HTTP server on this port.\n\
               \# http = 8000\n\n\
               \# TLS credentials for HTTPS web server on the same port as XFTP.\n\
               \# cert = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([Char]
cfgPath [Char] -> [Char] -> [Char]
`combine` [Char]
"web.crt") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
               \# key = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack ([Char]
cfgPath [Char] -> [Char] -> [Char]
`combine` [Char]
"web.key") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
    runServer :: StartOptions -> Ini -> IO ()
runServer StartOptions {MigrationConfirmation
confirmMigrations :: MigrationConfirmation
$sel:confirmMigrations:StartOptions :: StartOptions -> MigrationConfirmation
confirmMigrations} Ini
ini = do
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
LineBuffering
      ByteString
fp <- [Char] -> X509Config -> IO ByteString
checkSavedFingerprint [Char]
cfgPath X509Config
defaultX509Config
      let host :: [Char]
host = [Char] -> Either [Char] [Char] -> [Char]
forall b a. b -> Either a b -> b
fromRight [Char]
"<hostnames>" (Either [Char] [Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Either [Char] Text -> Either [Char] [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"TRANSPORT" Text
"host" Ini
ini
          port :: [Char]
port = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ini -> Text
strictIni Text
"TRANSPORT" Text
"port" Ini
ini
          srv :: ProtoServerWithAuth 'PXFTP
srv = ProtocolServer 'PXFTP
-> Maybe BasicAuth -> ProtoServerWithAuth 'PXFTP
forall (p :: ProtocolType).
ProtocolServer p -> Maybe BasicAuth -> ProtoServerWithAuth p
ProtoServerWithAuth (NonEmpty TransportHost
-> [Char] -> KeyHash -> ProtocolServer 'PXFTP
XFTPServer [[Char] -> TransportHost
THDomainName [Char]
host] (if [Char]
port [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"443" then [Char]
"" else [Char]
port) (ByteString -> KeyHash
C.KeyHash ByteString
fp)) Maybe BasicAuth
forall a. Maybe a
Nothing
      [Char] -> ProtoServerWithAuth 'PXFTP -> IO ()
forall (p :: ProtocolType).
ProtocolTypeI p =>
[Char] -> ProtoServerWithAuth p -> IO ()
printServiceInfo [Char]
serverVersion ProtoServerWithAuth 'PXFTP
srv
      let information :: Maybe ServerPublicInfo
information = Ini -> Maybe ServerPublicInfo
serverPublicInfo Ini
ini
      Maybe Text -> IO ()
printSourceCode (ServerPublicInfo -> Text
sourceCode (ServerPublicInfo -> Text) -> Maybe ServerPublicInfo -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ServerPublicInfo
information)
      case Ini -> Either [Char] AFStoreType
readFileStoreType Ini
ini of
        Left [Char]
err -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
err
        Right AFStoreType
fsType -> do
          Ini -> AFStoreType -> [Char] -> IO ()
checkFileStoreMode Ini
ini AFStoreType
fsType [Char]
storeLogFilePath
          AFStoreType
-> Ini
-> [Char]
-> MigrationConfirmation
-> (forall s. FileStoreClass s => XFTPStoreConfig s -> IO ())
-> IO ()
runWithStoreConfig AFStoreType
fsType Ini
ini [Char]
storeLogFilePath MigrationConfirmation
confirmMigrations ((forall s. FileStoreClass s => XFTPStoreConfig s -> IO ())
 -> IO ())
-> (forall s. FileStoreClass s => XFTPStoreConfig s -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \XFTPStoreConfig s
storeCfg -> do
            let cfg :: XFTPServerConfig s
cfg = XFTPStoreConfig s -> XFTPServerConfig s
forall s. XFTPStoreConfig s -> XFTPServerConfig s
serverConfig XFTPStoreConfig s
storeCfg
            XFTPServerConfig s -> IO ()
forall {s}. XFTPServerConfig s -> IO ()
printXFTPConfig XFTPServerConfig s
cfg
            case Maybe [Char]
webStaticPath' of
              Just [Char]
path -> do
                let onionHost :: Maybe TransportHost
onionHost =
                      ([Char] -> Maybe TransportHost)
-> (NonEmpty TransportHost -> Maybe TransportHost)
-> Either [Char] (NonEmpty TransportHost)
-> Maybe TransportHost
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe TransportHost -> [Char] -> Maybe TransportHost
forall a b. a -> b -> a
const Maybe TransportHost
forall a. Maybe a
Nothing) ((TransportHost -> Bool)
-> NonEmpty TransportHost -> Maybe TransportHost
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find TransportHost -> Bool
isOnion) (Either [Char] (NonEmpty TransportHost) -> Maybe TransportHost)
-> Either [Char] (NonEmpty TransportHost) -> Maybe TransportHost
forall a b. (a -> b) -> a -> b
$
                        forall a. StrEncoding a => ByteString -> Either [Char] a
strDecode @(L.NonEmpty TransportHost) (ByteString -> Either [Char] (NonEmpty TransportHost))
-> (Text -> ByteString)
-> Text
-> Either [Char] (NonEmpty TransportHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Either [Char] (NonEmpty TransportHost))
-> Either [Char] Text -> Either [Char] (NonEmpty TransportHost)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"TRANSPORT" Text
"host" Ini
ini
                    webHttpPort :: Maybe Int
webHttpPort = Either [Char] Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"WEB" Text
"http" Ini
ini) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> (Text -> [Char]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
                XFTPServerConfig s
-> Maybe ServerPublicInfo -> Maybe TransportHost -> [Char] -> IO ()
forall s.
XFTPServerConfig s
-> Maybe ServerPublicInfo -> Maybe TransportHost -> [Char] -> IO ()
generateSite XFTPServerConfig s
cfg Maybe ServerPublicInfo
information Maybe TransportHost
onionHost [Char]
path
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
webHttpPort Bool -> Bool -> Bool
|| Maybe WebHttpsParams -> Bool
forall a. Maybe a -> Bool
isJust Maybe WebHttpsParams
webHttpsParams') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  EmbeddedWebParams -> IO ()
serveStaticFiles EmbeddedWebParams {webStaticPath :: [Char]
webStaticPath = [Char]
path, Maybe Int
webHttpPort :: Maybe Int
webHttpPort :: Maybe Int
webHttpPort, webHttpsParams :: Maybe WebHttpsParams
webHttpsParams = Maybe WebHttpsParams
webHttpsParams'}
              Maybe [Char]
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            XFTPServerConfig s -> IO ()
forall s. FileStoreClass s => XFTPServerConfig s -> IO ()
runXFTPServer XFTPServerConfig s
cfg
      where
        isOnion :: TransportHost -> Bool
isOnion = \case THOnionHost ByteString
_ -> Bool
True; TransportHost
_ -> Bool
False
        enableStoreLog :: Maybe ()
enableStoreLog = Text -> Text -> Ini -> Maybe ()
settingIsOn Text
"STORE_LOG" Text
"enable" Ini
ini
        logStats :: Maybe ()
logStats = Text -> Text -> Ini -> Maybe ()
settingIsOn Text
"STORE_LOG" Text
"log_stats" Ini
ini
        c :: (X509Config -> [Char]) -> [Char]
c = [Char] -> [Char] -> [Char]
combine [Char]
cfgPath ([Char] -> [Char])
-> ((X509Config -> [Char]) -> [Char])
-> (X509Config -> [Char])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((X509Config -> [Char]) -> X509Config -> [Char]
forall a b. (a -> b) -> a -> b
$ X509Config
defaultX509Config)
        printXFTPConfig :: XFTPServerConfig s -> IO ()
printXFTPConfig XFTPServerConfig {Bool
allowNewFiles :: Bool
$sel:allowNewFiles:XFTPServerConfig :: forall s. XFTPServerConfig s -> Bool
allowNewFiles, Maybe BasicAuth
newFileBasicAuth :: Maybe BasicAuth
$sel:newFileBasicAuth:XFTPServerConfig :: forall s. XFTPServerConfig s -> Maybe BasicAuth
newFileBasicAuth, [Char]
xftpPort :: [Char]
$sel:xftpPort:XFTPServerConfig :: forall s. XFTPServerConfig s -> [Char]
xftpPort, Maybe [Char]
storeLogFile :: Maybe [Char]
$sel:storeLogFile:XFTPServerConfig :: forall s. XFTPServerConfig s -> Maybe [Char]
storeLogFile, Maybe ExpirationConfig
fileExpiration :: Maybe ExpirationConfig
$sel:fileExpiration:XFTPServerConfig :: forall s. XFTPServerConfig s -> Maybe ExpirationConfig
fileExpiration, Maybe ExpirationConfig
inactiveClientExpiration :: Maybe ExpirationConfig
$sel:inactiveClientExpiration:XFTPServerConfig :: forall s. XFTPServerConfig s -> Maybe ExpirationConfig
inactiveClientExpiration} = do
          [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe [Char]
storeLogFile of
            Just [Char]
f -> [Char]
"Store log: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
f
            Maybe [Char]
_ -> [Char]
"Store log disabled."
          [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ExpirationConfig
fileExpiration of
            Just ExpirationConfig {Int64
ttl :: ExpirationConfig -> Int64
ttl :: Int64
ttl} -> [Char]
"expiring files after " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int64 -> [Char]
showTTL Int64
ttl
            Maybe ExpirationConfig
_ -> [Char]
"not expiring files"
          [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ExpirationConfig
inactiveClientExpiration of
            Just ExpirationConfig {Int64
ttl :: ExpirationConfig -> Int64
ttl :: Int64
ttl, Int64
checkInterval :: ExpirationConfig -> Int64
checkInterval :: Int64
checkInterval} -> [Char]
"expiring clients inactive for " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
ttl [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" seconds every " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
checkInterval [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" seconds"
            Maybe ExpirationConfig
_ -> [Char]
"not expiring inactive clients"
          [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"Uploading new files "
              [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> if Bool
allowNewFiles
                then [Char] -> (BasicAuth -> [Char]) -> Maybe BasicAuth -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"allowed." ([Char] -> BasicAuth -> [Char]
forall a b. a -> b -> a
const [Char]
"requires password.") Maybe BasicAuth
newFileBasicAuth
                else [Char]
"NOT allowed."
          [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Listening on port " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xftpPort [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"..."

        httpCredentials_ :: Maybe ServerCredentials
httpCredentials_ =
          Either [Char] ServerCredentials -> Maybe ServerCredentials
forall a b. Either a b -> Maybe b
eitherToMaybe (Either [Char] ServerCredentials -> Maybe ServerCredentials)
-> Either [Char] ServerCredentials -> Maybe ServerCredentials
forall a b. (a -> b) -> a -> b
$ do
            [Char]
cert <- Text -> [Char]
T.unpack (Text -> [Char]) -> Either [Char] Text -> Either [Char] [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"WEB" Text
"cert" Ini
ini
            [Char]
key <- Text -> [Char]
T.unpack (Text -> [Char]) -> Either [Char] Text -> Either [Char] [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"WEB" Text
"key" Ini
ini
            pure
              ServerCredentials
                { $sel:caCertificateFile:ServerCredentials :: Maybe [Char]
caCertificateFile = Maybe [Char]
forall a. Maybe a
Nothing,
                  $sel:certificateFile:ServerCredentials :: [Char]
certificateFile = [Char]
cert,
                  $sel:privateKeyFile:ServerCredentials :: [Char]
privateKeyFile = [Char]
key
                }

        webHttpsParams' :: Maybe WebHttpsParams
webHttpsParams' = do
          Int
httpsPort <- Either [Char] Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"WEB" Text
"https" Ini
ini) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> (Text -> [Char]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
          [Char]
cert <- Either [Char] [Char] -> Maybe [Char]
forall a b. Either a b -> Maybe b
eitherToMaybe (Either [Char] [Char] -> Maybe [Char])
-> Either [Char] [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Either [Char] Text -> Either [Char] [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"WEB" Text
"cert" Ini
ini
          [Char]
key <- Either [Char] [Char] -> Maybe [Char]
forall a b. Either a b -> Maybe b
eitherToMaybe (Either [Char] [Char] -> Maybe [Char])
-> Either [Char] [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Either [Char] Text -> Either [Char] [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"WEB" Text
"key" Ini
ini
          pure WebHttpsParams {port :: Int
port = Int
httpsPort, [Char]
cert :: [Char]
cert :: [Char]
cert, [Char]
key :: [Char]
key :: [Char]
key}

        webStaticPath' :: Maybe [Char]
webStaticPath' = Either [Char] [Char] -> Maybe [Char]
forall a b. Either a b -> Maybe b
eitherToMaybe (Either [Char] [Char] -> Maybe [Char])
-> Either [Char] [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Either [Char] Text -> Either [Char] [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"WEB" Text
"static_path" Ini
ini

        serverConfig :: XFTPStoreConfig s -> XFTPServerConfig s
        serverConfig :: forall s. XFTPStoreConfig s -> XFTPServerConfig s
serverConfig XFTPStoreConfig s
serverStoreCfg =
          XFTPServerConfig
            { $sel:xftpPort:XFTPServerConfig :: [Char]
xftpPort = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ini -> Text
strictIni Text
"TRANSPORT" Text
"port" Ini
ini,
              $sel:controlPort:XFTPServerConfig :: Maybe [Char]
controlPort = ([Char] -> Maybe [Char])
-> (Text -> Maybe [Char]) -> Either [Char] Text -> Maybe [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [Char] -> [Char] -> Maybe [Char]
forall a b. a -> b -> a
const Maybe [Char]
forall a. Maybe a
Nothing) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> (Text -> [Char]) -> Text -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) (Either [Char] Text -> Maybe [Char])
-> Either [Char] Text -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"TRANSPORT" Text
"control_port" Ini
ini,
              $sel:fileIdSize:XFTPServerConfig :: Int
fileIdSize = Int
16,
              XFTPStoreConfig s
serverStoreCfg :: XFTPStoreConfig s
$sel:serverStoreCfg:XFTPServerConfig :: XFTPStoreConfig s
serverStoreCfg,
              $sel:storeLogFile:XFTPServerConfig :: Maybe [Char]
storeLogFile = Maybe ()
enableStoreLog Maybe () -> [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [Char]
storeLogFilePath,
              $sel:filesPath:XFTPServerConfig :: [Char]
filesPath = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ini -> Text
strictIni Text
"FILES" Text
"path" Ini
ini,
              $sel:fileSizeQuota:XFTPServerConfig :: Maybe Int64
fileSizeQuota = ([Char] -> Int64)
-> (FileSize Int64 -> Int64)
-> Either [Char] (FileSize Int64)
-> Int64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Int64
forall a. HasCallStack => [Char] -> a
error FileSize Int64 -> Int64
forall a. FileSize a -> a
unFileSize (Either [Char] (FileSize Int64) -> Int64)
-> Maybe (Either [Char] (FileSize Int64)) -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Maybe (Either [Char] (FileSize Int64))
forall a.
StrEncoding a =>
Text -> Text -> Ini -> Maybe (Either [Char] a)
strDecodeIni Text
"FILES" Text
"storage_quota" Ini
ini,
              $sel:allowedChunkSizes:XFTPServerConfig :: [Word32]
allowedChunkSizes = [Word32]
serverChunkSizes,
              $sel:allowNewFiles:XFTPServerConfig :: Bool
allowNewFiles = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ini -> Maybe Bool
iniOnOff Text
"AUTH" Text
"new_files" Ini
ini,
              $sel:newFileBasicAuth:XFTPServerConfig :: Maybe BasicAuth
newFileBasicAuth = ([Char] -> BasicAuth)
-> (BasicAuth -> BasicAuth) -> Either [Char] BasicAuth -> BasicAuth
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> BasicAuth
forall a. HasCallStack => [Char] -> a
error BasicAuth -> BasicAuth
forall a. a -> a
id (Either [Char] BasicAuth -> BasicAuth)
-> Maybe (Either [Char] BasicAuth) -> Maybe BasicAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Maybe (Either [Char] BasicAuth)
forall a.
StrEncoding a =>
Text -> Text -> Ini -> Maybe (Either [Char] a)
strDecodeIni Text
"AUTH" Text
"create_password" Ini
ini,
              $sel:controlPortAdminAuth:XFTPServerConfig :: Maybe BasicAuth
controlPortAdminAuth = ([Char] -> BasicAuth)
-> (BasicAuth -> BasicAuth) -> Either [Char] BasicAuth -> BasicAuth
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> BasicAuth
forall a. HasCallStack => [Char] -> a
error BasicAuth -> BasicAuth
forall a. a -> a
id (Either [Char] BasicAuth -> BasicAuth)
-> Maybe (Either [Char] BasicAuth) -> Maybe BasicAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Maybe (Either [Char] BasicAuth)
forall a.
StrEncoding a =>
Text -> Text -> Ini -> Maybe (Either [Char] a)
strDecodeIni Text
"AUTH" Text
"control_port_admin_password" Ini
ini,
              $sel:controlPortUserAuth:XFTPServerConfig :: Maybe BasicAuth
controlPortUserAuth = ([Char] -> BasicAuth)
-> (BasicAuth -> BasicAuth) -> Either [Char] BasicAuth -> BasicAuth
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> BasicAuth
forall a. HasCallStack => [Char] -> a
error BasicAuth -> BasicAuth
forall a. a -> a
id (Either [Char] BasicAuth -> BasicAuth)
-> Maybe (Either [Char] BasicAuth) -> Maybe BasicAuth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Maybe (Either [Char] BasicAuth)
forall a.
StrEncoding a =>
Text -> Text -> Ini -> Maybe (Either [Char] a)
strDecodeIni Text
"AUTH" Text
"control_port_user_password" Ini
ini,
              $sel:fileExpiration:XFTPServerConfig :: Maybe ExpirationConfig
fileExpiration =
                ExpirationConfig -> Maybe ExpirationConfig
forall a. a -> Maybe a
Just
                  ExpirationConfig
defaultFileExpiration
                    { ttl = 3600 * readIniDefault defFileExpirationHours "STORE_LOG" "expire_files_hours" ini
                    },
              $sel:fileTimeout:XFTPServerConfig :: Int
fileTimeout = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000, -- 5 mins to send 4mb chunk
              $sel:inactiveClientExpiration:XFTPServerConfig :: Maybe ExpirationConfig
inactiveClientExpiration =
                Text -> Text -> Ini -> Maybe ()
settingIsOn Text
"INACTIVE_CLIENTS" Text
"disconnect" Ini
ini
                  Maybe () -> ExpirationConfig -> Maybe ExpirationConfig
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ExpirationConfig
                    { ttl :: Int64
ttl = Text -> Text -> Ini -> Int64
forall a. Read a => Text -> Text -> Ini -> a
readStrictIni Text
"INACTIVE_CLIENTS" Text
"ttl" Ini
ini,
                      checkInterval :: Int64
checkInterval = Text -> Text -> Ini -> Int64
forall a. Read a => Text -> Text -> Ini -> a
readStrictIni Text
"INACTIVE_CLIENTS" Text
"check_interval" Ini
ini
                    },
              $sel:xftpCredentials:XFTPServerConfig :: ServerCredentials
xftpCredentials =
                ServerCredentials
                  { $sel:caCertificateFile:ServerCredentials :: Maybe [Char]
caCertificateFile = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ (X509Config -> [Char]) -> [Char]
c X509Config -> [Char]
caCrtFile,
                    $sel:privateKeyFile:ServerCredentials :: [Char]
privateKeyFile = (X509Config -> [Char]) -> [Char]
c X509Config -> [Char]
serverKeyFile,
                    $sel:certificateFile:ServerCredentials :: [Char]
certificateFile = (X509Config -> [Char]) -> [Char]
c X509Config -> [Char]
serverCrtFile
                  },
              $sel:httpCredentials:XFTPServerConfig :: Maybe ServerCredentials
httpCredentials = Maybe ServerCredentials
httpCredentials_,
              $sel:xftpServerVRange:XFTPServerConfig :: VersionRangeXFTP
xftpServerVRange = VersionRangeXFTP
supportedFileServerVRange,
              $sel:logStatsInterval:XFTPServerConfig :: Maybe Int64
logStatsInterval = Maybe ()
logStats Maybe () -> Int64 -> Maybe Int64
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int64
86400, -- seconds
              $sel:logStatsStartTime:XFTPServerConfig :: Int64
logStatsStartTime = Int64
0, -- seconds from 00:00 UTC
              $sel:serverStatsLogFile:XFTPServerConfig :: [Char]
serverStatsLogFile = [Char] -> [Char] -> [Char]
combine [Char]
logPath [Char]
"file-server-stats.daily.log",
              $sel:serverStatsBackupFile:XFTPServerConfig :: Maybe [Char]
serverStatsBackupFile = Maybe ()
logStats Maybe () -> [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [Char] -> [Char] -> [Char]
combine [Char]
logPath [Char]
"file-server-stats.log",
              $sel:prometheusInterval:XFTPServerConfig :: Maybe Int
prometheusInterval = Either [Char] Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"STORE_LOG" Text
"prometheus_interval" Ini
ini) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> (Text -> [Char]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack,
              $sel:prometheusMetricsFile:XFTPServerConfig :: [Char]
prometheusMetricsFile = [Char] -> [Char] -> [Char]
combine [Char]
logPath [Char]
"xftp-server-metrics.txt",
              $sel:transportConfig:XFTPServerConfig :: TransportServerConfig
transportConfig =
                let cfg :: TransportServerConfig
cfg =
                      Bool -> Maybe [ByteString] -> Bool -> TransportServerConfig
mkTransportServerConfig
                        (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ini -> Maybe Bool
iniOnOff Text
"TRANSPORT" Text
"log_tls_errors" Ini
ini)
                        ([ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
Just ([ByteString] -> Maybe [ByteString])
-> [ByteString] -> Maybe [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
alpnSupportedXFTPhandshakes [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
httpALPN)
                        Bool
False
                 in TransportServerConfig
cfg {addCORSHeaders = isJust httpCredentials_},
              $sel:responseDelay:XFTPServerConfig :: Int
responseDelay = Int
0,
              $sel:webStaticPath:XFTPServerConfig :: Maybe [Char]
webStaticPath = Maybe [Char]
webStaticPath'
            }

data CliCommand
  = Init InitOptions
  | OnlineCert CertOptions
  | Start StartOptions
  | Database StoreCmd
  | Delete

data StoreCmd = SCImport | SCExport

newtype StartOptions = StartOptions
  { StartOptions -> MigrationConfirmation
confirmMigrations :: MigrationConfirmation
  }

data InitOptions = InitOptions
  { InitOptions -> Bool
enableStoreLog :: Bool,
    InitOptions -> SignAlgorithm
signAlgorithm :: SignAlgorithm,
    InitOptions -> [Char]
ip :: HostName,
    InitOptions -> Maybe [Char]
fqdn :: Maybe HostName,
    InitOptions -> [Char]
filesPath :: FilePath,
    InitOptions -> FileSize Int64
fileSizeQuota :: FileSize Int64,
    InitOptions -> Maybe [Char]
webStaticPath :: Maybe FilePath
  }
  deriving (Int -> InitOptions -> [Char] -> [Char]
[InitOptions] -> [Char] -> [Char]
InitOptions -> [Char]
(Int -> InitOptions -> [Char] -> [Char])
-> (InitOptions -> [Char])
-> ([InitOptions] -> [Char] -> [Char])
-> Show InitOptions
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> InitOptions -> [Char] -> [Char]
showsPrec :: Int -> InitOptions -> [Char] -> [Char]
$cshow :: InitOptions -> [Char]
show :: InitOptions -> [Char]
$cshowList :: [InitOptions] -> [Char] -> [Char]
showList :: [InitOptions] -> [Char] -> [Char]
Show)

cliCommandP :: FilePath -> FilePath -> FilePath -> Parser CliCommand
cliCommandP :: [Char] -> [Char] -> [Char] -> Parser CliCommand
cliCommandP [Char]
cfgPath [Char]
logPath [Char]
iniFile =
  Mod CommandFields CliCommand -> Parser CliCommand
forall a. Mod CommandFields a -> Parser a
hsubparser
    ( [Char] -> ParserInfo CliCommand -> Mod CommandFields CliCommand
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"init" (Parser CliCommand -> InfoMod CliCommand -> ParserInfo CliCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (InitOptions -> CliCommand
Init (InitOptions -> CliCommand)
-> Parser InitOptions -> Parser CliCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InitOptions
initP) ([Char] -> InfoMod CliCommand
forall a. [Char] -> InfoMod a
progDesc ([Char] -> InfoMod CliCommand) -> [Char] -> InfoMod CliCommand
forall a b. (a -> b) -> a -> b
$ [Char]
"Initialize server - creates " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
cfgPath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" and " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
logPath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" directories and configuration files"))
        Mod CommandFields CliCommand
-> Mod CommandFields CliCommand -> Mod CommandFields CliCommand
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo CliCommand -> Mod CommandFields CliCommand
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"cert" (Parser CliCommand -> InfoMod CliCommand -> ParserInfo CliCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (CertOptions -> CliCommand
OnlineCert (CertOptions -> CliCommand)
-> Parser CertOptions -> Parser CliCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CertOptions
certOptionsP) ([Char] -> InfoMod CliCommand
forall a. [Char] -> InfoMod a
progDesc ([Char] -> InfoMod CliCommand) -> [Char] -> InfoMod CliCommand
forall a b. (a -> b) -> a -> b
$ [Char]
"Generate new online TLS server credentials (configuration: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
iniFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
")"))
        Mod CommandFields CliCommand
-> Mod CommandFields CliCommand -> Mod CommandFields CliCommand
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo CliCommand -> Mod CommandFields CliCommand
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"start" (Parser CliCommand -> InfoMod CliCommand -> ParserInfo CliCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (StartOptions -> CliCommand
Start (StartOptions -> CliCommand)
-> Parser StartOptions -> Parser CliCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser StartOptions
startOptsP) ([Char] -> InfoMod CliCommand
forall a. [Char] -> InfoMod a
progDesc ([Char] -> InfoMod CliCommand) -> [Char] -> InfoMod CliCommand
forall a b. (a -> b) -> a -> b
$ [Char]
"Start server (configuration: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
iniFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
")"))
        Mod CommandFields CliCommand
-> Mod CommandFields CliCommand -> Mod CommandFields CliCommand
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo CliCommand -> Mod CommandFields CliCommand
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"database" (Parser CliCommand -> InfoMod CliCommand -> ParserInfo CliCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (StoreCmd -> CliCommand
Database (StoreCmd -> CliCommand) -> Parser StoreCmd -> Parser CliCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser StoreCmd
storeCmdP) ([Char] -> InfoMod CliCommand
forall a. [Char] -> InfoMod a
progDesc [Char]
"Import/export file store to/from PostgreSQL database"))
        Mod CommandFields CliCommand
-> Mod CommandFields CliCommand -> Mod CommandFields CliCommand
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo CliCommand -> Mod CommandFields CliCommand
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"delete" (Parser CliCommand -> InfoMod CliCommand -> ParserInfo CliCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (CliCommand -> Parser CliCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CliCommand
Delete) ([Char] -> InfoMod CliCommand
forall a. [Char] -> InfoMod a
progDesc [Char]
"Delete configuration and log files"))
    )
  where
    initP :: Parser InitOptions
    initP :: Parser InitOptions
initP = do
      Bool
enableStoreLog <-
        Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag'
          Bool
False
          ( [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"disable-store-log"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Disable store log for persistence (enabled by default)"
          )
          Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
            Bool
True
            Bool
True
            ( [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"store-log"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Enable store log for persistence (DEPRECATED, enabled by default)"
            )
      SignAlgorithm
signAlgorithm <-
        ReadM SignAlgorithm
-> Mod OptionFields SignAlgorithm -> Parser SignAlgorithm
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          (([Char] -> Maybe SignAlgorithm) -> ReadM SignAlgorithm
forall a. ([Char] -> Maybe a) -> ReadM a
maybeReader [Char] -> Maybe SignAlgorithm
forall a. Read a => [Char] -> Maybe a
readMaybe)
          ( [Char] -> Mod OptionFields SignAlgorithm
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"sign-algorithm"
              Mod OptionFields SignAlgorithm
-> Mod OptionFields SignAlgorithm -> Mod OptionFields SignAlgorithm
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields SignAlgorithm
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a'
              Mod OptionFields SignAlgorithm
-> Mod OptionFields SignAlgorithm -> Mod OptionFields SignAlgorithm
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields SignAlgorithm
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Signature algorithm used for TLS certificates: ED25519, ED448"
              Mod OptionFields SignAlgorithm
-> Mod OptionFields SignAlgorithm -> Mod OptionFields SignAlgorithm
forall a. Semigroup a => a -> a -> a
<> SignAlgorithm -> Mod OptionFields SignAlgorithm
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value SignAlgorithm
ED448
              Mod OptionFields SignAlgorithm
-> Mod OptionFields SignAlgorithm -> Mod OptionFields SignAlgorithm
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields SignAlgorithm
forall a (f :: * -> *). Show a => Mod f a
showDefault
              Mod OptionFields SignAlgorithm
-> Mod OptionFields SignAlgorithm -> Mod OptionFields SignAlgorithm
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields SignAlgorithm
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"ALG"
          )
      [Char]
ip <-
        Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"ip"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help
                [Char]
"Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
"127.0.0.1"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
showDefault
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"IP"
          )
      Maybe [Char]
fqdn <-
        (Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [Char] -> Parser (Maybe [Char]))
-> (Mod OptionFields [Char] -> Parser [Char])
-> Mod OptionFields [Char]
-> Parser (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption)
          ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"fqdn"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n'
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Server FQDN used as Common Name for TLS online certificate"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields [Char]
forall a (f :: * -> *). Show a => Mod f a
showDefault
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"FQDN"
          )
      [Char]
filesPath <-
        Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"path"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Path to the directory to store files"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PATH"
          )
      FileSize Int64
fileSizeQuota <-
        Mod OptionFields (FileSize Int64) -> Parser (FileSize Int64)
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( [Char] -> Mod OptionFields (FileSize Int64)
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"quota"
              Mod OptionFields (FileSize Int64)
-> Mod OptionFields (FileSize Int64)
-> Mod OptionFields (FileSize Int64)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (FileSize Int64)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'q'
              Mod OptionFields (FileSize Int64)
-> Mod OptionFields (FileSize Int64)
-> Mod OptionFields (FileSize Int64)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (FileSize Int64)
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"File storage quota (e.g. 100gb)"
              Mod OptionFields (FileSize Int64)
-> Mod OptionFields (FileSize Int64)
-> Mod OptionFields (FileSize Int64)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields (FileSize Int64)
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"QUOTA"
          )
      Maybe [Char]
webStaticPath <-
        (Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [Char] -> Parser (Maybe [Char]))
-> (Mod OptionFields [Char] -> Parser [Char])
-> Mod OptionFields [Char]
-> Parser (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption)
          ( [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"web-path"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Directory to store generated static site with server information"
              Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"PATH"
          )
      pure InitOptions {Bool
$sel:enableStoreLog:InitOptions :: Bool
enableStoreLog :: Bool
enableStoreLog, SignAlgorithm
$sel:signAlgorithm:InitOptions :: SignAlgorithm
signAlgorithm :: SignAlgorithm
signAlgorithm, [Char]
$sel:ip:InitOptions :: [Char]
ip :: [Char]
ip, Maybe [Char]
$sel:fqdn:InitOptions :: Maybe [Char]
fqdn :: Maybe [Char]
fqdn, [Char]
$sel:filesPath:InitOptions :: [Char]
filesPath :: [Char]
filesPath, FileSize Int64
$sel:fileSizeQuota:InitOptions :: FileSize Int64
fileSizeQuota :: FileSize Int64
fileSizeQuota, Maybe [Char]
$sel:webStaticPath:InitOptions :: Maybe [Char]
webStaticPath :: Maybe [Char]
webStaticPath}
    startOptsP :: Parser StartOptions
    startOptsP :: Parser StartOptions
startOptsP = do
      MigrationConfirmation
confirmMigrations <-
        ReadM MigrationConfirmation
-> Mod OptionFields MigrationConfirmation
-> Parser MigrationConfirmation
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
          ReadM MigrationConfirmation
parseConfirmMigrations
          ( [Char] -> Mod OptionFields MigrationConfirmation
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"confirm-migrations"
              Mod OptionFields MigrationConfirmation
-> Mod OptionFields MigrationConfirmation
-> Mod OptionFields MigrationConfirmation
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields MigrationConfirmation
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"CONFIRM_MIGRATIONS"
              Mod OptionFields MigrationConfirmation
-> Mod OptionFields MigrationConfirmation
-> Mod OptionFields MigrationConfirmation
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields MigrationConfirmation
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Confirm PostgreSQL database migration: up, down (default is manual confirmation)"
              Mod OptionFields MigrationConfirmation
-> Mod OptionFields MigrationConfirmation
-> Mod OptionFields MigrationConfirmation
forall a. Semigroup a => a -> a -> a
<> MigrationConfirmation -> Mod OptionFields MigrationConfirmation
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value MigrationConfirmation
MCConsole
          )
      pure StartOptions {MigrationConfirmation
$sel:confirmMigrations:StartOptions :: MigrationConfirmation
confirmMigrations :: MigrationConfirmation
confirmMigrations}
    storeCmdP :: Parser StoreCmd
    storeCmdP :: Parser StoreCmd
storeCmdP =
      Mod CommandFields StoreCmd -> Parser StoreCmd
forall a. Mod CommandFields a -> Parser a
hsubparser
        ( [Char] -> ParserInfo StoreCmd -> Mod CommandFields StoreCmd
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"import" (Parser StoreCmd -> InfoMod StoreCmd -> ParserInfo StoreCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
info (StoreCmd -> Parser StoreCmd
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StoreCmd
SCImport) ([Char] -> InfoMod StoreCmd
forall a. [Char] -> InfoMod a
progDesc [Char]
"Import store log file into PostgreSQL database"))
            Mod CommandFields StoreCmd
-> Mod CommandFields StoreCmd -> Mod CommandFields StoreCmd
forall a. Semigroup a => a -> a -> a
<> [Char] -> ParserInfo StoreCmd -> Mod CommandFields StoreCmd
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"export" (Parser StoreCmd -> InfoMod StoreCmd -> ParserInfo StoreCmd
forall a. Parser a -> InfoMod a -> ParserInfo a
info (StoreCmd -> Parser StoreCmd
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StoreCmd
SCExport) ([Char] -> InfoMod StoreCmd
forall a. [Char] -> InfoMod a
progDesc [Char]
"Export PostgreSQL database to store log file"))
        )