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.
This commit is contained in:
Michał Kłeczek
committed by
Taimoor Zaeem
Taimoor Zaeem
parent
23b0c8d82a
commit
80ea1f4a1b
+123
-1
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-|
|
||||
Module : PostgREST.Logger
|
||||
@@ -35,7 +36,14 @@ import PostgREST.Config (LogLevel (..))
|
||||
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.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
|
||||
@@ -146,3 +154,117 @@ 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 $ 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..."
|
||||
DBListenBugCallQueryFix ->
|
||||
"This is likely a PostgreSQL bug in the notification queue, executing the following to try 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 usageErr ->
|
||||
jsonMessage usageErr
|
||||
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"
|
||||
PoolFlushed ->
|
||||
"Database connection pool flushed"
|
||||
JwtCacheLookup _ ->
|
||||
"Looked up a JWT in JWT cache"
|
||||
JwtCacheEviction ->
|
||||
"Evicted entry from JWT cache"
|
||||
TerminationUnixSignalObs signal ->
|
||||
"Received termination unix signal " <> signal
|
||||
WarpServerObs txt ->
|
||||
"Warp server: " <> txt
|
||||
where
|
||||
showMillis :: Double -> Text
|
||||
showMillis x = toS $ showFFloat (Just 1) x ""
|
||||
|
||||
jsonMessage err = T.decodeUtf8 . LBS.toStrict . Error.errorPayload $ 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"
|
||||
|
||||
@@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-|
|
||||
Module : PostgREST.Observation
|
||||
Description : This module holds an Observation type which is the core of Observability for PostgREST.
|
||||
@@ -10,22 +9,14 @@ Description : This module holds an Observation type which is the core of Observa
|
||||
module PostgREST.Observation
|
||||
( Observation(..)
|
||||
, ObsFatalError(..)
|
||||
, observationMessage
|
||||
, ObservationHandler
|
||||
, showOnSingleLine
|
||||
) 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.PgVersion
|
||||
import qualified PostgREST.Error as Error
|
||||
import PostgREST.Query (MainQuery)
|
||||
|
||||
import Protolude hiding (toList)
|
||||
@@ -73,117 +64,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 $ 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..."
|
||||
DBListenBugCallQueryFix ->
|
||||
"This is likely a PostgreSQL bug in the notification queue, executing the following to try 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 usageErr ->
|
||||
jsonMessage usageErr
|
||||
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"
|
||||
PoolFlushed ->
|
||||
"Database connection pool flushed"
|
||||
JwtCacheLookup _ ->
|
||||
"Looked up a JWT in JWT cache"
|
||||
JwtCacheEviction ->
|
||||
"Evicted entry from JWT cache"
|
||||
TerminationUnixSignalObs signal ->
|
||||
"Received termination unix signal " <> signal
|
||||
WarpServerObs txt ->
|
||||
"Warp server: " <> txt
|
||||
where
|
||||
showMillis :: Double -> Text
|
||||
showMillis x = toS $ showFFloat (Just 1) x ""
|
||||
|
||||
jsonMessage err = T.decodeUtf8 . LBS.toStrict . Error.errorPayload $ 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"
|
||||
|
||||
Reference in New Issue
Block a user