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
Steve Chavez
Steve Chavez
parent
a36963026e
commit
58a973e664
@@ -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
|
||||
|
||||
+120
-2
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user