refactor: make observation messages pure (#3250)
removes the observation messages from the Logger
This commit is contained in:
Steve Chavez
@@ -69,7 +69,7 @@ type Handler = ExceptT Error
|
||||
|
||||
run :: AppState -> (Observation -> IO ()) -> IO ()
|
||||
run appState observer = do
|
||||
observer $ AppStartObs prettyVersion
|
||||
observer $ AppServerStartObs prettyVersion
|
||||
|
||||
conf@AppConfig{..} <- AppState.getConfig appState
|
||||
AppState.connectionWorker appState -- Loads the initial SchemaCache
|
||||
|
||||
+11
-10
@@ -300,16 +300,17 @@ loadSchemaCache appState observer = do
|
||||
Left e -> do
|
||||
case checkIsFatal e of
|
||||
Just hint -> do
|
||||
observer $ AppSCacheFatalErrorObs e hint
|
||||
observer $ SchemaCacheFatalErrorObs e hint
|
||||
return SCFatalFail
|
||||
Nothing -> do
|
||||
putSchemaCache appState Nothing
|
||||
observer $ AppSCacheNormalErrorObs e
|
||||
observer $ SchemaCacheNormalErrorObs e
|
||||
return SCOnRetry
|
||||
|
||||
Right sCache -> do
|
||||
putSchemaCache appState $ Just sCache
|
||||
observer $ AppSCacheLoadSuccessObs sCache resultTime
|
||||
observer $ SchemaCacheQueriedObs resultTime
|
||||
observer $ SchemaCacheLoadedObs sCache
|
||||
return SCLoaded
|
||||
|
||||
-- | Current database connection status data ConnectionStatus
|
||||
@@ -335,22 +336,22 @@ internalConnectionWorker appState observer = work
|
||||
where
|
||||
work = do
|
||||
config@AppConfig{..} <- getConfig appState
|
||||
observer AppDBConnectAttemptObs
|
||||
observer DBConnectAttemptObs
|
||||
connected <- establishConnection appState config observer
|
||||
case connected of
|
||||
FatalConnectionError reason ->
|
||||
-- Fatal error when connecting
|
||||
observer (AppExitFatalObs reason) >> killThread (getMainThreadId appState)
|
||||
observer (ExitFatalObs reason) >> killThread (getMainThreadId appState)
|
||||
NotConnected ->
|
||||
-- Unreachable because establishConnection will keep trying to connect, unless disable-recovery is turned on
|
||||
unless configDbPoolAutomaticRecovery
|
||||
$ observer AppExitDBNoRecoveryObs >> killThread (getMainThreadId appState)
|
||||
$ observer ExitDBNoRecoveryObs >> killThread (getMainThreadId appState)
|
||||
Connected actualPgVersion -> do
|
||||
-- Procede with initialization
|
||||
putPgVersion appState actualPgVersion
|
||||
when configDbChannelEnabled $
|
||||
signalListener appState
|
||||
observer (AppDBConnectedObs $ pgvFullName actualPgVersion)
|
||||
observer (DBConnectedObs $ pgvFullName actualPgVersion)
|
||||
-- this could be fail because the connection drops, but the loadSchemaCache will pick the error and retry again
|
||||
-- We cannot retry after it fails immediately, because db-pre-config could have user errors. We just log the error and continue.
|
||||
when configDbConfig $ reReadConfig False appState observer
|
||||
@@ -523,16 +524,16 @@ checkIsFatal(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError serverEr
|
||||
= case serverError of
|
||||
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
|
||||
SQL.ServerError "42601" _ _ _ _
|
||||
-> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
|
||||
-> Just "This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues"
|
||||
-- Check for a "prepared statement <name> already exists" error (Code 42P05: duplicate_prepared_statement).
|
||||
-- This would mean that a connection pooler in transaction mode is being used
|
||||
-- while prepared statements are enabled in the PostgREST configuration,
|
||||
-- both of which are incompatible with each other.
|
||||
SQL.ServerError "42P05" _ _ _ _
|
||||
-> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
|
||||
-> Just "If you are using connection poolers in transaction mode, try setting db-prepared-statements to false."
|
||||
-- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation).
|
||||
-- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST.
|
||||
SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ _
|
||||
-> Just "Hint: Connection poolers in statement mode are not supported."
|
||||
-> Just "Connection poolers in statement mode are not supported."
|
||||
_ -> Nothing
|
||||
checkIsFatal _ = Nothing
|
||||
|
||||
+9
-80
@@ -11,16 +11,11 @@ module PostgREST.Logger
|
||||
import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
|
||||
updateAction)
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Data.Time (ZonedTime, defaultTimeLocale,
|
||||
formatTime, getZonedTime)
|
||||
import qualified Hasql.Pool as SQL
|
||||
import Data.Time (ZonedTime, defaultTimeLocale, formatTime,
|
||||
getZonedTime)
|
||||
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Middleware.RequestLogger as Wai
|
||||
import Numeric (showFFloat)
|
||||
|
||||
|
||||
import Network.HTTP.Types.Status (status400, status500)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
@@ -28,14 +23,9 @@ import System.IO.Unsafe (unsafePerformIO)
|
||||
import PostgREST.Config (LogLevel (..))
|
||||
import PostgREST.Observation
|
||||
|
||||
import qualified PostgREST.Auth as Auth
|
||||
import qualified PostgREST.Error as Error
|
||||
|
||||
import PostgREST.SchemaCache (showSummary)
|
||||
|
||||
import qualified PostgREST.Auth as Auth
|
||||
|
||||
import Protolude
|
||||
import Protolude.Partial (fromJust)
|
||||
|
||||
newtype LoggerState = LoggerState
|
||||
{ stateGetZTime :: IO ZonedTime -- ^ Time with time zone used for logs
|
||||
@@ -46,14 +36,6 @@ init = do
|
||||
zTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
|
||||
pure $ LoggerState zTime
|
||||
|
||||
logWithZTime :: LoggerState -> Text -> IO ()
|
||||
logWithZTime loggerState txt = do
|
||||
zTime <- stateGetZTime loggerState
|
||||
hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt
|
||||
|
||||
logPgrstError :: LoggerState -> SQL.UsageError -> IO ()
|
||||
logPgrstError loggerState e = logWithZTime loggerState . T.decodeUtf8 . LBS.toStrict $ Error.errorPayload $ Error.PgError False e
|
||||
|
||||
middleware :: LogLevel -> Wai.Middleware
|
||||
middleware logLevel = case logLevel of
|
||||
LogInfo -> requestLogger (const True)
|
||||
@@ -69,62 +51,9 @@ middleware logLevel = case logLevel of
|
||||
}
|
||||
|
||||
logObservation :: LoggerState -> Observation -> IO ()
|
||||
logObservation loggerState obs =
|
||||
case obs of
|
||||
AdminStartObs port ->
|
||||
logWithZTime loggerState $ "Admin server listening on port " <> show (fromIntegral (fromJust port) :: Integer)
|
||||
AppStartObs ver ->
|
||||
logWithZTime loggerState $ "Starting PostgREST " <> T.decodeUtf8 ver <> "..."
|
||||
AppServerPortObs port ->
|
||||
logWithZTime loggerState $ "Listening on port " <> show port
|
||||
AppServerUnixObs sock ->
|
||||
logWithZTime loggerState $ "Listening on unix socket " <> show sock
|
||||
AppDBConnectAttemptObs ->
|
||||
logWithZTime loggerState "Attempting to connect to the database..."
|
||||
AppExitFatalObs reason ->
|
||||
logWithZTime loggerState $ "Fatal error encountered. " <> reason
|
||||
AppExitDBNoRecoveryObs ->
|
||||
logWithZTime loggerState "Automatic recovery disabled, exiting."
|
||||
AppDBConnectedObs ver ->
|
||||
logWithZTime loggerState $ "Successfully connected to " <> ver
|
||||
AppSCacheFatalErrorObs usageErr hint -> do
|
||||
logWithZTime loggerState "A fatal error ocurred when loading the schema cache"
|
||||
logPgrstError loggerState usageErr
|
||||
logWithZTime loggerState hint
|
||||
AppSCacheNormalErrorObs usageErr -> do
|
||||
logWithZTime loggerState "An error ocurred when loading the schema cache"
|
||||
logPgrstError loggerState usageErr
|
||||
AppSCacheLoadSuccessObs sCache resultTime -> do
|
||||
logWithZTime loggerState $ "Schema cache queried in " <> showMillis resultTime <> " milliseconds"
|
||||
logWithZTime loggerState $ "Schema cache loaded " <> showSummary sCache
|
||||
ConnectionRetryObs delay -> do
|
||||
logWithZTime loggerState $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..."
|
||||
ConnectionPgVersionErrorObs usageErr ->
|
||||
logPgrstError loggerState usageErr
|
||||
DBListenerStart channel -> do
|
||||
logWithZTime loggerState $ "Listening for notifications on the " <> channel <> " channel"
|
||||
DBListenerFailNoRecoverObs ->
|
||||
logWithZTime loggerState "Automatic recovery disabled, exiting."
|
||||
DBListenerFailRecoverObs channel ->
|
||||
logWithZTime loggerState $ "Retrying listening for notifications on the " <> channel <> " channel.."
|
||||
ConfigReadErrorObs ->
|
||||
logWithZTime loggerState "An error ocurred when trying to query database settings for the config parameters"
|
||||
ConfigReadErrorFatalObs usageErr hint -> do
|
||||
logPgrstError loggerState usageErr
|
||||
logWithZTime loggerState hint
|
||||
ConfigReadErrorNotFatalObs usageErr -> do
|
||||
logPgrstError loggerState usageErr
|
||||
QueryRoleSettingsErrorObs usageErr -> do
|
||||
logWithZTime loggerState "An error ocurred when trying to query the role settings"
|
||||
logPgrstError loggerState usageErr
|
||||
QueryErrorCodeHighObs usageErr -> do
|
||||
logPgrstError loggerState usageErr
|
||||
ConfigInvalidObs err -> do
|
||||
logWithZTime loggerState $ "Failed reloading config: " <> err
|
||||
ConfigSucceededObs -> do
|
||||
logWithZTime loggerState "Config reloaded"
|
||||
PoolAcqTimeoutObs usageErr -> do
|
||||
logPgrstError loggerState usageErr
|
||||
where
|
||||
showMillis :: Double -> Text
|
||||
showMillis x = toS $ showFFloat (Just 1) (x * 1000) ""
|
||||
logObservation loggerState obs = logWithZTime loggerState $ observationMessage obs
|
||||
|
||||
logWithZTime :: LoggerState -> Text -> IO ()
|
||||
logWithZTime loggerState txt = do
|
||||
zTime <- stateGetZTime loggerState
|
||||
hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt
|
||||
|
||||
@@ -1,29 +1,37 @@
|
||||
{-# 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 PostgREST.SchemaCache (SchemaCache)
|
||||
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)
|
||||
| AppStartObs ByteString
|
||||
| AppServerStartObs ByteString
|
||||
| AppServerPortObs NS.PortNumber
|
||||
| AppServerUnixObs FilePath
|
||||
| AppDBConnectAttemptObs
|
||||
| AppExitFatalObs Text
|
||||
| AppExitDBNoRecoveryObs
|
||||
| AppDBConnectedObs Text
|
||||
| AppSCacheFatalErrorObs SQL.UsageError Text
|
||||
| AppSCacheNormalErrorObs SQL.UsageError
|
||||
| AppSCacheLoadSuccessObs SchemaCache Double
|
||||
| DBConnectAttemptObs
|
||||
| ExitFatalObs Text
|
||||
| ExitDBNoRecoveryObs
|
||||
| DBConnectedObs Text
|
||||
| SchemaCacheFatalErrorObs SQL.UsageError Text
|
||||
| SchemaCacheNormalErrorObs SQL.UsageError
|
||||
| SchemaCacheQueriedObs Double
|
||||
| SchemaCacheLoadedObs SchemaCache
|
||||
| ConnectionRetryObs Int
|
||||
| ConnectionPgVersionErrorObs SQL.UsageError
|
||||
| DBListenerStart Text
|
||||
@@ -37,3 +45,61 @@ data Observation
|
||||
| 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"
|
||||
SchemaCacheLoadedObs sCache ->
|
||||
"Schema cache loaded " <> showSummary sCache
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user