1{-| 2Module : PostgREST.Config 3Description : Manages PostgREST configuration type and parser. 4 5-} 6{-# LANGUAGE FlexibleContexts #-} 7{-# LANGUAGE FlexibleInstances #-} 8{-# LANGUAGE LambdaCase #-} 9{-# LANGUAGE MultiParamTypeClasses #-} 10{-# LANGUAGE RecordWildCards #-} 11{-# OPTIONS_GHC -fno-warn-type-defaults #-} 12 13module PostgREST.Config 14 ( AppConfig (..) 15 , Environment 16 , JSPath 17 , JSPathExp(..) 18 , LogLevel(..) 19 , OpenAPIMode(..) 20 , Proxy(..) 21 , toText 22 , isMalformedProxyUri 23 , readAppConfig 24 , readPGRSTEnvironment 25 , toURI 26 , parseSecret 27 ) where 28 29import qualified Crypto.JOSE.Types as JOSE 30import qualified Crypto.JWT as JWT 31import qualified Data.Aeson as JSON 32import qualified Data.ByteString as B 33import qualified Data.ByteString.Base64 as B64 34import qualified Data.ByteString.Char8 as BS 35import qualified Data.Configurator as C 36import qualified Data.Map.Strict as M 37import qualified Data.Text as T 38 39import qualified GHC.Show (show) 40 41import Control.Lens (preview) 42import Control.Monad (fail) 43import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri) 44import Data.Aeson (encode, toJSON) 45import Data.Either.Combinators (mapLeft) 46import Data.List (lookup) 47import Data.List.NonEmpty (fromList, toList) 48import Data.Maybe (fromJust) 49import Data.Scientific (floatingOrInteger) 50import Data.Time.Clock (NominalDiffTime) 51import Numeric (readOct, showOct) 52import System.Environment (getEnvironment) 53import System.Posix.Types (FileMode) 54 55import PostgREST.Config.JSPath (JSPath, JSPathExp (..), 56 pRoleClaimKey) 57import PostgREST.Config.Proxy (Proxy (..), 58 isMalformedProxyUri, toURI) 59import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, toQi) 60 61import Protolude hiding (Proxy, toList, toS) 62import Protolude.Conv (toS) 63 64 65data AppConfig = AppConfig 66 { configAppSettings :: [(Text, Text)] 67 , configDbAnonRole :: Text 68 , configDbChannel :: Text 69 , configDbChannelEnabled :: Bool 70 , configDbExtraSearchPath :: [Text] 71 , configDbMaxRows :: Maybe Integer 72 , configDbPoolSize :: Int 73 , configDbPoolTimeout :: NominalDiffTime 74 , configDbPreRequest :: Maybe QualifiedIdentifier 75 , configDbPreparedStatements :: Bool 76 , configDbRootSpec :: Maybe QualifiedIdentifier 77 , configDbSchemas :: NonEmpty Text 78 , configDbConfig :: Bool 79 , configDbTxAllowOverride :: Bool 80 , configDbTxRollbackAll :: Bool 81 , configDbUri :: Text 82 , configFilePath :: Maybe FilePath 83 , configJWKS :: Maybe JWKSet 84 , configJwtAudience :: Maybe StringOrURI 85 , configJwtRoleClaimKey :: JSPath 86 , configJwtSecret :: Maybe B.ByteString 87 , configJwtSecretIsBase64 :: Bool 88 , configLogLevel :: LogLevel 89 , configOpenApiMode :: OpenAPIMode 90 , configOpenApiServerProxyUri :: Maybe Text 91 , configRawMediaTypes :: [B.ByteString] 92 , configServerHost :: Text 93 , configServerPort :: Int 94 , configServerUnixSocket :: Maybe FilePath 95 , configServerUnixSocketMode :: FileMode 96 } 97 98data LogLevel = LogCrit | LogError | LogWarn | LogInfo 99 100instance Show LogLevel where 101 show LogCrit = "crit" 102 show LogError = "error" 103 show LogWarn = "warn" 104 show LogInfo = "info" 105 106data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled 107 deriving Eq 108 109instance Show OpenAPIMode where 110 show OAFollowPriv = "follow-privileges" 111 show OAIgnorePriv = "ignore-privileges" 112 show OADisabled = "disabled" 113 114-- | Dump the config 115toText :: AppConfig -> Text 116toText conf = 117 unlines $ (\(k, v) -> k <> " = " <> v) <$> pgrstSettings ++ appSettings 118 where 119 -- apply conf to all pgrst settings 120 pgrstSettings = (\(k, v) -> (k, v conf)) <$> 121 [("db-anon-role", q . configDbAnonRole) 122 ,("db-channel", q . configDbChannel) 123 ,("db-channel-enabled", T.toLower . show . configDbChannelEnabled) 124 ,("db-extra-search-path", q . T.intercalate "," . configDbExtraSearchPath) 125 ,("db-max-rows", maybe "\"\"" show . configDbMaxRows) 126 ,("db-pool", show . configDbPoolSize) 127 ,("db-pool-timeout", show . floor . configDbPoolTimeout) 128 ,("db-pre-request", q . maybe mempty show . configDbPreRequest) 129 ,("db-prepared-statements", T.toLower . show . configDbPreparedStatements) 130 ,("db-root-spec", q . maybe mempty show . configDbRootSpec) 131 ,("db-schemas", q . T.intercalate "," . toList . configDbSchemas) 132 ,("db-config", q . T.toLower . show . configDbConfig) 133 ,("db-tx-end", q . showTxEnd) 134 ,("db-uri", q . configDbUri) 135 ,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience) 136 ,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey) 137 ,("jwt-secret", q . toS . showJwtSecret) 138 ,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64) 139 ,("log-level", q . show . configLogLevel) 140 ,("openapi-mode", q . show . configOpenApiMode) 141 ,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri) 142 ,("raw-media-types", q . toS . B.intercalate "," . configRawMediaTypes) 143 ,("server-host", q . configServerHost) 144 ,("server-port", show . configServerPort) 145 ,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket) 146 ,("server-unix-socket-mode", q . T.pack . showSocketMode) 147 ] 148 149 -- quote all app.settings 150 appSettings = second q <$> configAppSettings conf 151 152 -- quote strings and replace " with \" 153 q s = "\"" <> T.replace "\"" "\\\"" s <> "\"" 154 155 showTxEnd c = case (configDbTxRollbackAll c, configDbTxAllowOverride c) of 156 ( False, False ) -> "commit" 157 ( False, True ) -> "commit-allow-override" 158 ( True , False ) -> "rollback" 159 ( True , True ) -> "rollback-allow-override" 160 showJwtSecret c 161 | configJwtSecretIsBase64 c = B64.encode secret 162 | otherwise = toS secret 163 where 164 secret = fromMaybe mempty $ configJwtSecret c 165 showSocketMode c = showOct (configServerUnixSocketMode c) mempty 166 167-- This class is needed for the polymorphism of overrideFromDbOrEnvironment 168-- because C.required and C.optional have different signatures 169class JustIfMaybe a b where 170 justIfMaybe :: a -> b 171 172instance JustIfMaybe a a where 173 justIfMaybe a = a 174 175instance JustIfMaybe a (Maybe a) where 176 justIfMaybe a = Just a 177 178-- | Reads and parses the config and overrides its parameters from env vars, 179-- files or db settings. 180readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> IO (Either Text AppConfig) 181readAppConfig dbSettings optPath prevDbUri = do 182 env <- readPGRSTEnvironment 183 -- if no filename provided, start with an empty map to read config from environment 184 conf <- maybe (return $ Right M.empty) loadConfig optPath 185 186 case C.runParser (parser optPath env dbSettings) =<< mapLeft show conf of 187 Left err -> 188 return . Left $ "Error in config " <> err 189 Right parsedConfig -> 190 Right <$> decodeLoadFiles parsedConfig 191 where 192 -- Both C.ParseError and IOError are shown here 193 loadConfig :: FilePath -> IO (Either SomeException C.Config) 194 loadConfig = try . C.load 195 196 decodeLoadFiles :: AppConfig -> IO AppConfig 197 decodeLoadFiles parsedConfig = 198 decodeJWKS <$> 199 (decodeSecret =<< readSecretFile =<< readDbUriFile prevDbUri parsedConfig) 200 201parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> C.Parser C.Config AppConfig 202parser optPath env dbSettings = 203 AppConfig 204 <$> parseAppSettings "app.settings" 205 <*> reqString "db-anon-role" 206 <*> (fromMaybe "pgrst" <$> optString "db-channel") 207 <*> (fromMaybe True <$> optBool "db-channel-enabled") 208 <*> (maybe ["public"] splitOnCommas <$> optValue "db-extra-search-path") 209 <*> optWithAlias (optInt "db-max-rows") 210 (optInt "max-rows") 211 <*> (fromMaybe 10 <$> optInt "db-pool") 212 <*> (fromIntegral . fromMaybe 10 <$> optInt "db-pool-timeout") 213 <*> (fmap toQi <$> optWithAlias (optString "db-pre-request") 214 (optString "pre-request")) 215 <*> (fromMaybe True <$> optBool "db-prepared-statements") 216 <*> (fmap toQi <$> optWithAlias (optString "db-root-spec") 217 (optString "root-spec")) 218 <*> (fromList . splitOnCommas <$> reqWithAlias (optValue "db-schemas") 219 (optValue "db-schema") 220 "missing key: either db-schemas or db-schema must be set") 221 <*> (fromMaybe True <$> optBool "db-config") 222 <*> parseTxEnd "db-tx-end" snd 223 <*> parseTxEnd "db-tx-end" fst 224 <*> reqString "db-uri" 225 <*> pure optPath 226 <*> pure Nothing 227 <*> parseJwtAudience "jwt-aud" 228 <*> parseRoleClaimKey "jwt-role-claim-key" "role-claim-key" 229 <*> (fmap encodeUtf8 <$> optString "jwt-secret") 230 <*> (fromMaybe False <$> optWithAlias 231 (optBool "jwt-secret-is-base64") 232 (optBool "secret-is-base64")) 233 <*> parseLogLevel "log-level" 234 <*> parseOpenAPIMode "openapi-mode" 235 <*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri" 236 <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types") 237 <*> (fromMaybe "!4" <$> optString "server-host") 238 <*> (fromMaybe 3000 <$> optInt "server-port") 239 <*> (fmap T.unpack <$> optString "server-unix-socket") 240 <*> parseSocketFileMode "server-unix-socket-mode" 241 where 242 parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)] 243 parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value 244 where 245 addFromEnv f = M.toList $ M.union fromEnv $ M.fromList f 246 fromEnv = M.mapKeys fromJust $ M.filterWithKey (\k _ -> isJust k) $ M.mapKeys normalize env 247 normalize k = ("app.settings." <>) <$> T.stripPrefix "PGRST_APP_SETTINGS_" (toS k) 248 249 parseSocketFileMode :: C.Key -> C.Parser C.Config FileMode 250 parseSocketFileMode k = 251 optString k >>= \case 252 Nothing -> pure 432 -- return default 660 mode if no value was provided 253 Just fileModeText -> 254 case readOct $ T.unpack fileModeText of 255 [] -> 256 fail "Invalid server-unix-socket-mode: not an octal" 257 (fileMode, _):_ -> 258 if fileMode < 384 || fileMode > 511 259 then fail "Invalid server-unix-socket-mode: needs to be between 600 and 777" 260 else pure fileMode 261 262 parseOpenAPIMode :: C.Key -> C.Parser C.Config OpenAPIMode 263 parseOpenAPIMode k = 264 optString k >>= \case 265 Nothing -> pure OAFollowPriv 266 Just "follow-privileges" -> pure OAFollowPriv 267 Just "ignore-privileges" -> pure OAIgnorePriv 268 Just "disabled" -> pure OADisabled 269 Just _ -> fail "Invalid openapi-mode. Check your configuration." 270 271 parseOpenAPIServerProxyURI :: C.Key -> C.Parser C.Config (Maybe Text) 272 parseOpenAPIServerProxyURI k = 273 optString k >>= \case 274 Nothing -> pure Nothing 275 Just val | isMalformedProxyUri val -> fail "Malformed proxy uri, a correct example: https://example.com:8443/basePath" 276 | otherwise -> pure $ Just val 277 278 parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI) 279 parseJwtAudience k = 280 optString k >>= \case 281 Nothing -> pure Nothing -- no audience in config file 282 Just aud -> case preview stringOrUri (T.unpack aud) of 283 Nothing -> fail "Invalid Jwt audience. Check your configuration." 284 aud' -> pure aud' 285 286 parseLogLevel :: C.Key -> C.Parser C.Config LogLevel 287 parseLogLevel k = 288 optString k >>= \case 289 Nothing -> pure LogError 290 Just "crit" -> pure LogCrit 291 Just "error" -> pure LogError 292 Just "warn" -> pure LogWarn 293 Just "info" -> pure LogInfo 294 Just _ -> fail "Invalid logging level. Check your configuration." 295 296 parseTxEnd :: C.Key -> ((Bool, Bool) -> Bool) -> C.Parser C.Config Bool 297 parseTxEnd k f = 298 optString k >>= \case 299 -- RollbackAll AllowOverride 300 Nothing -> pure $ f (False, False) 301 Just "commit" -> pure $ f (False, False) 302 Just "commit-allow-override" -> pure $ f (False, True) 303 Just "rollback" -> pure $ f (True, False) 304 Just "rollback-allow-override" -> pure $ f (True, True) 305 Just _ -> fail "Invalid transaction termination. Check your configuration." 306 307 parseRoleClaimKey :: C.Key -> C.Key -> C.Parser C.Config JSPath 308 parseRoleClaimKey k al = 309 optWithAlias (optString k) (optString al) >>= \case 310 Nothing -> pure [JSPKey "role"] 311 Just rck -> either (fail . show) pure $ pRoleClaimKey rck 312 313 reqWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> [Char] -> C.Parser C.Config a 314 reqWithAlias orig alias err = 315 orig >>= \case 316 Just v -> pure v 317 Nothing -> 318 alias >>= \case 319 Just v -> pure v 320 Nothing -> fail err 321 322 optWithAlias :: C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) -> C.Parser C.Config (Maybe a) 323 optWithAlias orig alias = 324 orig >>= \case 325 Just v -> pure $ Just v 326 Nothing -> alias 327 328 reqString :: C.Key -> C.Parser C.Config Text 329 reqString k = overrideFromDbOrEnvironment C.required k coerceText 330 331 optString :: C.Key -> C.Parser C.Config (Maybe Text) 332 optString k = mfilter (/= "") <$> overrideFromDbOrEnvironment C.optional k coerceText 333 334 optValue :: C.Key -> C.Parser C.Config (Maybe C.Value) 335 optValue k = overrideFromDbOrEnvironment C.optional k identity 336 337 optInt :: (Read i, Integral i) => C.Key -> C.Parser C.Config (Maybe i) 338 optInt k = join <$> overrideFromDbOrEnvironment C.optional k coerceInt 339 340 optBool :: C.Key -> C.Parser C.Config (Maybe Bool) 341 optBool k = join <$> overrideFromDbOrEnvironment C.optional k coerceBool 342 343 overrideFromDbOrEnvironment :: JustIfMaybe a b => 344 (C.Key -> C.Parser C.Value a -> C.Parser C.Config b) -> 345 C.Key -> (C.Value -> a) -> C.Parser C.Config b 346 overrideFromDbOrEnvironment necessity key coercion = 347 case reloadableDbSetting <|> M.lookup envVarName env of 348 Just dbOrEnvVal -> pure $ justIfMaybe $ coercion $ C.String dbOrEnvVal 349 Nothing -> necessity key (coercion <$> C.value) 350 where 351 dashToUnderscore '-' = '_' 352 dashToUnderscore c = c 353 envVarName = "PGRST_" <> (toUpper . dashToUnderscore <$> toS key) 354 reloadableDbSetting = 355 let dbSettingName = T.pack $ dashToUnderscore <$> toS key in 356 if dbSettingName `notElem` [ 357 "server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "log_level", 358 "db_anon_role", "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_timeout", "db_config"] 359 then lookup dbSettingName dbSettings 360 else Nothing 361 362 coerceText :: C.Value -> Text 363 coerceText (C.String s) = s 364 coerceText v = show v 365 366 coerceInt :: (Read i, Integral i) => C.Value -> Maybe i 367 coerceInt (C.Number x) = rightToMaybe $ floatingOrInteger x 368 coerceInt (C.String x) = readMaybe $ toS x 369 coerceInt _ = Nothing 370 371 coerceBool :: C.Value -> Maybe Bool 372 coerceBool (C.Bool b) = Just b 373 coerceBool (C.String s) = 374 -- parse all kinds of text: True, true, TRUE, "true", ... 375 case readMaybe . toS $ T.toTitle $ T.filter isAlpha $ toS s of 376 Just b -> Just b 377 -- numeric instead? 378 Nothing -> (> 0) <$> (readMaybe $ toS s :: Maybe Integer) 379 coerceBool _ = Nothing 380 381 splitOnCommas :: C.Value -> [Text] 382 splitOnCommas (C.String s) = T.strip <$> T.splitOn "," s 383 splitOnCommas _ = [] 384 385-- | Read the JWT secret from a file if configJwtSecret is actually a 386-- filepath(has @ as its prefix). To check if the JWT secret is provided is 387-- in fact a file path, it must be decoded as 'Text' to be processed. 388readSecretFile :: AppConfig -> IO AppConfig 389readSecretFile conf = 390 maybe (return conf) readSecret maybeFilename 391 where 392 maybeFilename = T.stripPrefix "@" . decodeUtf8 =<< configJwtSecret conf 393 readSecret filename = do 394 jwtSecret <- chomp <$> BS.readFile (toS filename) 395 return $ conf { configJwtSecret = Just jwtSecret } 396 chomp bs = fromMaybe bs (BS.stripSuffix "\n" bs) 397 398decodeSecret :: AppConfig -> IO AppConfig 399decodeSecret conf@AppConfig{..} = 400 case (configJwtSecretIsBase64, configJwtSecret) of 401 (True, Just secret) -> 402 either fail (return . updateSecret) $ decodeB64 secret 403 _ -> return conf 404 where 405 updateSecret bs = conf { configJwtSecret = Just bs } 406 decodeB64 = B64.decode . encodeUtf8 . T.strip . replaceUrlChars . decodeUtf8 407 replaceUrlChars = T.replace "_" "/" . T.replace "-" "+" . T.replace "." "=" 408 409-- | Parse `jwt-secret` configuration option and turn into a JWKSet. 410-- 411-- There are three ways to specify `jwt-secret`: text secret, JSON Web Key 412-- (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JWKSet 413-- with one key and the last is converted as is. 414decodeJWKS :: AppConfig -> AppConfig 415decodeJWKS conf = 416 conf { configJWKS = parseSecret <$> configJwtSecret conf } 417 418parseSecret :: ByteString -> JWKSet 419parseSecret bytes = 420 fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK) 421 maybeJWKSet 422 where 423 maybeJWKSet = JSON.decode (toS bytes) :: Maybe JWKSet 424 maybeJWK = JSON.decode (toS bytes) :: Maybe JWK 425 secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial] 426 keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes 427 428-- | Read database uri from a separate file if `db-uri` is a filepath. 429readDbUriFile :: Maybe Text -> AppConfig -> IO AppConfig 430readDbUriFile maybeDbUri conf = 431 case maybeDbUri of 432 Just prevDbUri -> 433 pure $ conf { configDbUri = prevDbUri } 434 Nothing -> 435 case T.stripPrefix "@" $ configDbUri conf of 436 Nothing -> return conf 437 Just filename -> do 438 dbUri <- T.strip <$> readFile (toS filename) 439 return $ conf { configDbUri = dbUri } 440 441type Environment = M.Map [Char] Text 442 443-- | Read environment variables that start with PGRST_ 444readPGRSTEnvironment :: IO Environment 445readPGRSTEnvironment = 446 M.map T.pack . M.fromList . filter (isPrefixOf "PGRST_" . fst) <$> getEnvironment 447