109 lines
3.9 KiB
Haskell
109 lines
3.9 KiB
Haskell
{-# 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 Numeric (showFFloat)
|
|
import qualified PostgREST.Error as Error
|
|
import PostgREST.SchemaCache (SchemaCache, showSummary)
|
|
|
|
import Protolude
|
|
import Protolude.Partial (fromJust)
|
|
|
|
data Observation
|
|
= AdminStartObs (Maybe Int)
|
|
| AppServerStartObs ByteString
|
|
| AppServerPortObs NS.PortNumber
|
|
| AppServerUnixObs FilePath
|
|
| DBConnectAttemptObs
|
|
| ExitFatalObs Text
|
|
| ExitDBNoRecoveryObs
|
|
| DBConnectedObs Text
|
|
| SchemaCacheFatalErrorObs SQL.UsageError Text
|
|
| SchemaCacheNormalErrorObs SQL.UsageError
|
|
| SchemaCacheQueriedObs Double
|
|
| SchemaCacheSummaryObs SchemaCache
|
|
| SchemaCacheLoadedObs Double
|
|
| ConnectionRetryObs Int
|
|
| ConnectionPgVersionErrorObs SQL.UsageError
|
|
| DBListenerStart Text
|
|
| DBListenerFailNoRecoverObs
|
|
| DBListenerFailRecoverObs Text
|
|
| ConfigReadErrorObs
|
|
| ConfigReadErrorFatalObs SQL.UsageError Text
|
|
| ConfigReadErrorNotFatalObs SQL.UsageError
|
|
| ConfigInvalidObs Text
|
|
| ConfigSucceededObs
|
|
| 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"
|
|
SchemaCacheSummaryObs sCache ->
|
|
"Schema cache loaded " <> showSummary sCache
|
|
SchemaCacheLoadedObs resultTime ->
|
|
"Schema cache loaded in " <> showMillis resultTime <> " milliseconds"
|
|
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
|