731 lines
33 KiB
Haskell
731 lines
33 KiB
Haskell
{-|
|
|
Module : PostgREST.Config
|
|
Description : Manages PostgREST configuration type and parser.
|
|
|
|
-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
|
|
|
|
module PostgREST.Config
|
|
( AppConfig (..)
|
|
, Environment
|
|
, JSPath
|
|
, JSPathExp(..)
|
|
, FilterExp(..)
|
|
, LogLevel(..)
|
|
, OpenAPIMode(..)
|
|
, Proxy(..)
|
|
, toText
|
|
, isMalformedProxyUri
|
|
, readAppConfig
|
|
, readPGRSTEnvironment
|
|
, toURI
|
|
, parseSecret
|
|
, addFallbackAppName
|
|
, addTargetSessionAttrs
|
|
, exampleConfigFile
|
|
) where
|
|
|
|
import qualified Data.Aeson as JSON
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Base64 as B64
|
|
import qualified Data.CaseInsensitive as CI
|
|
import qualified Data.Configurator as C
|
|
import qualified Data.Map.Strict as M
|
|
import qualified Data.String as S
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Jose.Jwa as JWT
|
|
import qualified Jose.Jwk as JWT
|
|
|
|
import Control.Monad (fail)
|
|
import Data.Either.Combinators (mapLeft)
|
|
import Data.List (lookup)
|
|
import Data.List.NonEmpty (fromList, toList)
|
|
import Data.Maybe (fromJust)
|
|
import Data.Scientific (floatingOrInteger)
|
|
import Jose.Jwk (Jwk, JwkSet)
|
|
import Network.URI (escapeURIString, isURI,
|
|
isUnescapedInURIComponent)
|
|
import Numeric (readOct, showOct)
|
|
import System.Environment (getEnvironment)
|
|
import System.Posix.Types (FileMode)
|
|
|
|
import PostgREST.Config.Database (RoleIsolationLvl,
|
|
RoleSettings)
|
|
import PostgREST.Config.JSPath (FilterExp (..), JSPath,
|
|
JSPathExp (..), dumpJSPath,
|
|
pRoleClaimKey)
|
|
import PostgREST.Config.Proxy (Proxy (..),
|
|
isMalformedProxyUri, toURI)
|
|
import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier, dumpQi,
|
|
toQi)
|
|
|
|
import Protolude hiding (Proxy, toList)
|
|
|
|
|
|
data AppConfig = AppConfig
|
|
{ configAppSettings :: [(Text, Text)]
|
|
, configDbAggregates :: Bool
|
|
, configDbAnonRole :: Maybe BS.ByteString
|
|
, configDbChannel :: Text
|
|
, configDbChannelEnabled :: Bool
|
|
, configDbExtraSearchPath :: [Text]
|
|
, configDbHoistedTxSettings :: [Text]
|
|
, configDbMaxRows :: Maybe Integer
|
|
, configDbPlanEnabled :: Bool
|
|
, configDbPoolSize :: Int
|
|
, configDbPoolAcquisitionTimeout :: Int
|
|
, configDbPoolMaxLifetime :: Int
|
|
, configDbPoolMaxIdletime :: Int
|
|
, configDbPoolAutomaticRecovery :: Bool
|
|
, configDbPreRequest :: Maybe QualifiedIdentifier
|
|
, configDbPreparedStatements :: Bool
|
|
, configDbRootSpec :: Maybe QualifiedIdentifier
|
|
, configDbSchemas :: NonEmpty Text
|
|
, configDbConfig :: Bool
|
|
, configDbPreConfig :: Maybe QualifiedIdentifier
|
|
, configDbTxAllowOverride :: Bool
|
|
, configDbTxRollbackAll :: Bool
|
|
, configDbUri :: Text
|
|
, configFilePath :: Maybe FilePath
|
|
, configJWKS :: Maybe JwkSet
|
|
, configJwtAudience :: Maybe Text
|
|
, configJwtRoleClaimKey :: JSPath
|
|
, configJwtSecret :: Maybe BS.ByteString
|
|
, configJwtSecretIsBase64 :: Bool
|
|
, configJwtCacheMaxEntries :: Int
|
|
, configLogLevel :: LogLevel
|
|
, configLogQuery :: Bool
|
|
, configOpenApiMode :: OpenAPIMode
|
|
, configOpenApiSecurityActive :: Bool
|
|
, configOpenApiServerProxyUri :: Maybe Text
|
|
, configServerCorsAllowedOrigins :: Maybe [Text]
|
|
, configServerHost :: Text
|
|
, configServerPort :: Int
|
|
, configServerTraceHeader :: Maybe (CI.CI BS.ByteString)
|
|
, configServerTimingEnabled :: Bool
|
|
, configServerUnixSocket :: Maybe FilePath
|
|
, configServerUnixSocketMode :: FileMode
|
|
, configAdminServerHost :: Text
|
|
, configAdminServerPort :: Maybe Int
|
|
, configRoleSettings :: RoleSettings
|
|
, configRoleIsoLvl :: RoleIsolationLvl
|
|
, configInternalSCSleep :: Maybe Int32
|
|
}
|
|
|
|
data LogLevel = LogCrit | LogError | LogWarn | LogInfo | LogDebug
|
|
deriving (Eq, Ord)
|
|
|
|
dumpLogLevel :: LogLevel -> Text
|
|
dumpLogLevel = \case
|
|
LogCrit -> "crit"
|
|
LogError -> "error"
|
|
LogWarn -> "warn"
|
|
LogInfo -> "info"
|
|
LogDebug -> "debug"
|
|
|
|
data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
|
|
deriving Eq
|
|
|
|
dumpOpenApiMode :: OpenAPIMode -> Text
|
|
dumpOpenApiMode = \case
|
|
OAFollowPriv -> "follow-privileges"
|
|
OAIgnorePriv -> "ignore-privileges"
|
|
OADisabled -> "disabled"
|
|
|
|
-- | Dump the config
|
|
toText :: AppConfig -> Text
|
|
toText conf =
|
|
unlines $ (\(k, v) -> k <> " = " <> v) <$> pgrstSettings ++ appSettings
|
|
where
|
|
-- apply conf to all pgrst settings
|
|
pgrstSettings = (\(k, v) -> (k, v conf)) <$>
|
|
[("db-aggregates-enabled", T.toLower . show . configDbAggregates)
|
|
,("db-anon-role", q . T.decodeUtf8 . fromMaybe "" . configDbAnonRole)
|
|
,("db-channel", q . configDbChannel)
|
|
,("db-channel-enabled", T.toLower . show . configDbChannelEnabled)
|
|
,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath)
|
|
,("db-hoisted-tx-settings", q . T.intercalate "," . configDbHoistedTxSettings)
|
|
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
|
|
,("db-plan-enabled", T.toLower . show . configDbPlanEnabled)
|
|
,("db-pool", show . configDbPoolSize)
|
|
,("db-pool-acquisition-timeout", show . configDbPoolAcquisitionTimeout)
|
|
,("db-pool-max-lifetime", show . configDbPoolMaxLifetime)
|
|
,("db-pool-max-idletime", show . configDbPoolMaxIdletime)
|
|
,("db-pool-automatic-recovery", T.toLower . show . configDbPoolAutomaticRecovery)
|
|
,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest)
|
|
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
|
|
,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec)
|
|
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
|
|
,("db-config", T.toLower . show . configDbConfig)
|
|
,("db-pre-config", q . maybe mempty dumpQi . configDbPreConfig)
|
|
,("db-tx-end", q . showTxEnd)
|
|
,("db-uri", q . configDbUri)
|
|
,("jwt-aud", q . fromMaybe mempty . configJwtAudience)
|
|
,("jwt-role-claim-key", q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey)
|
|
,("jwt-secret", q . T.decodeUtf8 . showJwtSecret)
|
|
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
|
|
,("jwt-cache-max-entries", show . configJwtCacheMaxEntries)
|
|
,("log-level", q . dumpLogLevel . configLogLevel)
|
|
,("log-query", T.toLower . show . configLogQuery)
|
|
,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode)
|
|
,("openapi-security-active", T.toLower . show . configOpenApiSecurityActive)
|
|
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
|
|
,("server-cors-allowed-origins", q . maybe "" (T.intercalate ",") . configServerCorsAllowedOrigins)
|
|
,("server-host", q . configServerHost)
|
|
,("server-port", show . configServerPort)
|
|
,("server-trace-header", q . T.decodeUtf8 . maybe mempty CI.original . configServerTraceHeader)
|
|
,("server-timing-enabled", T.toLower . show . configServerTimingEnabled)
|
|
,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket)
|
|
,("server-unix-socket-mode", q . T.pack . showSocketMode)
|
|
,("admin-server-host", q . configAdminServerHost)
|
|
,("admin-server-port", maybe "\"\"" show . configAdminServerPort)
|
|
]
|
|
|
|
-- quote all app.settings
|
|
appSettings = second q <$> configAppSettings conf
|
|
|
|
-- quote strings and replace " with \"
|
|
q s = "\"" <> T.replace "\"" "\\\"" s <> "\""
|
|
|
|
showTxEnd c = case (configDbTxRollbackAll c, configDbTxAllowOverride c) of
|
|
( False, False ) -> "commit"
|
|
( False, True ) -> "commit-allow-override"
|
|
( True , False ) -> "rollback"
|
|
( True , True ) -> "rollback-allow-override"
|
|
showJwtSecret c
|
|
| configJwtSecretIsBase64 c = B64.encode secret
|
|
| otherwise = secret
|
|
where
|
|
secret = fromMaybe mempty $ configJwtSecret c
|
|
showSocketMode c = showOct (configServerUnixSocketMode c) mempty
|
|
|
|
-- This class is needed for the polymorphism of overrideFromDbOrEnvironment
|
|
-- because C.required and C.optional have different signatures
|
|
class JustIfMaybe a b where
|
|
justIfMaybe :: a -> b
|
|
|
|
instance JustIfMaybe a a where
|
|
justIfMaybe = identity
|
|
|
|
instance JustIfMaybe a (Maybe a) where
|
|
justIfMaybe = Just
|
|
|
|
-- | Reads and parses the config and overrides its parameters from env vars,
|
|
-- files or db settings.
|
|
readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> RoleIsolationLvl -> IO (Either Text AppConfig)
|
|
readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do
|
|
env <- readPGRSTEnvironment
|
|
-- if no filename provided, start with an empty map to read config from environment
|
|
conf <- maybe (return $ Right M.empty) loadConfig optPath
|
|
|
|
case C.runParser (parser optPath env dbSettings roleSettings roleIsolationLvl) =<< mapLeft show conf of
|
|
Left err ->
|
|
return . Left $ "Error in config " <> err
|
|
Right parsedConfig ->
|
|
mapLeft show <$> decodeLoadFiles parsedConfig
|
|
where
|
|
-- Both C.ParseError and IOError are shown here
|
|
loadConfig :: FilePath -> IO (Either SomeException C.Config)
|
|
loadConfig = try . C.load
|
|
|
|
decodeLoadFiles :: AppConfig -> IO (Either IOException AppConfig)
|
|
decodeLoadFiles parsedConfig = try $
|
|
decodeJWKS =<<
|
|
decodeSecret =<<
|
|
readSecretFile =<<
|
|
readDbUriFile prevDbUri parsedConfig
|
|
|
|
parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> C.Parser C.Config AppConfig
|
|
parser optPath env dbSettings roleSettings roleIsolationLvl =
|
|
AppConfig
|
|
<$> parseAppSettings "app.settings"
|
|
<*> (fromMaybe False <$> optBool "db-aggregates-enabled")
|
|
<*> (fmap encodeUtf8 <$> optString "db-anon-role")
|
|
<*> (fromMaybe "pgrst" <$> optString "db-channel")
|
|
<*> (fromMaybe True <$> optBool "db-channel-enabled")
|
|
<*> (maybe ["public"] splitOnCommasEmptyable <$> optStringEmptyable "db-extra-search-path")
|
|
<*> (maybe defaultHoistedAllowList splitOnCommas <$> optString "db-hoisted-tx-settings")
|
|
<*> optWithAlias (optInt "db-max-rows")
|
|
(optInt "max-rows")
|
|
<*> (fromMaybe False <$> optBool "db-plan-enabled")
|
|
<*> (fromMaybe 10 <$> optInt "db-pool")
|
|
<*> (fromMaybe 10 <$> optInt "db-pool-acquisition-timeout")
|
|
<*> (fromMaybe 1800 <$> optInt "db-pool-max-lifetime")
|
|
<*> (fromMaybe 30 <$> optWithAlias (optInt "db-pool-timeout")
|
|
(optInt "db-pool-max-idletime"))
|
|
<*> (fromMaybe True <$> optBool "db-pool-automatic-recovery")
|
|
<*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
|
|
(optString "pre-request"))
|
|
<*> (fromMaybe True <$> optBool "db-prepared-statements")
|
|
<*> (fmap toQi <$> optWithAlias (optString "db-root-spec")
|
|
(optString "root-spec"))
|
|
<*> (fromList . maybe ["public"] splitOnCommas <$> optWithAlias (optString "db-schemas")
|
|
(optString "db-schema"))
|
|
<*> (fromMaybe True <$> optBool "db-config")
|
|
<*> (fmap toQi <$> optString "db-pre-config")
|
|
<*> parseTxEnd "db-tx-end" snd
|
|
<*> parseTxEnd "db-tx-end" fst
|
|
<*> (fromMaybe "postgresql://" <$> optString "db-uri")
|
|
<*> pure optPath
|
|
<*> pure Nothing
|
|
<*> optStringOrURI "jwt-aud"
|
|
<*> parseRoleClaimKey "jwt-role-claim-key" "role-claim-key"
|
|
<*> (fmap encodeUtf8 <$> optString "jwt-secret")
|
|
<*> (fromMaybe False <$> optWithAlias
|
|
(optBool "jwt-secret-is-base64")
|
|
(optBool "secret-is-base64"))
|
|
<*> (fromMaybe 1000 <$> optInt "jwt-cache-max-entries")
|
|
<*> parseLogLevel "log-level"
|
|
<*> (fromMaybe False <$> optBool "log-query")
|
|
<*> parseOpenAPIMode "openapi-mode"
|
|
<*> (fromMaybe False <$> optBool "openapi-security-active")
|
|
<*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
|
|
<*> parseCORSAllowedOrigins "server-cors-allowed-origins"
|
|
<*> (defaultServerHost <$> optString "server-host")
|
|
<*> parseServerPort "server-port"
|
|
<*> (fmap (CI.mk . encodeUtf8) <$> optString "server-trace-header")
|
|
<*> (fromMaybe False <$> optBool "server-timing-enabled")
|
|
<*> (fmap T.unpack <$> optString "server-unix-socket")
|
|
<*> parseSocketFileMode "server-unix-socket-mode"
|
|
<*> (defaultServerHost <$> optWithAlias (optString "admin-server-host")
|
|
(optString "server-host"))
|
|
<*> parseAdminServerPort "admin-server-port"
|
|
<*> pure roleSettings
|
|
<*> pure roleIsolationLvl
|
|
<*> optInt "internal-schema-cache-sleep"
|
|
where
|
|
parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)]
|
|
parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value
|
|
where
|
|
addFromEnv f = M.toList $ M.union fromEnv $ M.fromList f
|
|
fromEnv = M.mapKeys fromJust $ M.filterWithKey (\k _ -> isJust k) $ M.mapKeys normalize env
|
|
normalize k = ("app.settings." <>) <$> T.stripPrefix "PGRST_APP_SETTINGS_" (toS k)
|
|
|
|
parseServerPort :: C.Key -> C.Parser C.Config Int
|
|
parseServerPort k = fromMaybe 3000 <$> optInt k
|
|
|
|
parseAdminServerPort :: C.Key -> C.Parser C.Config (Maybe Int)
|
|
parseAdminServerPort k = do
|
|
serverPort <- parseServerPort "server-port"
|
|
optInt k >>= \case
|
|
Nothing -> pure Nothing
|
|
Just asp | asp == serverPort -> fail "admin-server-port cannot be the same as server-port"
|
|
| otherwise -> pure $ Just asp
|
|
|
|
parseSocketFileMode :: C.Key -> C.Parser C.Config FileMode
|
|
parseSocketFileMode k =
|
|
optString k >>= \case
|
|
Nothing -> pure 432 -- return default 660 mode if no value was provided
|
|
Just fileModeText ->
|
|
case readOct $ T.unpack fileModeText of
|
|
[] ->
|
|
fail "Invalid server-unix-socket-mode: not an octal"
|
|
(fileMode, _):_ ->
|
|
if fileMode < 384 || fileMode > 511
|
|
then fail "Invalid server-unix-socket-mode: needs to be between 600 and 777"
|
|
else pure fileMode
|
|
|
|
parseOpenAPIMode :: C.Key -> C.Parser C.Config OpenAPIMode
|
|
parseOpenAPIMode k =
|
|
optString k >>= \case
|
|
Nothing -> pure OAFollowPriv
|
|
Just "follow-privileges" -> pure OAFollowPriv
|
|
Just "ignore-privileges" -> pure OAIgnorePriv
|
|
Just "disabled" -> pure OADisabled
|
|
Just _ -> fail "Invalid openapi-mode. Check your configuration."
|
|
|
|
parseOpenAPIServerProxyURI :: C.Key -> C.Parser C.Config (Maybe Text)
|
|
parseOpenAPIServerProxyURI k =
|
|
optString k >>= \case
|
|
Nothing -> pure Nothing
|
|
Just val | isMalformedProxyUri val -> fail "Malformed proxy uri, a correct example: https://example.com:8443/basePath"
|
|
| otherwise -> pure $ Just val
|
|
|
|
parseLogLevel :: C.Key -> C.Parser C.Config LogLevel
|
|
parseLogLevel k =
|
|
optString k >>= \case
|
|
Nothing -> pure LogError
|
|
Just "crit" -> pure LogCrit
|
|
Just "error" -> pure LogError
|
|
Just "warn" -> pure LogWarn
|
|
Just "info" -> pure LogInfo
|
|
Just "debug" -> pure LogDebug
|
|
Just _ -> fail "Invalid logging level. Check your configuration."
|
|
|
|
parseTxEnd :: C.Key -> ((Bool, Bool) -> Bool) -> C.Parser C.Config Bool
|
|
parseTxEnd k f =
|
|
optString k >>= \case
|
|
-- RollbackAll AllowOverride
|
|
Nothing -> pure $ f (False, False)
|
|
Just "commit" -> pure $ f (False, False)
|
|
Just "commit-allow-override" -> pure $ f (False, True)
|
|
Just "rollback" -> pure $ f (True, False)
|
|
Just "rollback-allow-override" -> pure $ f (True, True)
|
|
Just _ -> fail "Invalid transaction termination. Check your configuration."
|
|
|
|
parseRoleClaimKey :: C.Key -> C.Key -> C.Parser C.Config JSPath
|
|
parseRoleClaimKey k al =
|
|
optWithAlias (optString k) (optString al) >>= \case
|
|
Nothing -> pure [JSPKey "role"]
|
|
Just rck -> either (fail . show) pure $ pRoleClaimKey rck
|
|
|
|
parseCORSAllowedOrigins k =
|
|
optString k >>= \case
|
|
Nothing -> pure Nothing
|
|
Just orig -> pure $ Just (T.strip <$> T.splitOn "," orig)
|
|
|
|
optWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a)
|
|
optWithAlias orig alias =
|
|
orig >>= \case
|
|
Just v -> pure $ Just v
|
|
Nothing -> alias
|
|
|
|
optString :: C.Key -> C.Parser C.Config (Maybe Text)
|
|
optString k = mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText
|
|
|
|
optStringEmptyable :: C.Key -> C.Parser C.Config (Maybe Text)
|
|
optStringEmptyable k = overrideFromDbOrEnvironment C.optional k coerceText
|
|
|
|
optStringOrURI :: C.Key -> C.Parser C.Config (Maybe Text)
|
|
optStringOrURI k = do
|
|
stringOrURI <- mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText
|
|
-- If the string contains ':' then it should
|
|
-- be a valid URI according to RFC 3986
|
|
case stringOrURI of
|
|
Just s -> if T.isInfixOf ":" s then validateURI s else return (Just s)
|
|
Nothing -> return Nothing
|
|
where
|
|
validateURI :: Text -> C.Parser C.Config (Maybe Text)
|
|
validateURI s = if isURI (T.unpack s)
|
|
then return $ Just s
|
|
else fail "jwt-aud should be a string or a valid URI"
|
|
|
|
optInt :: (Read i, Integral i) => C.Key -> C.Parser C.Config (Maybe i)
|
|
optInt k = join <$> overrideFromDbOrEnvironment C.optional k coerceInt
|
|
|
|
optBool :: C.Key -> C.Parser C.Config (Maybe Bool)
|
|
optBool k = join <$> overrideFromDbOrEnvironment C.optional k coerceBool
|
|
|
|
overrideFromDbOrEnvironment :: JustIfMaybe a b =>
|
|
(C.Key -> C.Parser C.Value a -> C.Parser C.Config b) ->
|
|
C.Key -> (C.Value -> a) -> C.Parser C.Config b
|
|
overrideFromDbOrEnvironment necessity key coercion =
|
|
case dbConf <|> M.lookup envVarName env of
|
|
Just dbOrEnvVal -> pure $ justIfMaybe $ coercion $ C.String dbOrEnvVal
|
|
Nothing -> necessity key (coercion <$> C.value)
|
|
where
|
|
dashToUnderscore '-' = '_'
|
|
dashToUnderscore c = c
|
|
envVarName = "PGRST_" <> (toUpper . dashToUnderscore <$> toS key)
|
|
dbConf = lookup (T.pack $ dashToUnderscore <$> toS key) dbSettings
|
|
|
|
coerceText :: C.Value -> Text
|
|
coerceText (C.String s) = s
|
|
coerceText v = show v
|
|
|
|
coerceInt :: (Read i, Integral i) => C.Value -> Maybe i
|
|
coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x
|
|
coerceInt (C.String x) = readMaybe x
|
|
coerceInt _ = Nothing
|
|
|
|
coerceBool :: C.Value -> Maybe Bool
|
|
coerceBool (C.Bool b) = Just b
|
|
coerceBool (C.String s) =
|
|
-- parse all kinds of text: True, true, TRUE, "true", ...
|
|
case readMaybe $ T.toTitle $ T.filter isAlpha $ toS s of
|
|
Just b -> Just b
|
|
-- numeric instead?
|
|
Nothing -> (> 0) <$> (readMaybe s :: Maybe Integer)
|
|
coerceBool _ = Nothing
|
|
|
|
splitOnCommas :: Text -> [Text]
|
|
splitOnCommas s = T.strip <$> T.splitOn "," s
|
|
|
|
splitOnCommasEmptyable :: Text -> [Text]
|
|
splitOnCommasEmptyable "" = []
|
|
splitOnCommasEmptyable s = T.strip <$> T.splitOn "," s
|
|
|
|
defaultHoistedAllowList = ["statement_timeout","plan_filter.statement_cost_limit","default_transaction_isolation"]
|
|
|
|
defaultServerHost :: Maybe Text -> Text
|
|
defaultServerHost = fromMaybe "!4"
|
|
|
|
-- | Read the JWT secret from a file if configJwtSecret is actually a
|
|
-- filepath(has @ as its prefix). To check if the JWT secret is provided is
|
|
-- in fact a file path, it must be decoded as 'Text' to be processed.
|
|
readSecretFile :: AppConfig -> IO AppConfig
|
|
readSecretFile conf =
|
|
maybe (return conf) readSecret maybeFilename
|
|
where
|
|
maybeFilename = T.stripPrefix "@" . decodeUtf8 =<< configJwtSecret conf
|
|
readSecret filename = do
|
|
jwtSecret <- chomp <$> BS.readFile (toS filename)
|
|
return $ conf { configJwtSecret = Just jwtSecret }
|
|
chomp bs = fromMaybe bs (BS.stripSuffix "\n" bs)
|
|
|
|
decodeSecret :: AppConfig -> IO AppConfig
|
|
decodeSecret conf@AppConfig{..} =
|
|
case (configJwtSecretIsBase64, configJwtSecret) of
|
|
(True, Just secret) ->
|
|
either fail (return . updateSecret) $ decodeB64 secret
|
|
_ -> return conf
|
|
where
|
|
updateSecret bs = conf { configJwtSecret = Just bs }
|
|
decodeB64 = B64.decode . encodeUtf8 . T.strip . replaceUrlChars . decodeUtf8
|
|
replaceUrlChars = T.replace "_" "/" . T.replace "-" "+" . T.replace "." "="
|
|
|
|
-- | Parse `jwt-secret` configuration option and turn into a JWKS.
|
|
--
|
|
-- There are three ways to specify `jwt-secret`: text secret, JSON Web Key
|
|
-- (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JwkSet
|
|
-- with one key and the last is converted as is.
|
|
decodeJWKS :: AppConfig -> IO AppConfig
|
|
decodeJWKS conf = do
|
|
jwks <- case configJwtSecret conf of
|
|
Just s -> either fail (pure . Just) $ parseSecret s
|
|
Nothing -> pure Nothing
|
|
return $ conf { configJWKS = jwks }
|
|
|
|
parseSecret :: ByteString -> Either [Char] JwkSet
|
|
parseSecret bytes =
|
|
case maybeJWKSet of
|
|
Just jwk -> Right jwk
|
|
Nothing -> maybe validateSecret (\jwk' -> Right $ JWT.JwkSet [jwk']) maybeJWK
|
|
where
|
|
maybeJWKSet = JSON.decodeStrict bytes :: Maybe JwkSet
|
|
maybeJWK = JSON.decodeStrict bytes :: Maybe Jwk
|
|
secret = JWT.JwkSet [JWT.SymmetricJwk bytes Nothing (Just JWT.Sig) (Just $ JWT.Signed JWT.HS256)]
|
|
validateSecret
|
|
| BS.length bytes < 32 = Left "The JWT secret must be at least 32 characters long."
|
|
| otherwise = Right secret
|
|
|
|
-- | Read database uri from a separate file if `db-uri` is a filepath.
|
|
readDbUriFile :: Maybe Text -> AppConfig -> IO AppConfig
|
|
readDbUriFile maybeDbUri conf =
|
|
case maybeDbUri of
|
|
Just prevDbUri ->
|
|
pure $ conf { configDbUri = prevDbUri }
|
|
Nothing ->
|
|
case T.stripPrefix "@" $ configDbUri conf of
|
|
Nothing -> return conf
|
|
Just filename -> do
|
|
dbUri <- T.strip <$> readFile (toS filename)
|
|
return $ conf { configDbUri = dbUri }
|
|
|
|
type Environment = M.Map [Char] Text
|
|
|
|
-- | Read environment variables that start with PGRST_
|
|
readPGRSTEnvironment :: IO Environment
|
|
readPGRSTEnvironment =
|
|
M.map T.pack . M.fromList . filter (isPrefixOf "PGRST_" . fst) <$> getEnvironment
|
|
|
|
data PGConnString = PGURI | PGKeyVal
|
|
|
|
-- Uses same logic as libpq recognized_connection_string
|
|
-- https://github.com/postgres/postgres/blob/5eafacd2797dc0b04a0bde25fbf26bf79903e7c2/src/interfaces/libpq/fe-connect.c#L5923-L5936
|
|
pgConnString :: Text -> Maybe PGConnString
|
|
pgConnString conn | uriDesignator `T.isPrefixOf` conn || shortUriDesignator `T.isPrefixOf` conn = Just PGURI
|
|
| "=" `T.isInfixOf` conn = Just PGKeyVal
|
|
| otherwise = Nothing
|
|
where
|
|
uriDesignator = "postgresql://"
|
|
shortUriDesignator = "postgres://"
|
|
|
|
-- | Adds a `fallback_application_name` value to the connection string. This allows querying the PostgREST version on pg_stat_activity.
|
|
--
|
|
-- >>> let ver = "11.1.0 (5a04ec7)"::ByteString
|
|
-- >>> let strangeVer = "11'1&0@#$%,.:\"[]{}?+^()=asdfqwer"::ByteString
|
|
--
|
|
-- >>> addFallbackAppName ver "postgres://user:pass@host:5432/postgres"
|
|
-- "postgres://user:pass@host:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
--
|
|
-- >>> addFallbackAppName ver "postgres://user:pass@host:5432/postgres?"
|
|
-- "postgres://user:pass@host:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
--
|
|
-- >>> addFallbackAppName ver "postgres:///postgres?host=server&port=5432"
|
|
-- "postgres:///postgres?host=server&port=5432&fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
--
|
|
-- >>> addFallbackAppName ver "postgresql://"
|
|
-- "postgresql://?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
--
|
|
-- >>> addFallbackAppName strangeVer "postgres:///postgres?host=server&port=5432"
|
|
-- "postgres:///postgres?host=server&port=5432&fallback_application_name=PostgREST%2011%271%260%40%23%24%25%2C.%3A%22%5B%5D%7B%7D%3F%2B%5E%28%29%3Dasdfqwer"
|
|
--
|
|
-- >>> addFallbackAppName ver "postgres://user:invalid_chars[]#@host:5432/postgres"
|
|
-- "postgres://user:invalid_chars[]#@host:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
--
|
|
-- >>> addFallbackAppName ver "host=localhost port=5432 dbname=postgres"
|
|
-- "host=localhost port=5432 dbname=postgres fallback_application_name='PostgREST 11.1.0 (5a04ec7)'"
|
|
--
|
|
-- >>> addFallbackAppName strangeVer "host=localhost port=5432 dbname=postgres"
|
|
-- "host=localhost port=5432 dbname=postgres fallback_application_name='PostgREST 11\\'1&0@#$%,.:\"[]{}?+^()=asdfqwer'"
|
|
--
|
|
-- works with passwords containing `?`
|
|
-- >>> addFallbackAppName ver "postgres://admin2:?pass?special?@localhost:5432/postgres"
|
|
-- "postgres://admin2:?pass?special?@localhost:5432/postgres?fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
--
|
|
-- addFallbackAppName ver "postgresql://?dbname=postgres&host=/run/user/1000/postgrest/postgrest-with-postgresql-16-BuR/socket&user=some_protected_user&password=invalid_pass"
|
|
-- "postgresql://?dbname=postgres&host=/run/user/1000/postgrest/postgrest-with-postgresql-16-BuR/socket&user=some_protected_user&password=invalid_pass&fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
--
|
|
-- addFallbackAppName ver "postgresql:///postgres?host=/run/user/1000/postgrest/postgrest-with-postgresql-16-BuR/socket&user=some_protected_user&password=invalid_pass"
|
|
-- "postgresql:///postgres?host=/run/user/1000/postgrest/postgrest-with-postgresql-16-BuR/socket&user=some_protected_user&password=invalid_pass&fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29"
|
|
addFallbackAppName :: ByteString -> Text -> Text
|
|
addFallbackAppName version dbUri = addConnStringOption dbUri "fallback_application_name" pgrstVer
|
|
where
|
|
pgrstVer = "PostgREST " <> T.decodeUtf8 version
|
|
|
|
-- | Adds `target_session_attrs=read-write` to the connection string. This allows using PostgREST listener when multiple hosts are specified in the connection string.
|
|
--
|
|
-- >>> addTargetSessionAttrs "postgres:///postgres?host=/dir/0kN/socket_replica_24378,/dir/0kN/socket"
|
|
-- "postgres:///postgres?host=/dir/0kN/socket_replica_24378,/dir/0kN/socket&target_session_attrs=read-write"
|
|
--
|
|
-- >>> addTargetSessionAttrs "postgresql://host1:123,host2:456/somedb"
|
|
-- "postgresql://host1:123,host2:456/somedb?target_session_attrs=read-write"
|
|
--
|
|
-- >>> addTargetSessionAttrs "postgresql://host1:123,host2:456/somedb?fallback_application_name=foo"
|
|
-- "postgresql://host1:123,host2:456/somedb?fallback_application_name=foo&target_session_attrs=read-write"
|
|
--
|
|
-- adds target_session_attrs despite one existing
|
|
-- >>> addTargetSessionAttrs "postgresql://host1:123,host2:456/somedb?target_session_attrs=read-only"
|
|
-- "postgresql://host1:123,host2:456/somedb?target_session_attrs=read-only&target_session_attrs=read-write"
|
|
--
|
|
-- >>> addTargetSessionAttrs "host=localhost port=5432 dbname=postgres"
|
|
-- "host=localhost port=5432 dbname=postgres target_session_attrs='read-write'"
|
|
addTargetSessionAttrs :: Text -> Text
|
|
addTargetSessionAttrs dbUri = addConnStringOption dbUri "target_session_attrs" "read-write"
|
|
|
|
addConnStringOption :: Text -> Text -> Text -> Text
|
|
addConnStringOption dbUri key val = dbUri <>
|
|
case pgConnString dbUri of
|
|
Nothing -> mempty
|
|
Just PGKeyVal -> " " <> keyValFmt
|
|
Just PGURI -> case lookAtOptions dbUri of
|
|
(_, "") -> "?" <> uriFmt
|
|
(_, "?") -> uriFmt
|
|
(_, _) -> "&" <> uriFmt
|
|
where
|
|
uriFmt = key <> "=" <> toS (escapeURIString isUnescapedInURIComponent $ toS val)
|
|
keyValFmt = key <> "=" <> "'" <> T.replace "'" "\\'" val <> "'"
|
|
lookAtOptions x = T.breakOn "?" . snd $ T.breakOnEnd "@" x -- start from after `@` to not mess passwords that include `?`, see https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING-URIS
|
|
|
|
-- | Example config file displayed on postgrest "--example" flag
|
|
exampleConfigFile :: [Char]
|
|
exampleConfigFile = S.unlines
|
|
[ "## Admin server used for checks. It's disabled by default unless a port is specified."
|
|
, "# admin-server-port = 3001"
|
|
, ""
|
|
, "## The database role to use when no client authentication is provided"
|
|
, "# db-anon-role = \"anon\""
|
|
, ""
|
|
, "## 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"
|
|
, ""
|
|
, "## Function for in-database configuration"
|
|
, "## db-pre-config = \"postgrest.pre_config\""
|
|
, ""
|
|
, "## Extra schemas to add to the search_path of every request"
|
|
, "db-extra-search-path = \"public\""
|
|
, ""
|
|
, "## Limit rows in response"
|
|
, "# db-max-rows = 1000"
|
|
, ""
|
|
, "## Allow getting the EXPLAIN plan through the `Accept: application/vnd.pgrst.plan` header"
|
|
, "# db-plan-enabled = false"
|
|
, ""
|
|
, "## Number of open connections in the pool"
|
|
, "db-pool = 10"
|
|
, ""
|
|
, "## Time in seconds to wait to acquire a slot from the connection pool"
|
|
, "# db-pool-acquisition-timeout = 10"
|
|
, ""
|
|
, "## Time in seconds after which to recycle pool connections"
|
|
, "# db-pool-max-lifetime = 1800"
|
|
, ""
|
|
, "## Time in seconds after which to recycle unused pool connections"
|
|
, "# db-pool-max-idletime = 30"
|
|
, ""
|
|
, "## Allow automatic database connection retrying"
|
|
, "# db-pool-automatic-recovery = true"
|
|
, ""
|
|
, "## Stored proc to exec immediately after auth"
|
|
, "# db-pre-request = \"stored_proc_name\""
|
|
, ""
|
|
, "## 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"
|
|
, ""
|
|
, "## The name of which database schema to expose to REST clients"
|
|
, "db-schemas = \"public\""
|
|
, ""
|
|
, "## 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\""
|
|
, ""
|
|
, "## The standard connection URI format, documented at"
|
|
, "## https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING"
|
|
, "db-uri = \"postgresql://\""
|
|
, ""
|
|
, "# jwt-aud = \"your_audience_claim\""
|
|
, ""
|
|
, "## Jspath to the role claim key"
|
|
, "jwt-role-claim-key = \".role\""
|
|
, ""
|
|
, "## 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-secret-is-base64 = false"
|
|
, ""
|
|
, "## Enables JWT Cache and sets its max size, disables caching with 0"
|
|
, "# jwt-cache-max-entries = 0"
|
|
, ""
|
|
, "## Logging level, the admitted values are: crit, error, warn, info and debug."
|
|
, "log-level = \"error\""
|
|
, ""
|
|
, "## Log the SQL query at the current log-level."
|
|
, "log-query = false"
|
|
, ""
|
|
, "## 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 = \"\""
|
|
, ""
|
|
, "## Configurable CORS origins"
|
|
, "# server-cors-allowed-origins = \"\""
|
|
, ""
|
|
, "server-host = \"!4\""
|
|
, "server-port = 3000"
|
|
, ""
|
|
, "## Allow getting the request-response timing information through the `Server-Timing` header"
|
|
, "server-timing-enabled = false"
|
|
, ""
|
|
, "## 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\""
|
|
]
|