{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.CLI
  ( main
  , CLI (..)
  , Command (..)
  , readCLIShowHelp
  ) where

import qualified Data.Aeson                 as JSON
import qualified Data.ByteString.Char8      as BS
import qualified Data.ByteString.Lazy       as LBS
import qualified Hasql.Pool                 as SQL
import qualified Hasql.Transaction.Sessions as SQL
import qualified Options.Applicative        as O

import Data.Text.IO (hPutStrLn)
import Text.Heredoc (str)

import PostgREST.AppState    (AppState)
import PostgREST.Config      (AppConfig (..))
import PostgREST.DbStructure (queryDbStructure)
import PostgREST.Version     (prettyVersion)
import PostgREST.Workers     (reReadConfig)

import qualified PostgREST.App      as App
import qualified PostgREST.AppState as AppState
import qualified PostgREST.Config   as Config

import Protolude hiding (hPutStrLn)


main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO ()
main :: SignalHandlerInstaller -> Maybe SocketRunner -> CLI -> IO ()
main SignalHandlerInstaller
installSignalHandlers Maybe SocketRunner
runAppWithSocket CLI{Command
cliCommand :: CLI -> Command
cliCommand :: Command
cliCommand, Maybe FilePath
cliPath :: CLI -> Maybe FilePath
cliPath :: Maybe FilePath
cliPath} = do
  conf :: AppConfig
conf@AppConfig{Bool
Int
[(Text, Text)]
[ByteString]
[Text]
JSPath
Maybe Integer
Maybe FilePath
Maybe ByteString
Maybe Text
Maybe StringOrURI
Maybe JWKSet
Maybe QualifiedIdentifier
Text
FileMode
NonEmpty Text
NominalDiffTime
OpenAPIMode
LogLevel
configServerUnixSocketMode :: AppConfig -> FileMode
configServerUnixSocket :: AppConfig -> Maybe FilePath
configServerPort :: AppConfig -> Int
configServerHost :: AppConfig -> Text
configRawMediaTypes :: AppConfig -> [ByteString]
configOpenApiServerProxyUri :: AppConfig -> Maybe Text
configOpenApiMode :: AppConfig -> OpenAPIMode
configLogLevel :: AppConfig -> LogLevel
configJwtSecretIsBase64 :: AppConfig -> Bool
configJwtSecret :: AppConfig -> Maybe ByteString
configJwtRoleClaimKey :: AppConfig -> JSPath
configJwtAudience :: AppConfig -> Maybe StringOrURI
configJWKS :: AppConfig -> Maybe JWKSet
configFilePath :: AppConfig -> Maybe FilePath
configDbUseLegacyGucs :: AppConfig -> Bool
configDbUri :: AppConfig -> Text
configDbTxRollbackAll :: AppConfig -> Bool
configDbTxAllowOverride :: AppConfig -> Bool
configDbConfig :: AppConfig -> Bool
configDbSchemas :: AppConfig -> NonEmpty Text
configDbRootSpec :: AppConfig -> Maybe QualifiedIdentifier
configDbPreparedStatements :: AppConfig -> Bool
configDbPreRequest :: AppConfig -> Maybe QualifiedIdentifier
configDbPoolTimeout :: AppConfig -> NominalDiffTime
configDbPoolSize :: AppConfig -> Int
configDbMaxRows :: AppConfig -> Maybe Integer
configDbExtraSearchPath :: AppConfig -> [Text]
configDbChannelEnabled :: AppConfig -> Bool
configDbChannel :: AppConfig -> Text
configDbAnonRole :: AppConfig -> Text
configAppSettings :: AppConfig -> [(Text, Text)]
configServerUnixSocketMode :: FileMode
configServerUnixSocket :: Maybe FilePath
configServerPort :: Int
configServerHost :: Text
configRawMediaTypes :: [ByteString]
configOpenApiServerProxyUri :: Maybe Text
configOpenApiMode :: OpenAPIMode
configLogLevel :: LogLevel
configJwtSecretIsBase64 :: Bool
configJwtSecret :: Maybe ByteString
configJwtRoleClaimKey :: JSPath
configJwtAudience :: Maybe StringOrURI
configJWKS :: Maybe JWKSet
configFilePath :: Maybe FilePath
configDbUseLegacyGucs :: Bool
configDbUri :: Text
configDbTxRollbackAll :: Bool
configDbTxAllowOverride :: Bool
configDbConfig :: Bool
configDbSchemas :: NonEmpty Text
configDbRootSpec :: Maybe QualifiedIdentifier
configDbPreparedStatements :: Bool
configDbPreRequest :: Maybe QualifiedIdentifier
configDbPoolTimeout :: NominalDiffTime
configDbPoolSize :: Int
configDbMaxRows :: Maybe Integer
configDbExtraSearchPath :: [Text]
configDbChannelEnabled :: Bool
configDbChannel :: Text
configDbAnonRole :: Text
configAppSettings :: [(Text, Text)]
..} <-
    (Text -> AppConfig)
-> (AppConfig -> AppConfig) -> Either Text AppConfig -> AppConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> AppConfig
forall a. HasCallStack => Text -> a
panic AppConfig -> AppConfig
forall a. a -> a
identity (Either Text AppConfig -> AppConfig)
-> IO (Either Text AppConfig) -> IO AppConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
-> Maybe FilePath -> Maybe Text -> IO (Either Text AppConfig)
Config.readAppConfig [(Text, Text)]
forall a. Monoid a => a
mempty Maybe FilePath
cliPath Maybe Text
forall a. Maybe a
Nothing
  AppState
appState <- AppConfig -> IO AppState
AppState.init AppConfig
conf

  -- Override the config with config options from the db
  -- TODO: the same operation is repeated on connectionWorker, ideally this
  -- would be done only once, but dump CmdDumpConfig needs it for tests.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
configDbConfig (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> SignalHandlerInstaller
reReadConfig Bool
True AppState
appState

  Command -> SignalHandlerInstaller
exec Command
cliCommand AppState
appState
  where
    exec :: Command -> AppState -> IO ()
    exec :: Command -> SignalHandlerInstaller
exec Command
CmdDumpConfig AppState
appState = Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStr (Text -> IO ()) -> (AppConfig -> Text) -> AppConfig -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppConfig -> Text
Config.toText (AppConfig -> IO ()) -> IO AppConfig -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AppState -> IO AppConfig
AppState.getConfig AppState
appState
    exec Command
CmdDumpSchema AppState
appState = ByteString -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AppState -> IO ByteString
dumpSchema AppState
appState
    exec Command
CmdRun AppState
appState = SignalHandlerInstaller
-> Maybe SocketRunner -> SignalHandlerInstaller
App.run SignalHandlerInstaller
installSignalHandlers Maybe SocketRunner
runAppWithSocket AppState
appState

-- | Dump DbStructure schema to JSON
dumpSchema :: AppState -> IO LBS.ByteString
dumpSchema :: AppState -> IO ByteString
dumpSchema AppState
appState = do
  AppConfig{Bool
Int
[(Text, Text)]
[ByteString]
[Text]
JSPath
Maybe Integer
Maybe FilePath
Maybe ByteString
Maybe Text
Maybe StringOrURI
Maybe JWKSet
Maybe QualifiedIdentifier
Text
FileMode
NonEmpty Text
NominalDiffTime
OpenAPIMode
LogLevel
configServerUnixSocketMode :: FileMode
configServerUnixSocket :: Maybe FilePath
configServerPort :: Int
configServerHost :: Text
configRawMediaTypes :: [ByteString]
configOpenApiServerProxyUri :: Maybe Text
configOpenApiMode :: OpenAPIMode
configLogLevel :: LogLevel
configJwtSecretIsBase64 :: Bool
configJwtSecret :: Maybe ByteString
configJwtRoleClaimKey :: JSPath
configJwtAudience :: Maybe StringOrURI
configJWKS :: Maybe JWKSet
configFilePath :: Maybe FilePath
configDbUseLegacyGucs :: Bool
configDbUri :: Text
configDbTxRollbackAll :: Bool
configDbTxAllowOverride :: Bool
configDbConfig :: Bool
configDbSchemas :: NonEmpty Text
configDbRootSpec :: Maybe QualifiedIdentifier
configDbPreparedStatements :: Bool
configDbPreRequest :: Maybe QualifiedIdentifier
configDbPoolTimeout :: NominalDiffTime
configDbPoolSize :: Int
configDbMaxRows :: Maybe Integer
configDbExtraSearchPath :: [Text]
configDbChannelEnabled :: Bool
configDbChannel :: Text
configDbAnonRole :: Text
configAppSettings :: [(Text, Text)]
configServerUnixSocketMode :: AppConfig -> FileMode
configServerUnixSocket :: AppConfig -> Maybe FilePath
configServerPort :: AppConfig -> Int
configServerHost :: AppConfig -> Text
configRawMediaTypes :: AppConfig -> [ByteString]
configOpenApiServerProxyUri :: AppConfig -> Maybe Text
configOpenApiMode :: AppConfig -> OpenAPIMode
configLogLevel :: AppConfig -> LogLevel
configJwtSecretIsBase64 :: AppConfig -> Bool
configJwtSecret :: AppConfig -> Maybe ByteString
configJwtRoleClaimKey :: AppConfig -> JSPath
configJwtAudience :: AppConfig -> Maybe StringOrURI
configJWKS :: AppConfig -> Maybe JWKSet
configFilePath :: AppConfig -> Maybe FilePath
configDbUseLegacyGucs :: AppConfig -> Bool
configDbUri :: AppConfig -> Text
configDbTxRollbackAll :: AppConfig -> Bool
configDbTxAllowOverride :: AppConfig -> Bool
configDbConfig :: AppConfig -> Bool
configDbSchemas :: AppConfig -> NonEmpty Text
configDbRootSpec :: AppConfig -> Maybe QualifiedIdentifier
configDbPreparedStatements :: AppConfig -> Bool
configDbPreRequest :: AppConfig -> Maybe QualifiedIdentifier
configDbPoolTimeout :: AppConfig -> NominalDiffTime
configDbPoolSize :: AppConfig -> Int
configDbMaxRows :: AppConfig -> Maybe Integer
configDbExtraSearchPath :: AppConfig -> [Text]
configDbChannelEnabled :: AppConfig -> Bool
configDbChannel :: AppConfig -> Text
configDbAnonRole :: AppConfig -> Text
configAppSettings :: AppConfig -> [(Text, Text)]
..} <- AppState -> IO AppConfig
AppState.getConfig AppState
appState
  PgVersion
actualPgVersion <- AppState -> IO PgVersion
AppState.getPgVersion AppState
appState
  Either UsageError DbStructure
result <-
    let transaction :: IsolationLevel -> Mode -> Transaction a -> Session a
transaction = if Bool
configDbPreparedStatements then IsolationLevel -> Mode -> Transaction a -> Session a
forall a. IsolationLevel -> Mode -> Transaction a -> Session a
SQL.transaction else IsolationLevel -> Mode -> Transaction a -> Session a
forall a. IsolationLevel -> Mode -> Transaction a -> Session a
SQL.unpreparedTransaction in
    Pool -> Session DbStructure -> IO (Either UsageError DbStructure)
forall a. Pool -> Session a -> IO (Either UsageError a)
SQL.use (AppState -> Pool
AppState.getPool AppState
appState) (Session DbStructure -> IO (Either UsageError DbStructure))
-> Session DbStructure -> IO (Either UsageError DbStructure)
forall a b. (a -> b) -> a -> b
$
      IsolationLevel
-> Mode -> Transaction DbStructure -> Session DbStructure
forall a. IsolationLevel -> Mode -> Transaction a -> Session a
transaction IsolationLevel
SQL.ReadCommitted Mode
SQL.Read (Transaction DbStructure -> Session DbStructure)
-> Transaction DbStructure -> Session DbStructure
forall a b. (a -> b) -> a -> b
$
        [Text] -> [Text] -> PgVersion -> Bool -> Transaction DbStructure
queryDbStructure
          (NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
configDbSchemas)
          [Text]
configDbExtraSearchPath
          PgVersion
actualPgVersion
          Bool
configDbPreparedStatements
  Pool -> IO ()
SQL.release (Pool -> IO ()) -> Pool -> IO ()
forall a b. (a -> b) -> a -> b
$ AppState -> Pool
AppState.getPool AppState
appState
  case Either UsageError DbStructure
result of
    Left UsageError
e -> do
      Handle -> Text -> IO ()
hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"An error ocurred when loading the schema cache:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UsageError -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show UsageError
e
      IO ByteString
forall a. IO a
exitFailure
    Right DbStructure
dbStructure -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ DbStructure -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode DbStructure
dbStructure

-- | Command line interface options
data CLI = CLI
  { CLI -> Command
cliCommand :: Command
  , CLI -> Maybe FilePath
cliPath    :: Maybe FilePath
  }

data Command
  = CmdRun
  | CmdDumpConfig
  | CmdDumpSchema

-- | Read command line interface options. Also prints help.
readCLIShowHelp :: Bool -> IO CLI
readCLIShowHelp :: Bool -> IO CLI
readCLIShowHelp Bool
hasEnvironment =
  ParserPrefs -> ParserInfo CLI -> IO CLI
forall a. ParserPrefs -> ParserInfo a -> IO a
O.customExecParser ParserPrefs
prefs ParserInfo CLI
opts
  where
    prefs :: ParserPrefs
prefs = PrefsMod -> ParserPrefs
O.prefs (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$ PrefsMod
O.showHelpOnError PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
O.showHelpOnEmpty
    opts :: ParserInfo CLI
opts = Parser CLI -> InfoMod CLI -> ParserInfo CLI
forall a. Parser a -> InfoMod a -> ParserInfo a
O.info Parser CLI
parser (InfoMod CLI -> ParserInfo CLI) -> InfoMod CLI -> ParserInfo CLI
forall a b. (a -> b) -> a -> b
$ InfoMod CLI
forall a. InfoMod a
O.fullDesc InfoMod CLI -> InfoMod CLI -> InfoMod CLI
forall a. Semigroup a => a -> a -> a
<> InfoMod CLI
forall a. InfoMod a
progDesc InfoMod CLI -> InfoMod CLI -> InfoMod CLI
forall a. Semigroup a => a -> a -> a
<> InfoMod CLI
forall a. InfoMod a
footer
    parser :: Parser CLI
parser = Parser ((CLI -> CLI) -> CLI -> CLI)
forall a. Parser (a -> a)
O.helper Parser ((CLI -> CLI) -> CLI -> CLI)
-> Parser (CLI -> CLI) -> Parser (CLI -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (CLI -> CLI)
forall a. Parser (a -> a)
exampleParser Parser (CLI -> CLI) -> Parser CLI -> Parser CLI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CLI
cliParser

    progDesc :: InfoMod a
progDesc =
      FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
O.progDesc (FilePath -> InfoMod a) -> FilePath -> InfoMod a
forall a b. (a -> b) -> a -> b
$
        FilePath
"PostgREST "
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ByteString -> FilePath
BS.unpack ByteString
prettyVersion
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" / create a REST API to an existing Postgres database"

    footer :: InfoMod a
footer =
      FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
O.footer (FilePath -> InfoMod a) -> FilePath -> InfoMod a
forall a b. (a -> b) -> a -> b
$
        FilePath
"To run PostgREST, please pass the FILENAME argument"
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" or set PGRST_ environment variables."

    exampleParser :: Parser (a -> a)
exampleParser =
      FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
O.infoOption FilePath
exampleConfigFile (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"example"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'e'
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Show an example configuration file"

    cliParser :: O.Parser CLI
    cliParser :: Parser CLI
cliParser =
      Command -> Maybe FilePath -> CLI
CLI
        (Command -> Maybe FilePath -> CLI)
-> Parser Command -> Parser (Maybe FilePath -> CLI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Command
dumpConfigFlag Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
dumpSchemaFlag)
        Parser (Maybe FilePath -> CLI)
-> Parser (Maybe FilePath) -> Parser CLI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => Bool -> f a -> f (Maybe a)
optionalIf Bool
hasEnvironment Parser FilePath
configFileOption

    configFileOption :: Parser FilePath
configFileOption =
      Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
O.strArgument (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
O.metavar FilePath
"FILENAME"
        Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Path to configuration file (optional with PGRST_ environment variables)"

    dumpConfigFlag :: Parser Command
dumpConfigFlag =
      Command -> Command -> Mod FlagFields Command -> Parser Command
forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag Command
CmdRun Command
CmdDumpConfig (Mod FlagFields Command -> Parser Command)
-> Mod FlagFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod FlagFields Command
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"dump-config"
        Mod FlagFields Command
-> Mod FlagFields Command -> Mod FlagFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Command
forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Dump loaded configuration and exit"

    dumpSchemaFlag :: Parser Command
dumpSchemaFlag =
      Command -> Command -> Mod FlagFields Command -> Parser Command
forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag Command
CmdRun Command
CmdDumpSchema (Mod FlagFields Command -> Parser Command)
-> Mod FlagFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod FlagFields Command
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
O.long FilePath
"dump-schema"
        Mod FlagFields Command
-> Mod FlagFields Command -> Mod FlagFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Command
forall (f :: * -> *) a. FilePath -> Mod f a
O.help FilePath
"Dump loaded schema as JSON and exit (for debugging, output structure is unstable)"

    optionalIf :: Alternative f => Bool -> f a -> f (Maybe a)
    optionalIf :: Bool -> f a -> f (Maybe a)
optionalIf Bool
True  = f a -> f (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional
    optionalIf Bool
False = (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just

exampleConfigFile :: [Char]
exampleConfigFile :: FilePath
exampleConfigFile =
  [str|### REQUIRED:
      |db-uri = "postgres://user:pass@localhost:5432/dbname"
      |db-schema = "public"
      |db-anon-role = "postgres"
      |
      |### OPTIONAL:
      |## number of open connections in the pool
      |db-pool = 10
      |
      |## Time to live, in seconds, for an idle database pool connection.
      |db-pool-timeout = 10
      |
      |## extra schemas to add to the search_path of every request
      |db-extra-search-path = "public"
      |
      |## limit rows in response
      |# db-max-rows = 1000
      |
      |## stored proc to exec immediately after auth
      |# db-pre-request = "stored_proc_name"
      |
      |## stored proc that overrides the root "/" spec
      |## it must be inside the db-schema
      |# db-root-spec = "stored_proc_name"
      |
      |## Notification channel for reloading the schema cache
      |db-channel = "pgrst"
      |
      |## Enable or disable the notification channel
      |db-channel-enabled = true
      |
      |## Enable in-database configuration
      |db-config = true
      |
      |## Determine if GUC request settings for headers, cookies and jwt claims use the legacy names (string with dashes, invalid starting from PostgreSQL v14) with text values instead of the new names (string without dashes, valid on all PostgreSQL versions) with json values.
      |## For PostgreSQL v14 and up, this setting will be ignored.
      |db-use-legacy-gucs = true
      |
      |## how to terminate database transactions
      |## possible values are:
      |## commit (default)
      |##   transaction is always committed, this can not be overriden
      |## commit-allow-override
      |##   transaction is committed, but can be overriden with Prefer tx=rollback header
      |## rollback
      |##   transaction is always rolled back, this can not be overriden
      |## rollback-allow-override
      |##   transaction is rolled back, but can be overriden with Prefer tx=commit header
      |db-tx-end = "commit"
      |
      |## enable or disable prepared statements. disabling is only necessary when behind a connection pooler.
      |## when disabled, statements will be parametrized but won't be prepared.
      |db-prepared-statements = true
      |
      |server-host = "!4"
      |server-port = 3000
      |
      |## unix socket location
      |## if specified it takes precedence over server-port
      |# server-unix-socket = "/tmp/pgrst.sock"
      |
      |## unix socket file mode
      |## when none is provided, 660 is applied by default
      |# server-unix-socket-mode = "660"
      |
      |## determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely
      |## admitted values: follow-privileges, ignore-privileges, disabled
      |openapi-mode = "follow-privileges"
      |
      |## base url for the OpenAPI output
      |openapi-server-proxy-uri = ""
      |
      |## choose a secret, JSON Web Key (or set) to enable JWT auth
      |## (use "@filename" to load from separate file)
      |# jwt-secret = "secret_with_at_least_32_characters"
      |# jwt-aud = "your_audience_claim"
      |jwt-secret-is-base64 = false
      |
      |## jspath to the role claim key
      |jwt-role-claim-key = ".role"
      |
      |## content types to produce raw output
      |# raw-media-types="image/png, image/jpg"
      |
      |## logging level, the admitted values are: crit, error, warn and info.
      |log-level = "error"
      |]