From beea3fe7eaa17e0531278d8ff0fe417996799b67 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Thu, 25 Feb 2021 00:00:15 -0500 Subject: [PATCH] Separate reading files from whole config re-read --- main/Main.hs | 55 ++++++++------- src/PostgREST/Config.hs | 149 +++++++++++++++------------------------- 2 files changed, 87 insertions(+), 117 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index 15c15c8a487..916ab84af74 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -66,8 +66,15 @@ main = do -- read command/path from commad line CLI{cliCommand, cliPath} <- readCLIShowHelp env - -- build the 'AppConfig' from the config file path - conf <- either panic identity <$> readConfig mempty env cliPath + -- build the 'AppConfig' from the config file path and env vars + pathEnvConf <- either panic identity <$> readAppConfig mempty env cliPath Nothing Nothing + + -- read external files + dbUriFile <- readDbUriFile $ configDbUri pathEnvConf + secretFile <- readSecretFile $ configJwtSecret pathEnvConf + + -- add the external files to AppConfig + conf <- either panic identity <$> readAppConfig mempty env cliPath dbUriFile secretFile -- These are config values that can't be reloaded at runtime. Reloading some of them would imply restarting the web server. let @@ -104,10 +111,10 @@ main = do -- Config that can change at runtime refConf <- newIORef conf - let configRereader startingUp = reReadConfig startingUp pool gucConfigEnabled env cliPath refConf + let dbConfigReader startingUp = readDbConfig startingUp pool gucConfigEnabled env cliPath dbUriFile secretFile refConf - -- re-read and override the config if db-load-guc-config is true - when gucConfigEnabled $ configRereader True + -- Override the config with config options from the db, only if db-load-guc-config is true + when gucConfigEnabled $ dbConfigReader True case cliCommand of CmdDumpConfig -> @@ -126,7 +133,7 @@ main = do -- This is passed to the connectionWorker method so it can kill the main thread if the PostgreSQL's version is not supported. mainTid <- myThreadId - let connWorker = connectionWorker mainTid pool refConf refDbStructure refIsWorkerOn (dbChannelEnabled, mvarConnectionStatus) $ configRereader False + let connWorker = connectionWorker mainTid pool refConf refDbStructure refIsWorkerOn (dbChannelEnabled, mvarConnectionStatus) $ dbConfigReader False -- Sets the initial refDbStructure connWorker @@ -149,13 +156,13 @@ main = do -- Re-read the config on SIGUSR2 void $ installHandler sigUSR2 ( - Catch $ configRereader False + Catch $ dbConfigReader False ) Nothing #endif -- reload schema cache + config on NOTIFY when dbChannelEnabled $ - listener dbUri dbChannel pool refConf refDbStructure mvarConnectionStatus connWorker $ configRereader False + listener dbUri dbChannel pool refConf refDbStructure mvarConnectionStatus connWorker $ dbConfigReader False -- ask for the OS time at most once per second getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime} @@ -274,15 +281,6 @@ connectionStatus pool = putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..." return itShould -loadDbSettings :: P.Pool -> IO [(Text, Text)] -loadDbSettings pool = do - result <- P.use pool $ HT.transaction HT.ReadCommitted HT.Read $ HT.statement mempty dbSettingsStatement - case result of - Left e -> do - hPutStrLn stderr ("An error ocurred when trying to query database settings for the config parameters:\n" <> show e :: Text) - pure [] - Right x -> pure x - -- | Load the DbStructure by using a connection from the pool. loadSchemaCache :: P.Pool -> PgVersion -> IORef AppConfig -> IORef (Maybe DbStructure) -> IO SCacheStatus loadSchemaCache pool actualPgVersion refConf refDbStructure = do @@ -342,20 +340,29 @@ listener dbUri dbChannel pool refConf refDbStructure mvarConnectionStatus connWo errorMessage = "Could not listen for notifications on the " <> dbChannel <> " channel" :: Text retryMessage = "Retrying listening for notifications on the " <> dbChannel <> " channel.." :: Text --- | Re-reads the config at runtime. -reReadConfig :: Bool -> P.Pool -> Bool -> Environment -> Maybe FilePath -> IORef AppConfig -> IO () -reReadConfig startingUp pool gucConfigEnabled env path refConf = do - dbSettings <- if gucConfigEnabled then loadDbSettings pool else pure [] - readConfig dbSettings env path >>= \case +-- | Reads the config options from the db +readDbConfig :: Bool -> P.Pool -> Bool -> Environment -> Maybe FilePath -> Maybe Text -> Maybe BS.ByteString -> IORef AppConfig -> IO () +readDbConfig startingUp pool gucConfigEnabled env path dbUriFile secretFile refConf = do + dbSettings <- if gucConfigEnabled then loadDbSettings else pure [] + readAppConfig dbSettings env path dbUriFile secretFile >>= \case Left err -> if startingUp then panic err -- die on invalid config if the program is starting up - else hPutStrLn stderr $ "Failed config reload. " <> err + else hPutStrLn stderr $ "Failed config load. " <> err Right conf -> do atomicWriteIORef refConf conf if startingUp then pass - else putStrLn ("Config reloaded" :: Text) + else putStrLn ("Config loaded" :: Text) + where + loadDbSettings :: IO [(Text, Text)] + loadDbSettings = do + result <- P.use pool $ HT.transaction HT.ReadCommitted HT.Read $ HT.statement mempty dbSettingsStatement + case result of + Left e -> do + hPutStrLn stderr ("An error ocurred when trying to query database settings for the config parameters:\n" <> show e :: Text) + pure [] + Right x -> pure x -- | Dump DbStructure schema to JSON dumpSchema :: P.Pool -> AppConfig -> IO LBS.ByteString diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 2f47bf18933..b581d3e5ef0 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -31,7 +31,9 @@ module PostgREST.Config , Environment , readCLIShowHelp , readEnvironment - , readConfig + , readAppConfig + , readDbUriFile + , readSecretFile , parseSecret ) where @@ -331,9 +333,9 @@ instance JustIfMaybe a a where instance JustIfMaybe a (Maybe a) where justIfMaybe a = Just a --- | Parse the config file -readAppConfig :: [(Text, Text)] -> Environment -> Maybe FilePath -> IO (Either Text AppConfig) -readAppConfig dbSettings env optPath = do +-- | Reads and parses the config and overrides its parameters from env vars, files or db settings. +readAppConfig :: [(Text, Text)] -> Environment -> Maybe FilePath -> Maybe Text -> Maybe B.ByteString -> IO (Either Text AppConfig) +readAppConfig dbSettings env optPath dbUriFile secretFile = do -- Now read the actual config file conf <- case optPath of -- Both C.ParseError and IOError are shown here @@ -345,6 +347,10 @@ readAppConfig dbSettings env optPath = do where parseConfig = + let pB64 = fromMaybe False <$> optWithAlias (optBool "jwt-secret-is-base64") + (optBool "secret-is-base64") + pSec = parseJwtSecret "jwt-secret" =<< pB64 + in AppConfig <$> parseAppSettings "app.settings" <*> reqString "db-anon-role" @@ -366,13 +372,12 @@ readAppConfig dbSettings env optPath = do <*> (fromMaybe True <$> optBool "db-load-guc-config") <*> parseTxEnd "db-tx-end" snd <*> parseTxEnd "db-tx-end" fst - <*> reqString "db-uri" - <*> pure Nothing + <*> parseDbUri "db-uri" + <*> (fmap parseSecret <$> pSec) <*> parseJwtAudience "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")) + <*> pSec + <*> pB64 <*> parseLogLevel "log-level" <*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri" <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types") @@ -381,6 +386,25 @@ readAppConfig dbSettings env optPath = do <*> (fmap unpack <$> optString "server-unix-socket") <*> parseSocketFileMode "server-unix-socket-mode" + parseDbUri :: C.Key -> C.Parser C.Config Text + parseDbUri k = flip fromMaybe dbUriFile <$> reqString k + + parseJwtSecret :: C.Key -> Bool -> C.Parser C.Config (Maybe B.ByteString) + parseJwtSecret k isB64 = optString k >>= \case + Nothing -> pure Nothing + Just sec -> + let secStr = encodeUtf8 sec + secFile = fromMaybe secStr secretFile + -- replace because the JWT is actually base64url encoded which must be turned into just base64 before decoding. + replaceUrlChars = replace "_" "/" . replace "-" "+" . replace "." "=" + willBeFile = isPrefixOf "@" (toS secStr) && isNothing secretFile + in + if isB64 && not willBeFile -- don't decode in bas64 if the secret will be a file or it will err. The secFile will be filled with the file contents in a later stage. + then case B64.decode $ encodeUtf8 $ strip $ replaceUrlChars $ decodeUtf8 secFile of + Left errMsg -> fail errMsg + Right bs -> pure $ Just bs + else pure $ Just secFile + parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)] parseAppSettings key = addFromEnv . fmap (fmap coerceText) <$> C.subassocs key C.value where @@ -515,90 +539,6 @@ readAppConfig dbSettings env optPath = do splitOnCommas (C.String s) = strip <$> splitOn "," s splitOnCommas _ = [] --- | Reads the config and overrides its parameters from files, env vars or db settings. -readConfig :: [(Text, Text)] -> Environment -> Maybe FilePath -> IO (Either Text AppConfig) -readConfig dbSettings env path = - readAppConfig dbSettings env path >>= \case - Left err -> pure $ Left err - Right appConf -> do - conf <- loadDbUriFile =<< loadSecretFile appConf - pure $ Right $ conf { configJWKS = parseSecret <$> configJwtSecret conf} - -type Environment = M.Map [Char] Text - -readEnvironment :: IO Environment -readEnvironment = getEnvironment <&> pgrst - where - pgrst env = M.filterWithKey (\k _ -> "PGRST_" `isPrefixOf` k) $ M.map pack $ M.fromList env - -{-| - The purpose of this function is to load the JWT secret from a file if - configJwtSecret is actually a filepath and replaces some characters if the JWT - is base64 encoded. - - The reason some characters need to be replaced is because JWT is actually - base64url encoded which must be turned into just base64 before decoding. - - To check if the JWT secret is provided is in fact a file path, it must be - decoded as 'Text' to be processed. - - decodeUtf8: Decode a ByteString containing UTF-8 encoded text that is known to - be valid. --} -loadSecretFile :: AppConfig -> IO AppConfig -loadSecretFile conf = extractAndTransform mSecret - where - mSecret = decodeUtf8 <$> configJwtSecret conf - isB64 = configJwtSecretIsBase64 conf - -- - -- The Text (variable name secret) here is mSecret from above which is the JWT - -- decoded as Utf8 - -- - -- stripPrefix: Return the suffix of the second string if its prefix matches - -- the entire first string. - -- - -- The configJwtSecret is a filepath instead of the JWT secret itself if the - -- secret has @ as its prefix. - extractAndTransform :: Maybe Text -> IO AppConfig - extractAndTransform Nothing = return conf - extractAndTransform (Just secret) = - fmap setSecret $ - transformString isB64 =<< - case stripPrefix "@" secret of - Nothing -> return . encodeUtf8 $ secret - Just filename -> chomp <$> BS.readFile (toS filename) - where - chomp bs = fromMaybe bs (BS.stripSuffix "\n" bs) - -- - -- Turns the Base64url encoded JWT into Base64 - transformString :: Bool -> ByteString -> IO ByteString - transformString False t = return t - transformString True t = - case B64.decode $ encodeUtf8 $ strip $ replaceUrlChars $ decodeUtf8 t of - Left errMsg -> panic $ pack errMsg - Right bs -> return bs - setSecret bs = conf {configJwtSecret = Just bs} - -- - -- replace: Replace every occurrence of one substring with another - replaceUrlChars = - replace "_" "/" . replace "-" "+" . replace "." "=" - -{- - Load database uri from a separate file if `db-uri` is a filepath. --} -loadDbUriFile :: AppConfig -> IO AppConfig -loadDbUriFile conf = extractDbUri mDbUri - where - mDbUri = configDbUri conf - extractDbUri :: Text -> IO AppConfig - extractDbUri dbUri = - fmap setDbUri $ - case stripPrefix "@" dbUri of - Nothing -> return dbUri - Just filename -> strip <$> readFile (toS filename) - setDbUri dbUri = conf {configDbUri = dbUri} - - {-| Parse `jwt-secret` configuration option and turn into a JWKSet. @@ -615,3 +555,26 @@ parseSecret bytes = maybeJWK = JSON.decode (toS bytes) :: Maybe JWK secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial] keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes + +type Environment = M.Map [Char] Text + +readEnvironment :: IO Environment +readEnvironment = getEnvironment <&> pgrst + where + pgrst env = M.filterWithKey (\k _ -> "PGRST_" `isPrefixOf` k) $ M.map pack $ M.fromList env + +-- | 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 :: Maybe B.ByteString -> IO (Maybe B.ByteString) +readSecretFile mSecret = + case (stripPrefix "@" . decodeUtf8) =<< mSecret of + Nothing -> return Nothing + Just filename -> Just . chomp <$> BS.readFile (toS filename) + where + chomp bs = fromMaybe bs (BS.stripSuffix "\n" bs) + +-- | Read database uri from a separate file if `db-uri` is a filepath. +readDbUriFile :: Text -> IO (Maybe Text) +readDbUriFile dbUri = case stripPrefix "@" dbUri of + Nothing -> return Nothing + Just filename -> Just . strip <$> readFile (toS filename)