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

module Simplex.FileTransfer.Server.Main where

import Data.Either (fromRight)
import Data.Functor (($>))
import Data.Ini (lookupValue, readIniFile)
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
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 (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration)
import Simplex.FileTransfer.Transport (supportedFileServerVRange, alpnSupportedXFTPhandshakes)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
import Simplex.Messaging.Server.CLI
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.HTTP2 (httpALPN)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), 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 [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`."
    CliCommand
Start ->
      [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 Ini -> IO ()
runServer
        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"
    initializeServer :: InitOptions -> IO ()
initializeServer InitOptions {Bool
enableStoreLog :: Bool
enableStoreLog :: InitOptions -> Bool
enableStoreLog, SignAlgorithm
signAlgorithm :: SignAlgorithm
signAlgorithm :: InitOptions -> SignAlgorithm
signAlgorithm, [Char]
ip :: [Char]
ip :: InitOptions -> [Char]
ip, Maybe [Char]
fqdn :: Maybe [Char]
fqdn :: InitOptions -> Maybe [Char]
fqdn, [Char]
filesPath :: [Char]
filesPath :: InitOptions -> [Char]
filesPath, FileSize Int64
fileSizeQuota :: FileSize Int64
fileSizeQuota :: InitOptions -> FileSize Int64
fileSizeQuota} = 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
"[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
"# 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")
    runServer :: Ini -> IO ()
runServer 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
      XFTPServerConfig -> IO ()
printXFTPConfig XFTPServerConfig
serverConfig
      XFTPServerConfig -> IO ()
runXFTPServer XFTPServerConfig
serverConfig
      where
        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 -> IO ()
printXFTPConfig XFTPServerConfig {Bool
allowNewFiles :: Bool
allowNewFiles :: XFTPServerConfig -> Bool
allowNewFiles, Maybe BasicAuth
newFileBasicAuth :: Maybe BasicAuth
newFileBasicAuth :: XFTPServerConfig -> Maybe BasicAuth
newFileBasicAuth, [Char]
xftpPort :: [Char]
xftpPort :: XFTPServerConfig -> [Char]
xftpPort, Maybe [Char]
storeLogFile :: Maybe [Char]
storeLogFile :: XFTPServerConfig -> Maybe [Char]
storeLogFile, Maybe ExpirationConfig
fileExpiration :: Maybe ExpirationConfig
fileExpiration :: XFTPServerConfig -> Maybe ExpirationConfig
fileExpiration, Maybe ExpirationConfig
inactiveClientExpiration :: Maybe ExpirationConfig
inactiveClientExpiration :: XFTPServerConfig -> 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]
"..."

        serverConfig :: XFTPServerConfig
serverConfig =
          XFTPServerConfig
            { xftpPort :: [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,
              controlPort :: 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,
              fileIdSize :: Int
fileIdSize = Int
16,
              storeLogFile :: Maybe [Char]
storeLogFile = Maybe ()
enableStoreLog Maybe () -> [Char] -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [Char]
storeLogFilePath,
              filesPath :: [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,
              fileSizeQuota :: 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,
              allowedChunkSizes :: [Word32]
allowedChunkSizes = [Word32]
serverChunkSizes,
              allowNewFiles :: 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,
              newFileBasicAuth :: 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,
              controlPortAdminAuth :: 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,
              controlPortUserAuth :: 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,
              fileExpiration :: Maybe ExpirationConfig
fileExpiration =
                ExpirationConfig -> Maybe ExpirationConfig
forall a. a -> Maybe a
Just
                  ExpirationConfig
defaultFileExpiration
                    { ttl = 3600 * readIniDefault defFileExpirationHours "STORE_LOG" "expire_files_hours" ini
                    },
              fileTimeout :: 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
              inactiveClientExpiration :: 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
                    },
              xftpCredentials :: ServerCredentials
xftpCredentials =
                ServerCredentials
                  { caCertificateFile :: 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,
                    privateKeyFile :: [Char]
privateKeyFile = (X509Config -> [Char]) -> [Char]
c X509Config -> [Char]
serverKeyFile,
                    certificateFile :: [Char]
certificateFile = (X509Config -> [Char]) -> [Char]
c X509Config -> [Char]
serverCrtFile
                  },
              xftpServerVRange :: VersionRangeXFTP
xftpServerVRange = VersionRangeXFTP
supportedFileServerVRange,
              logStatsInterval :: Maybe Int64
logStatsInterval = Maybe ()
logStats Maybe () -> Int64 -> Maybe Int64
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int64
86400, -- seconds
              logStatsStartTime :: Int64
logStatsStartTime = Int64
0, -- seconds from 00:00 UTC
              serverStatsLogFile :: [Char]
serverStatsLogFile = [Char] -> [Char] -> [Char]
combine [Char]
logPath [Char]
"file-server-stats.daily.log",
              serverStatsBackupFile :: 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",
              prometheusInterval :: Maybe Int
prometheusInterval = Either [Char] Int -> Maybe Int
forall a b. Either a b -> Maybe b
eitherToMaybe (Either [Char] Int -> Maybe Int) -> Either [Char] Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> (Text -> [Char]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Int) -> Either [Char] Text -> Either [Char] Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Ini -> Either [Char] Text
lookupValue Text
"STORE_LOG" Text
"prometheus_interval" Ini
ini,
              prometheusMetricsFile :: [Char]
prometheusMetricsFile = [Char] -> [Char] -> [Char]
combine [Char]
logPath [Char]
"xftp-server-metrics.txt",
              transportConfig :: TransportServerConfig
transportConfig =
                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,
              responseDelay :: Int
responseDelay = Int
0
            }

data CliCommand
  = Init InitOptions
  | OnlineCert CertOptions
  | Start
  | Delete

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
  }
  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 (CliCommand -> Parser CliCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CliCommand
Start) ([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]
"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"
          )
      pure InitOptions {Bool
enableStoreLog :: Bool
enableStoreLog :: Bool
enableStoreLog, SignAlgorithm
signAlgorithm :: SignAlgorithm
signAlgorithm :: SignAlgorithm
signAlgorithm, [Char]
ip :: [Char]
ip :: [Char]
ip, Maybe [Char]
fqdn :: Maybe [Char]
fqdn :: Maybe [Char]
fqdn, [Char]
filesPath :: [Char]
filesPath :: [Char]
filesPath, FileSize Int64
fileSizeQuota :: FileSize Int64
fileSizeQuota :: FileSize Int64
fileSizeQuota}