From 97b1c391aa436eb6f3d81d0badb3ee96aaa23a4d Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Tue, 20 Feb 2024 18:19:40 -0500 Subject: [PATCH] refactor: make observation messages pure removes the observation messages from the Logger --- src/PostgREST/App.hs | 2 +- src/PostgREST/AppState.hs | 21 +++++---- src/PostgREST/Logger.hs | 89 ++++-------------------------------- src/PostgREST/Observation.hs | 84 ++++++++++++++++++++++++++++++---- 4 files changed, 96 insertions(+), 100 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index edfd007b22..d58a284cc9 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -69,7 +69,7 @@ type Handler = ExceptT Error run :: AppState -> (Observation -> IO ()) -> IO () run appState observer = do - observer $ AppStartObs prettyVersion + observer $ AppServerStartObs prettyVersion conf@AppConfig{..} <- AppState.getConfig appState AppState.connectionWorker appState -- Loads the initial SchemaCache diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 4aac3014ad..1487bc608e 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -300,16 +300,17 @@ loadSchemaCache appState observer = do Left e -> do case checkIsFatal e of Just hint -> do - observer $ AppSCacheFatalErrorObs e hint + observer $ SchemaCacheFatalErrorObs e hint return SCFatalFail Nothing -> do putSchemaCache appState Nothing - observer $ AppSCacheNormalErrorObs e + observer $ SchemaCacheNormalErrorObs e return SCOnRetry Right sCache -> do putSchemaCache appState $ Just sCache - observer $ AppSCacheLoadSuccessObs sCache resultTime + observer $ SchemaCacheQueriedObs resultTime + observer $ SchemaCacheLoadedObs sCache return SCLoaded -- | Current database connection status data ConnectionStatus @@ -335,22 +336,22 @@ internalConnectionWorker appState observer = work where work = do config@AppConfig{..} <- getConfig appState - observer AppDBConnectAttemptObs + observer DBConnectAttemptObs connected <- establishConnection appState config observer case connected of FatalConnectionError reason -> -- Fatal error when connecting - observer (AppExitFatalObs reason) >> killThread (getMainThreadId appState) + observer (ExitFatalObs reason) >> killThread (getMainThreadId appState) NotConnected -> -- Unreachable because establishConnection will keep trying to connect, unless disable-recovery is turned on unless configDbPoolAutomaticRecovery - $ observer AppExitDBNoRecoveryObs >> killThread (getMainThreadId appState) + $ observer ExitDBNoRecoveryObs >> killThread (getMainThreadId appState) Connected actualPgVersion -> do -- Procede with initialization putPgVersion appState actualPgVersion when configDbChannelEnabled $ signalListener appState - observer (AppDBConnectedObs $ pgvFullName actualPgVersion) + observer (DBConnectedObs $ pgvFullName actualPgVersion) -- this could be fail because the connection drops, but the loadSchemaCache will pick the error and retry again -- We cannot retry after it fails immediately, because db-pre-config could have user errors. We just log the error and continue. when configDbConfig $ reReadConfig False appState observer @@ -523,16 +524,16 @@ checkIsFatal(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError serverEr = case serverError of -- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal. SQL.ServerError "42601" _ _ _ _ - -> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues" + -> Just "This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues" -- Check for a "prepared statement already exists" error (Code 42P05: duplicate_prepared_statement). -- This would mean that a connection pooler in transaction mode is being used -- while prepared statements are enabled in the PostgREST configuration, -- both of which are incompatible with each other. SQL.ServerError "42P05" _ _ _ _ - -> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false." + -> Just "If you are using connection poolers in transaction mode, try setting db-prepared-statements to false." -- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation). -- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST. SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ _ - -> Just "Hint: Connection poolers in statement mode are not supported." + -> Just "Connection poolers in statement mode are not supported." _ -> Nothing checkIsFatal _ = Nothing diff --git a/src/PostgREST/Logger.hs b/src/PostgREST/Logger.hs index e8d1ed738e..f214dbca83 100644 --- a/src/PostgREST/Logger.hs +++ b/src/PostgREST/Logger.hs @@ -11,16 +11,11 @@ module PostgREST.Logger import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text.Encoding as T -import Data.Time (ZonedTime, defaultTimeLocale, - formatTime, getZonedTime) -import qualified Hasql.Pool as SQL +import Data.Time (ZonedTime, defaultTimeLocale, formatTime, + getZonedTime) import qualified Network.Wai as Wai import qualified Network.Wai.Middleware.RequestLogger as Wai -import Numeric (showFFloat) - import Network.HTTP.Types.Status (status400, status500) import System.IO.Unsafe (unsafePerformIO) @@ -28,14 +23,9 @@ import System.IO.Unsafe (unsafePerformIO) import PostgREST.Config (LogLevel (..)) import PostgREST.Observation -import qualified PostgREST.Auth as Auth -import qualified PostgREST.Error as Error - -import PostgREST.SchemaCache (showSummary) - +import qualified PostgREST.Auth as Auth import Protolude -import Protolude.Partial (fromJust) newtype LoggerState = LoggerState { stateGetZTime :: IO ZonedTime -- ^ Time with time zone used for logs @@ -46,14 +36,6 @@ init = do zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime } pure $ LoggerState zTime -logWithZTime :: LoggerState -> Text -> IO () -logWithZTime loggerState txt = do - zTime <- stateGetZTime loggerState - hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt - -logPgrstError :: LoggerState -> SQL.UsageError -> IO () -logPgrstError loggerState e = logWithZTime loggerState . T.decodeUtf8 . LBS.toStrict $ Error.errorPayload $ Error.PgError False e - middleware :: LogLevel -> Wai.Middleware middleware logLevel = case logLevel of LogInfo -> requestLogger (const True) @@ -69,62 +51,9 @@ middleware logLevel = case logLevel of } logObservation :: LoggerState -> Observation -> IO () -logObservation loggerState obs = - case obs of - AdminStartObs port -> - logWithZTime loggerState $ "Admin server listening on port " <> show (fromIntegral (fromJust port) :: Integer) - AppStartObs ver -> - logWithZTime loggerState $ "Starting PostgREST " <> T.decodeUtf8 ver <> "..." - AppServerPortObs port -> - logWithZTime loggerState $ "Listening on port " <> show port - AppServerUnixObs sock -> - logWithZTime loggerState $ "Listening on unix socket " <> show sock - AppDBConnectAttemptObs -> - logWithZTime loggerState "Attempting to connect to the database..." - AppExitFatalObs reason -> - logWithZTime loggerState $ "Fatal error encountered. " <> reason - AppExitDBNoRecoveryObs -> - logWithZTime loggerState "Automatic recovery disabled, exiting." - AppDBConnectedObs ver -> - logWithZTime loggerState $ "Successfully connected to " <> ver - AppSCacheFatalErrorObs usageErr hint -> do - logWithZTime loggerState "A fatal error ocurred when loading the schema cache" - logPgrstError loggerState usageErr - logWithZTime loggerState hint - AppSCacheNormalErrorObs usageErr -> do - logWithZTime loggerState "An error ocurred when loading the schema cache" - logPgrstError loggerState usageErr - AppSCacheLoadSuccessObs sCache resultTime -> do - logWithZTime loggerState $ "Schema cache queried in " <> showMillis resultTime <> " milliseconds" - logWithZTime loggerState $ "Schema cache loaded " <> showSummary sCache - ConnectionRetryObs delay -> do - logWithZTime loggerState $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..." - ConnectionPgVersionErrorObs usageErr -> - logPgrstError loggerState usageErr - DBListenerStart channel -> do - logWithZTime loggerState $ "Listening for notifications on the " <> channel <> " channel" - DBListenerFailNoRecoverObs -> - logWithZTime loggerState "Automatic recovery disabled, exiting." - DBListenerFailRecoverObs channel -> - logWithZTime loggerState $ "Retrying listening for notifications on the " <> channel <> " channel.." - ConfigReadErrorObs -> - logWithZTime loggerState "An error ocurred when trying to query database settings for the config parameters" - ConfigReadErrorFatalObs usageErr hint -> do - logPgrstError loggerState usageErr - logWithZTime loggerState hint - ConfigReadErrorNotFatalObs usageErr -> do - logPgrstError loggerState usageErr - QueryRoleSettingsErrorObs usageErr -> do - logWithZTime loggerState "An error ocurred when trying to query the role settings" - logPgrstError loggerState usageErr - QueryErrorCodeHighObs usageErr -> do - logPgrstError loggerState usageErr - ConfigInvalidObs err -> do - logWithZTime loggerState $ "Failed reloading config: " <> err - ConfigSucceededObs -> do - logWithZTime loggerState "Config reloaded" - PoolAcqTimeoutObs usageErr -> do - logPgrstError loggerState usageErr - where - showMillis :: Double -> Text - showMillis x = toS $ showFFloat (Just 1) (x * 1000) "" +logObservation loggerState obs = logWithZTime loggerState $ observationMessage obs + +logWithZTime :: LoggerState -> Text -> IO () +logWithZTime loggerState txt = do + zTime <- stateGetZTime loggerState + hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt diff --git a/src/PostgREST/Observation.hs b/src/PostgREST/Observation.hs index fabb3cb149..1c0a964be9 100644 --- a/src/PostgREST/Observation.hs +++ b/src/PostgREST/Observation.hs @@ -1,29 +1,37 @@ +{-# LANGUAGE LambdaCase #-} {-| Module : PostgREST.Observation Description : Module for observability types -} module PostgREST.Observation ( Observation(..) + , observationMessage ) where +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text.Encoding as T import qualified Hasql.Pool as SQL import qualified Network.Socket as NS -import PostgREST.SchemaCache (SchemaCache) +import Numeric (showFFloat) +import qualified PostgREST.Error as Error +import PostgREST.SchemaCache (SchemaCache, showSummary) import Protolude +import Protolude.Partial (fromJust) data Observation = AdminStartObs (Maybe Int) - | AppStartObs ByteString + | AppServerStartObs ByteString | AppServerPortObs NS.PortNumber | AppServerUnixObs FilePath - | AppDBConnectAttemptObs - | AppExitFatalObs Text - | AppExitDBNoRecoveryObs - | AppDBConnectedObs Text - | AppSCacheFatalErrorObs SQL.UsageError Text - | AppSCacheNormalErrorObs SQL.UsageError - | AppSCacheLoadSuccessObs SchemaCache Double + | DBConnectAttemptObs + | ExitFatalObs Text + | ExitDBNoRecoveryObs + | DBConnectedObs Text + | SchemaCacheFatalErrorObs SQL.UsageError Text + | SchemaCacheNormalErrorObs SQL.UsageError + | SchemaCacheQueriedObs Double + | SchemaCacheLoadedObs SchemaCache | ConnectionRetryObs Int | ConnectionPgVersionErrorObs SQL.UsageError | DBListenerStart Text @@ -37,3 +45,61 @@ data Observation | QueryRoleSettingsErrorObs SQL.UsageError | QueryErrorCodeHighObs SQL.UsageError | PoolAcqTimeoutObs SQL.UsageError + +observationMessage :: Observation -> Text +observationMessage = \case + AdminStartObs port -> + "Admin server listening on port " <> show (fromIntegral (fromJust port) :: Integer) + AppServerStartObs ver -> + "Starting PostgREST " <> T.decodeUtf8 ver <> "..." + AppServerPortObs port -> + "Listening on port " <> show port + AppServerUnixObs sock -> + "Listening on unix socket " <> show sock + DBConnectAttemptObs -> + "Attempting to connect to the database..." + ExitFatalObs reason -> + "Fatal error encountered. " <> reason + ExitDBNoRecoveryObs -> + "Automatic recovery disabled, exiting." + DBConnectedObs ver -> + "Successfully connected to " <> ver + SchemaCacheFatalErrorObs usageErr hint -> + "A fatal error ocurred when loading the schema cache. " <> hint <> ". " <> jsonMessage usageErr + SchemaCacheNormalErrorObs usageErr -> + "An error ocurred when loading the schema cache. " <> jsonMessage usageErr + SchemaCacheQueriedObs resultTime -> + "Schema cache queried in " <> showMillis resultTime <> " milliseconds" + SchemaCacheLoadedObs sCache -> + "Schema cache loaded " <> showSummary sCache + ConnectionRetryObs delay -> + "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..." + ConnectionPgVersionErrorObs usageErr -> + jsonMessage usageErr + DBListenerStart channel -> do + "Listening for notifications on the " <> channel <> " channel" + DBListenerFailNoRecoverObs -> + "Automatic recovery disabled, exiting." + DBListenerFailRecoverObs channel -> + "Retrying listening for notifications on the " <> channel <> " channel.." + ConfigReadErrorObs -> + "An error ocurred when trying to query database settings for the config parameters" + ConfigReadErrorFatalObs usageErr hint -> + hint <> ". " <> jsonMessage usageErr + ConfigReadErrorNotFatalObs usageErr -> + jsonMessage usageErr + QueryRoleSettingsErrorObs usageErr -> + "An error ocurred when trying to query the role settings. " <> jsonMessage usageErr + QueryErrorCodeHighObs usageErr -> + jsonMessage usageErr + ConfigInvalidObs err -> + "Failed reloading config: " <> err + ConfigSucceededObs -> + "Config reloaded" + PoolAcqTimeoutObs usageErr -> + jsonMessage usageErr + where + showMillis :: Double -> Text + showMillis x = toS $ showFFloat (Just 1) (x * 1000) "" + + jsonMessage err = T.decodeUtf8 . LBS.toStrict . Error.errorPayload $ Error.PgError False err