Separate reading files from whole config re-read

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

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)