From 58a973e664a596b9af471b1895a68661f4f9a0ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20K=C5=82eczek?= Date: Fri, 27 Feb 2026 08:17:33 +0100 Subject: [PATCH] refactor: make Observation Logger and Listener modules more cohesive Observation module exports observationMessage and isDbListenerBug functions. The first one is used only in Logger module and the second one - only in Listener. This change moves observationMessage function to Logger module and isDbListenerBug function to Listener module, making all three modules more cohesive and lessening dependencies. It also gives the compiler more opportunities for intra-module inlining and optimization. --- src/PostgREST/Listener.hs | 6 +- src/PostgREST/Logger.hs | 122 +++++++++++++++++++++++++++++++++- src/PostgREST/Observation.hs | 123 ----------------------------------- 3 files changed, 124 insertions(+), 127 deletions(-) diff --git a/src/PostgREST/Listener.hs b/src/PostgREST/Listener.hs index e801e1d69..1f49769db 100644 --- a/src/PostgREST/Listener.hs +++ b/src/PostgREST/Listener.hs @@ -10,8 +10,7 @@ import qualified Hasql.Connection as SQL import qualified Hasql.Notifications as SQL import PostgREST.AppState (AppState, getConfig) import PostgREST.Config (AppConfig (..)) -import PostgREST.Observation (Observation (..), - isDbListenerBug) +import PostgREST.Observation (Observation (..)) import PostgREST.Version (prettyVersion) import qualified PostgREST.AppState as AppState @@ -20,6 +19,7 @@ import qualified PostgREST.Config as Config import Control.Arrow ((&&&)) import Data.Bitraversable (bisequence) import Data.Either.Combinators (whenRight) +import qualified Data.Text as T import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Session as SQL import PostgREST.Config.Database (queryPgVersion) @@ -106,3 +106,5 @@ retryingListen appState = do AppState.schemaCacheLoader appState releaseConnection = void . forkIO . handle (observer . DBListenerConnectionCleanupFail) . SQL.release + + isDbListenerBug e = "could not access status of transaction" `T.isInfixOf` show e diff --git a/src/PostgREST/Logger.hs b/src/PostgREST/Logger.hs index e088a55c3..baef0220a 100644 --- a/src/PostgREST/Logger.hs +++ b/src/PostgREST/Logger.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecursiveDo #-} {-| @@ -32,11 +33,19 @@ import qualified Network.Wai.Middleware.RequestLogger as Wai import Network.HTTP.Types.Status (Status, status400, status500) import System.IO.Unsafe (unsafePerformIO) -import PostgREST.Config (LogLevel (..)) +import PostgREST.Config (LogLevel (..), Verbosity (..)) import PostgREST.Observation import PostgREST.Query (MainQuery (..)) -import Protolude +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Hasql.Connection as SQL +import qualified Hasql.Pool as SQL +import qualified Hasql.Pool.Observation as SQL +import Numeric (showFFloat) +import PostgREST.Config.PgVersion (pgvName) +import qualified PostgREST.Error as Error +import Protolude data LoggerState = LoggerState { stateGetZTime :: IO ZonedTime -- ^ Time with time zone used for logs @@ -132,3 +141,112 @@ renderSnippet snippet = prepared = False -- unused in sql + +observationMessage :: Observation -> Text +observationMessage = \case + AdminStartObs address -> + "Admin server listening on " <> address + AppStartObs ver -> + "Starting PostgREST " <> T.decodeUtf8 ver <> "..." + AppServerAddressObs address -> + "API server listening on " <> address + DBConnectedObs ver -> + "Successfully connected to " <> ver + ExitUnsupportedPgVersion pgVer minPgVer -> + "Cannot run in this PostgreSQL version (" <> pgvName pgVer <> "), PostgREST needs at least " <> pgvName minPgVer + ExitDBNoRecoveryObs -> + "Automatic recovery disabled, exiting." + ExitDBFatalError ServerAuthError usageErr -> + "Failed to establish a connection. " <> jsonMessage usageErr + ExitDBFatalError ServerPgrstBug usageErr -> + "This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues. " <> jsonMessage usageErr + ExitDBFatalError ServerError42P05 usageErr -> + "If you are using connection poolers in transaction mode, try setting db-prepared-statements to false. " <> jsonMessage usageErr + ExitDBFatalError ServerError08P01 usageErr -> + "Connection poolers in statement mode are not supported." <> jsonMessage usageErr + SchemaCacheEmptyObs -> + T.decodeUtf8 . LBS.toStrict . Error.errorPayload Verbose $ Error.NoSchemaCacheError + SchemaCacheErrorObs dbSchemas extraPaths usageErr -> + "Failed to load the schema cache using " + <> "db-schemas=" <> T.intercalate "," (toList dbSchemas) + <> " and " + <> "db-extra-search-path=" <> T.intercalate "," extraPaths + <> ". " <> jsonMessage usageErr + SchemaCacheQueriedObs resultTime -> + "Schema cache queried in " <> showMillis resultTime <> " milliseconds" + SchemaCacheSummaryObs summary -> + "Schema cache loaded " <> summary + SchemaCacheLoadedObs resultTime -> + "Schema cache loaded in " <> showMillis resultTime <> " milliseconds" + ConnectionRetryObs delay -> + "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..." + QueryPgVersionError usageErr -> + "Failed to query the PostgreSQL version. " <> jsonMessage usageErr + DBListenStart host port fullName channel -> do + "Listener connected to " <> fullName <> " on " <> show (fold $ host <> fmap (":" <>) port) <> " and listening for database notifications on the " <> show channel <> " channel" + DBListenFail channel listenErr -> + "Failed listening for database notifications on the " <> show channel <> " channel. " <> + either showListenerConnError showListenerException listenErr + DBListenRetry delay -> + "Retrying listening for database notifications in " <> (show delay::Text) <> " seconds..." + DBListenBugHint -> + "HINT: This is likely a bug in the notification queue, try executing the following to solve it: select pg_notification_queue_usage();" + DBListenerGotSCacheMsg channel -> + "Received a schema cache reload message on the " <> show channel <> " channel" + DBListenerGotConfigMsg channel -> + "Received a config reload message on the " <> show channel <> " channel" + DBListenerConnectionCleanupFail ex -> + "Failed during listener connection cleanup: " <> showOnSingleLine '\t' (show ex) + QueryObs{} -> + mempty -- TODO pending refactor: The logic for printing the query cannot be done here. Join the observationMessage function into observationLogger to avoid this mempty. + ConfigReadErrorObs usageErr -> + "Failed to query database settings for the config parameters." <> jsonMessage usageErr + QueryRoleSettingsErrorObs usageErr -> + "Failed to query the role settings. " <> jsonMessage usageErr + QueryErrorCodeHighObs usageErr -> + jsonMessage usageErr + ConfigInvalidObs err -> + "Failed reloading config: " <> err + ConfigSucceededObs -> + "Config reloaded" + PoolInit poolSize -> + "Connection Pool initialized with a maximum size of " <> show poolSize <> " connections" + PoolAcqTimeoutObs -> jsonMessage SQL.AcquisitionTimeoutUsageError + HasqlPoolObs (SQL.ConnectionObservation uuid status) -> + "Connection " <> show uuid <> ( + case status of + SQL.ConnectingConnectionStatus -> " is being established" + SQL.ReadyForUseConnectionStatus -> " is available" + SQL.InUseConnectionStatus -> " is used" + SQL.TerminatedConnectionStatus reason -> " is terminated due to " <> case reason of + SQL.AgingConnectionTerminationReason -> "max lifetime" + SQL.IdlenessConnectionTerminationReason -> "max idletime" + SQL.ReleaseConnectionTerminationReason -> "release" + SQL.NetworkErrorConnectionTerminationReason _ -> "network error" -- usage error is already logged, no need to repeat the same message. + ) + PoolRequest -> + "Trying to borrow a connection from pool" + PoolRequestFullfilled -> + "Borrowed a connection from the pool" + JwtCacheLookup _ -> + "Looked up a JWT in JWT cache" + JwtCacheEviction -> + "Evicted entry from JWT cache" + WarpErrorObs txt -> + "Warp server error: " <> txt + where + showMillis :: Double -> Text + showMillis x = toS $ showFFloat (Just 1) x "" + + jsonMessage err = T.decodeUtf8 . LBS.toStrict . Error.errorPayload Verbose $ Error.PgError False err + + + showListenerConnError :: SQL.ConnectionError -> Text + showListenerConnError = maybe "Connection error" (showOnSingleLine '\t' . T.decodeUtf8) + + showListenerException :: SomeException -> Text + showListenerException = showOnSingleLine '\t' . show + + +showOnSingleLine :: Char -> Text -> Text +showOnSingleLine split txt = T.intercalate " " $ T.filter (/= split) <$> T.lines txt -- the errors from hasql-notifications come intercalated with "\t\n" diff --git a/src/PostgREST/Observation.hs b/src/PostgREST/Observation.hs index ad990308c..59149e098 100644 --- a/src/PostgREST/Observation.hs +++ b/src/PostgREST/Observation.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-| Module : PostgREST.Observation Description : This module holds an Observation type which is the core of Observability for PostgREST. @@ -9,24 +8,14 @@ Description : This module holds an Observation type which is the core of Observa module PostgREST.Observation ( Observation(..) , ObsFatalError(..) - , observationMessage , ObservationHandler - , showOnSingleLine - , isDbListenerBug ) where -import qualified Data.ByteString.Lazy as LBS -import Data.List.NonEmpty (toList) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T import qualified Hasql.Connection as SQL import qualified Hasql.Pool as SQL import qualified Hasql.Pool.Observation as SQL import Network.HTTP.Types.Status (Status) -import Numeric (showFFloat) -import PostgREST.Config (Verbosity (..)) import PostgREST.Config.PgVersion -import qualified PostgREST.Error as Error import PostgREST.Query (MainQuery) import Protolude hiding (toList) @@ -71,115 +60,3 @@ data Observation data ObsFatalError = ServerAuthError | ServerPgrstBug | ServerError42P05 | ServerError08P01 type ObservationHandler = Observation -> IO () - -observationMessage :: Observation -> Text -observationMessage = \case - AdminStartObs address -> - "Admin server listening on " <> address - AppStartObs ver -> - "Starting PostgREST " <> T.decodeUtf8 ver <> "..." - AppServerAddressObs address -> - "API server listening on " <> address - DBConnectedObs ver -> - "Successfully connected to " <> ver - ExitUnsupportedPgVersion pgVer minPgVer -> - "Cannot run in this PostgreSQL version (" <> pgvName pgVer <> "), PostgREST needs at least " <> pgvName minPgVer - ExitDBNoRecoveryObs -> - "Automatic recovery disabled, exiting." - ExitDBFatalError ServerAuthError usageErr -> - "Failed to establish a connection. " <> jsonMessage usageErr - ExitDBFatalError ServerPgrstBug usageErr -> - "This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues. " <> jsonMessage usageErr - ExitDBFatalError ServerError42P05 usageErr -> - "If you are using connection poolers in transaction mode, try setting db-prepared-statements to false. " <> jsonMessage usageErr - ExitDBFatalError ServerError08P01 usageErr -> - "Connection poolers in statement mode are not supported." <> jsonMessage usageErr - SchemaCacheEmptyObs -> - T.decodeUtf8 . LBS.toStrict . Error.errorPayload Verbose $ Error.NoSchemaCacheError - SchemaCacheErrorObs dbSchemas extraPaths usageErr -> - "Failed to load the schema cache using " - <> "db-schemas=" <> T.intercalate "," (toList dbSchemas) - <> " and " - <> "db-extra-search-path=" <> T.intercalate "," extraPaths - <> ". " <> jsonMessage usageErr - SchemaCacheQueriedObs resultTime -> - "Schema cache queried in " <> showMillis resultTime <> " milliseconds" - SchemaCacheSummaryObs summary -> - "Schema cache loaded " <> summary - SchemaCacheLoadedObs resultTime -> - "Schema cache loaded in " <> showMillis resultTime <> " milliseconds" - ConnectionRetryObs delay -> - "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..." - QueryPgVersionError usageErr -> - "Failed to query the PostgreSQL version. " <> jsonMessage usageErr - DBListenStart host port fullName channel -> do - "Listener connected to " <> fullName <> " on " <> show (fold $ host <> fmap (":" <>) port) <> " and listening for database notifications on the " <> show channel <> " channel" - DBListenFail channel listenErr -> - "Failed listening for database notifications on the " <> show channel <> " channel. " <> - either showListenerConnError showListenerException listenErr - DBListenRetry delay -> - "Retrying listening for database notifications in " <> (show delay::Text) <> " seconds..." - DBListenBugHint -> - "HINT: This is likely a bug in the notification queue, try executing the following to solve it: select pg_notification_queue_usage();" - DBListenerGotSCacheMsg channel -> - "Received a schema cache reload message on the " <> show channel <> " channel" - DBListenerGotConfigMsg channel -> - "Received a config reload message on the " <> show channel <> " channel" - DBListenerConnectionCleanupFail ex -> - "Failed during listener connection cleanup: " <> showOnSingleLine '\t' (show ex) - QueryObs{} -> - mempty -- TODO pending refactor: The logic for printing the query cannot be done here. Join the observationMessage function into observationLogger to avoid this mempty. - ConfigReadErrorObs usageErr -> - "Failed to query database settings for the config parameters." <> jsonMessage usageErr - QueryRoleSettingsErrorObs usageErr -> - "Failed to query the role settings. " <> jsonMessage usageErr - QueryErrorCodeHighObs usageErr -> - jsonMessage usageErr - ConfigInvalidObs err -> - "Failed reloading config: " <> err - ConfigSucceededObs -> - "Config reloaded" - PoolInit poolSize -> - "Connection Pool initialized with a maximum size of " <> show poolSize <> " connections" - PoolAcqTimeoutObs -> jsonMessage SQL.AcquisitionTimeoutUsageError - HasqlPoolObs (SQL.ConnectionObservation uuid status) -> - "Connection " <> show uuid <> ( - case status of - SQL.ConnectingConnectionStatus -> " is being established" - SQL.ReadyForUseConnectionStatus -> " is available" - SQL.InUseConnectionStatus -> " is used" - SQL.TerminatedConnectionStatus reason -> " is terminated due to " <> case reason of - SQL.AgingConnectionTerminationReason -> "max lifetime" - SQL.IdlenessConnectionTerminationReason -> "max idletime" - SQL.ReleaseConnectionTerminationReason -> "release" - SQL.NetworkErrorConnectionTerminationReason _ -> "network error" -- usage error is already logged, no need to repeat the same message. - ) - PoolRequest -> - "Trying to borrow a connection from pool" - PoolRequestFullfilled -> - "Borrowed a connection from the pool" - JwtCacheLookup _ -> - "Looked up a JWT in JWT cache" - JwtCacheEviction -> - "Evicted entry from JWT cache" - WarpErrorObs txt -> - "Warp server error: " <> txt - where - showMillis :: Double -> Text - showMillis x = toS $ showFFloat (Just 1) x "" - - jsonMessage err = T.decodeUtf8 . LBS.toStrict . Error.errorPayload Verbose $ Error.PgError False err - - - showListenerConnError :: SQL.ConnectionError -> Text - showListenerConnError = maybe "Connection error" (showOnSingleLine '\t' . T.decodeUtf8) - - showListenerException :: SomeException -> Text - showListenerException = showOnSingleLine '\t' . show - - -showOnSingleLine :: Char -> Text -> Text -showOnSingleLine split txt = T.intercalate " " $ T.filter (/= split) <$> T.lines txt -- the errors from hasql-notifications come intercalated with "\t\n" - -isDbListenerBug :: SomeException -> Bool -isDbListenerBug e = "could not access status of transaction" `T.isInfixOf` show e