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