2023-03-14 07:38:09 +03:00
|
|
|
{-# LANGUAGE NumericUnderscores #-}
|
2022-03-16 03:39:21 +03:00
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
2019-11-26 15:14:21 +03:00
|
|
|
{-# LANGUAGE UndecidableInstances #-}
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
module Hasura.Logging
|
|
|
|
( LoggerSettings (..),
|
|
|
|
defaultLoggerSettings,
|
2019-07-11 08:37:06 +03:00
|
|
|
EngineLogType (..),
|
2019-11-26 15:14:21 +03:00
|
|
|
Hasura,
|
|
|
|
InternalLogTypes (..),
|
|
|
|
EngineLog (..),
|
2019-07-11 08:37:06 +03:00
|
|
|
userAllowedLogTypes,
|
2018-07-20 10:22:46 +03:00
|
|
|
ToEngineLog (..),
|
|
|
|
debugT,
|
|
|
|
debugBS,
|
|
|
|
debugLBS,
|
2020-03-05 20:59:26 +03:00
|
|
|
UnstructuredLog (..),
|
2018-09-27 14:22:49 +03:00
|
|
|
Logger (..),
|
2018-07-20 10:22:46 +03:00
|
|
|
LogLevel (..),
|
2023-05-30 15:31:14 +03:00
|
|
|
UnhandledInternalErrorLog (..),
|
2018-07-20 10:22:46 +03:00
|
|
|
mkLogger,
|
2022-07-11 11:04:30 +03:00
|
|
|
nullLogger,
|
2018-07-27 12:34:50 +03:00
|
|
|
LoggerCtx (..),
|
2018-07-20 10:22:46 +03:00
|
|
|
mkLoggerCtx,
|
|
|
|
cleanLoggerCtx,
|
2019-11-26 15:14:21 +03:00
|
|
|
eventTriggerLogType,
|
2023-01-30 09:06:45 +03:00
|
|
|
eventTriggerProcessLogType,
|
2020-05-13 15:33:16 +03:00
|
|
|
scheduledTriggerLogType,
|
2023-01-30 09:06:45 +03:00
|
|
|
scheduledTriggerProcessLogType,
|
2023-02-07 15:22:08 +03:00
|
|
|
cronEventGeneratorProcessType,
|
2021-11-09 17:21:48 +03:00
|
|
|
sourceCatalogMigrationLogType,
|
2019-11-26 15:14:21 +03:00
|
|
|
EnabledLogTypes (..),
|
|
|
|
defaultEnabledEngineLogTypes,
|
|
|
|
isEngineLogTypeEnabled,
|
|
|
|
readLogTypes,
|
2021-09-09 14:54:19 +03:00
|
|
|
getFormattedTime,
|
2023-03-14 07:38:09 +03:00
|
|
|
|
2023-03-14 08:52:25 +03:00
|
|
|
-- * Debounced stats logger
|
2023-03-14 07:38:09 +03:00
|
|
|
createStatsLogger,
|
|
|
|
closeStatsLogger,
|
|
|
|
logStats,
|
2023-06-06 11:49:53 +03:00
|
|
|
|
|
|
|
-- * Other internal logs
|
|
|
|
StoredIntrospectionLog (..),
|
2023-06-12 11:50:33 +03:00
|
|
|
StoredIntrospectionStorageLog (..),
|
2018-07-20 10:22:46 +03:00
|
|
|
)
|
|
|
|
where
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2021-03-02 00:37:49 +03:00
|
|
|
import Control.AutoUpdate qualified as Auto
|
2023-05-30 15:31:14 +03:00
|
|
|
import Control.Exception (ErrorCall (ErrorCallWithLocation), catch)
|
2023-03-14 07:38:09 +03:00
|
|
|
import Control.FoldDebounce qualified as FDebounce
|
2021-03-13 17:40:50 +03:00
|
|
|
import Control.Monad.Trans.Control
|
|
|
|
import Control.Monad.Trans.Managed (ManagedT (..), allocate)
|
2021-03-02 00:37:49 +03:00
|
|
|
import Data.Aeson qualified as J
|
|
|
|
import Data.Aeson.TH qualified as J
|
2022-07-11 11:04:30 +03:00
|
|
|
import Data.Aeson.Types qualified as J
|
2021-03-02 00:37:49 +03:00
|
|
|
import Data.ByteString qualified as B
|
|
|
|
import Data.ByteString.Lazy qualified as BL
|
|
|
|
import Data.ByteString.Lazy.Char8 qualified as BLC
|
|
|
|
import Data.HashSet qualified as Set
|
2022-07-11 11:04:30 +03:00
|
|
|
import Data.Map.Strict (Map)
|
|
|
|
import Data.Map.Strict qualified as Map
|
2022-06-17 12:56:38 +03:00
|
|
|
import Data.SerializableBlob qualified as SB
|
2023-05-30 15:31:14 +03:00
|
|
|
import Data.String (fromString)
|
2021-03-02 00:37:49 +03:00
|
|
|
import Data.Text qualified as T
|
|
|
|
import Data.Time.Clock qualified as Time
|
|
|
|
import Data.Time.Format qualified as Format
|
|
|
|
import Data.Time.LocalTime qualified as Time
|
2023-06-06 11:49:53 +03:00
|
|
|
import Hasura.Base.Error (QErr)
|
2018-07-20 10:22:46 +03:00
|
|
|
import Hasura.Prelude
|
2021-03-02 00:37:49 +03:00
|
|
|
import System.Log.FastLogger qualified as FL
|
2022-07-11 11:04:30 +03:00
|
|
|
import Witch qualified
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2018-07-20 10:22:46 +03:00
|
|
|
newtype FormattedTime = FormattedTime {_unFormattedTime :: Text}
|
|
|
|
deriving (Show, Eq, J.ToJSON)
|
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
-- | Typeclass representing any type which can be parsed into a list of enabled log types, and has a @Set@
|
|
|
|
-- of default enabled log types, and can find out if a log type is enabled
|
|
|
|
class (Eq (EngineLogType impl), Hashable (EngineLogType impl)) => EnabledLogTypes impl where
|
|
|
|
parseEnabledLogTypes :: String -> Either String [EngineLogType impl]
|
|
|
|
defaultEnabledLogTypes :: Set.HashSet (EngineLogType impl)
|
|
|
|
isLogTypeEnabled :: Set.HashSet (EngineLogType impl) -> EngineLogType impl -> Bool
|
|
|
|
|
|
|
|
-- | A family of EngineLogType types
|
|
|
|
data family EngineLogType impl
|
|
|
|
|
|
|
|
data Hasura
|
|
|
|
|
|
|
|
data instance EngineLogType Hasura
|
2019-07-11 08:37:06 +03:00
|
|
|
= ELTHttpLog
|
|
|
|
| ELTWebsocketLog
|
|
|
|
| ELTWebhookLog
|
|
|
|
| ELTQueryLog
|
2023-03-15 16:05:17 +03:00
|
|
|
| ELTExecutionLog
|
2019-07-11 08:37:06 +03:00
|
|
|
| ELTStartup
|
2020-06-04 20:25:21 +03:00
|
|
|
| ELTLivequeryPollerLog
|
2020-07-29 16:30:29 +03:00
|
|
|
| ELTActionHandler
|
2022-07-11 11:04:30 +03:00
|
|
|
| ELTDataConnectorLog
|
2022-11-08 10:36:26 +03:00
|
|
|
| ELTJwkRefreshLog
|
2019-07-11 08:37:06 +03:00
|
|
|
| -- internal log types
|
2019-11-26 15:14:21 +03:00
|
|
|
ELTInternal !InternalLogTypes
|
2019-07-11 08:37:06 +03:00
|
|
|
deriving (Show, Eq, Generic)
|
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
instance Hashable (EngineLogType Hasura)
|
|
|
|
|
2022-07-11 11:04:30 +03:00
|
|
|
instance Witch.From (EngineLogType Hasura) Text where
|
|
|
|
from = \case
|
2021-01-19 22:14:42 +03:00
|
|
|
ELTHttpLog -> "http-log"
|
|
|
|
ELTWebsocketLog -> "websocket-log"
|
|
|
|
ELTWebhookLog -> "webhook-log"
|
|
|
|
ELTQueryLog -> "query-log"
|
2023-03-15 16:05:17 +03:00
|
|
|
ELTExecutionLog -> "execution-log"
|
2021-01-19 22:14:42 +03:00
|
|
|
ELTStartup -> "startup"
|
2020-06-04 20:25:21 +03:00
|
|
|
ELTLivequeryPollerLog -> "livequery-poller-log"
|
2021-01-19 22:14:42 +03:00
|
|
|
ELTActionHandler -> "action-handler-log"
|
2022-07-11 11:04:30 +03:00
|
|
|
ELTDataConnectorLog -> "data-connector-log"
|
2022-11-08 10:36:26 +03:00
|
|
|
ELTJwkRefreshLog -> "jwk-refresh-log"
|
2022-07-11 11:04:30 +03:00
|
|
|
ELTInternal t -> Witch.from t
|
|
|
|
|
|
|
|
instance J.ToJSON (EngineLogType Hasura) where
|
|
|
|
toJSON = J.String . Witch.into @Text
|
2019-11-26 15:14:21 +03:00
|
|
|
|
|
|
|
instance J.FromJSON (EngineLogType Hasura) where
|
2022-07-11 11:04:30 +03:00
|
|
|
parseJSON = J.withText "log-type" $ \s ->
|
|
|
|
let logTypeText = T.toLower $ T.strip s
|
|
|
|
logTypeMaybe = Map.lookup logTypeText allowedLogTypeMapping
|
|
|
|
in logTypeMaybe `onNothing` failure
|
|
|
|
where
|
|
|
|
allowedLogTypeMapping :: Map Text (EngineLogType Hasura)
|
|
|
|
allowedLogTypeMapping =
|
|
|
|
Map.fromList $ (\lt -> (Witch.into @Text lt, lt)) <$> userAllowedLogTypes
|
|
|
|
|
|
|
|
failure :: J.Parser (EngineLogType Hasura)
|
|
|
|
failure =
|
|
|
|
fail $ "Valid list of comma-separated log types: " <> BLC.unpack (J.encode userAllowedLogTypes)
|
2019-11-26 15:14:21 +03:00
|
|
|
|
|
|
|
data InternalLogTypes
|
|
|
|
= -- | mostly for debug logs - see @debugT@, @debugBS@ and @debugLBS@ functions
|
|
|
|
ILTUnstructured
|
2023-05-30 15:31:14 +03:00
|
|
|
| ILTUnhandledInternalError
|
2019-11-26 15:14:21 +03:00
|
|
|
| ILTEventTrigger
|
2023-01-30 09:06:45 +03:00
|
|
|
| ILTEventTriggerProcess
|
2020-05-13 15:33:16 +03:00
|
|
|
| ILTScheduledTrigger
|
2023-01-30 09:06:45 +03:00
|
|
|
| ILTScheduledTriggerProcess
|
2023-02-07 15:22:08 +03:00
|
|
|
| ILTCronEventGeneratorProcess
|
2019-11-26 15:14:21 +03:00
|
|
|
| -- | internal logs for the websocket server
|
|
|
|
ILTWsServer
|
|
|
|
| ILTPgClient
|
|
|
|
| -- | log type for logging metadata related actions; currently used in logging inconsistent metadata
|
|
|
|
ILTMetadata
|
|
|
|
| ILTTelemetry
|
2022-11-06 01:37:04 +03:00
|
|
|
| ILTSchemaSync
|
2021-11-09 17:21:48 +03:00
|
|
|
| ILTSourceCatalogMigration
|
2023-06-06 11:49:53 +03:00
|
|
|
| ILTStoredIntrospection
|
2023-06-12 11:50:33 +03:00
|
|
|
| ILTStoredIntrospectionStorage
|
2019-11-26 15:14:21 +03:00
|
|
|
deriving (Show, Eq, Generic)
|
|
|
|
|
|
|
|
instance Hashable InternalLogTypes
|
|
|
|
|
2022-07-11 11:04:30 +03:00
|
|
|
instance Witch.From InternalLogTypes Text where
|
|
|
|
from = \case
|
2021-01-19 22:14:42 +03:00
|
|
|
ILTUnstructured -> "unstructured"
|
2023-05-30 15:31:14 +03:00
|
|
|
ILTUnhandledInternalError -> "unhandled-internal-error"
|
2021-01-19 22:14:42 +03:00
|
|
|
ILTEventTrigger -> "event-trigger"
|
2023-01-30 09:06:45 +03:00
|
|
|
ILTEventTriggerProcess -> "event-trigger-process"
|
2020-05-13 15:33:16 +03:00
|
|
|
ILTScheduledTrigger -> "scheduled-trigger"
|
2023-01-30 09:06:45 +03:00
|
|
|
ILTScheduledTriggerProcess -> "scheduled-trigger-process"
|
2023-02-07 15:22:08 +03:00
|
|
|
ILTCronEventGeneratorProcess -> "cron-event-generator-process"
|
2021-01-19 22:14:42 +03:00
|
|
|
ILTWsServer -> "ws-server"
|
|
|
|
ILTPgClient -> "pg-client"
|
|
|
|
ILTMetadata -> "metadata"
|
|
|
|
ILTTelemetry -> "telemetry-log"
|
2022-11-06 01:37:04 +03:00
|
|
|
ILTSchemaSync -> "schema-sync"
|
2021-11-09 17:21:48 +03:00
|
|
|
ILTSourceCatalogMigration -> "source-catalog-migration"
|
2023-06-06 11:49:53 +03:00
|
|
|
ILTStoredIntrospection -> "stored-introspection"
|
2023-06-12 11:50:33 +03:00
|
|
|
ILTStoredIntrospectionStorage -> "stored-introspection-storage"
|
2019-07-11 08:37:06 +03:00
|
|
|
|
2022-07-11 11:04:30 +03:00
|
|
|
instance J.ToJSON InternalLogTypes where
|
|
|
|
toJSON = J.String . Witch.into @Text
|
|
|
|
|
2019-07-11 08:37:06 +03:00
|
|
|
-- the default enabled log-types
|
2019-11-26 15:14:21 +03:00
|
|
|
defaultEnabledEngineLogTypes :: Set.HashSet (EngineLogType Hasura)
|
|
|
|
defaultEnabledEngineLogTypes =
|
2022-11-08 19:47:25 +03:00
|
|
|
Set.fromList [ELTStartup, ELTHttpLog, ELTWebhookLog, ELTWebsocketLog, ELTJwkRefreshLog]
|
2019-07-11 08:37:06 +03:00
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
isEngineLogTypeEnabled :: Set.HashSet (EngineLogType Hasura) -> EngineLogType Hasura -> Bool
|
|
|
|
isEngineLogTypeEnabled enabledTypes logTy = case logTy of
|
|
|
|
ELTInternal _ -> True
|
|
|
|
_ -> logTy `Set.member` enabledTypes
|
|
|
|
|
|
|
|
readLogTypes :: String -> Either String [EngineLogType Hasura]
|
|
|
|
readLogTypes = mapM (J.eitherDecodeStrict' . quote . txtToBs) . T.splitOn "," . T.pack
|
|
|
|
where
|
|
|
|
quote x = "\"" <> x <> "\""
|
|
|
|
|
|
|
|
instance EnabledLogTypes Hasura where
|
|
|
|
parseEnabledLogTypes = readLogTypes
|
|
|
|
defaultEnabledLogTypes = defaultEnabledEngineLogTypes
|
|
|
|
isLogTypeEnabled = isEngineLogTypeEnabled
|
|
|
|
|
2019-07-11 08:37:06 +03:00
|
|
|
-- log types that can be set by the user
|
2019-11-26 15:14:21 +03:00
|
|
|
userAllowedLogTypes :: [EngineLogType Hasura]
|
2019-07-11 08:37:06 +03:00
|
|
|
userAllowedLogTypes =
|
|
|
|
[ ELTStartup,
|
|
|
|
ELTHttpLog,
|
|
|
|
ELTWebhookLog,
|
|
|
|
ELTWebsocketLog,
|
|
|
|
ELTQueryLog,
|
2023-03-15 16:05:17 +03:00
|
|
|
ELTExecutionLog,
|
2022-07-11 11:04:30 +03:00
|
|
|
ELTLivequeryPollerLog,
|
|
|
|
ELTActionHandler,
|
2022-11-08 10:36:26 +03:00
|
|
|
ELTDataConnectorLog,
|
|
|
|
ELTJwkRefreshLog
|
2019-07-11 08:37:06 +03:00
|
|
|
]
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
data LogLevel
|
|
|
|
= LevelDebug
|
|
|
|
| LevelInfo
|
|
|
|
| LevelWarn
|
|
|
|
| LevelError
|
|
|
|
| LevelOther Text
|
|
|
|
deriving (Show, Eq, Ord)
|
|
|
|
|
|
|
|
instance J.ToJSON LogLevel where
|
|
|
|
toJSON =
|
|
|
|
J.toJSON . \case
|
|
|
|
LevelDebug -> "debug"
|
|
|
|
LevelInfo -> "info"
|
|
|
|
LevelWarn -> "warn"
|
|
|
|
LevelError -> "error"
|
|
|
|
LevelOther t -> t
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
data EngineLog impl = EngineLog
|
2018-07-20 10:22:46 +03:00
|
|
|
{ _elTimestamp :: !FormattedTime,
|
|
|
|
_elLevel :: !LogLevel,
|
2019-11-26 15:14:21 +03:00
|
|
|
_elType :: !(EngineLogType impl),
|
2018-07-20 10:22:46 +03:00
|
|
|
_elDetail :: !J.Value
|
2019-11-26 15:14:21 +03:00
|
|
|
}
|
|
|
|
|
2023-05-24 16:51:56 +03:00
|
|
|
deriving instance (Show (EngineLogType impl)) => Show (EngineLog impl)
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2023-05-24 16:51:56 +03:00
|
|
|
deriving instance (Eq (EngineLogType impl)) => Eq (EngineLog impl)
|
2019-11-26 15:14:21 +03:00
|
|
|
|
2022-03-16 03:39:21 +03:00
|
|
|
-- Empty splice to bring all the above definitions in scope.
|
|
|
|
--
|
|
|
|
-- TODO: Restructure the code so that we can avoid this.
|
2019-11-26 15:14:21 +03:00
|
|
|
$(pure [])
|
|
|
|
|
2023-05-24 16:51:56 +03:00
|
|
|
instance (J.ToJSON (EngineLogType impl)) => J.ToJSON (EngineLog impl) where
|
2021-01-19 22:14:42 +03:00
|
|
|
toJSON = $(J.mkToJSON hasuraJSON ''EngineLog)
|
2019-11-26 15:14:21 +03:00
|
|
|
|
|
|
|
-- | Typeclass representing any data type that can be converted to @EngineLog@ for the purpose of
|
|
|
|
-- logging
|
2023-05-24 16:51:56 +03:00
|
|
|
class (EnabledLogTypes impl) => ToEngineLog a impl where
|
2019-11-26 15:14:21 +03:00
|
|
|
toEngineLog :: a -> (LogLevel, EngineLogType impl, J.Value)
|
2018-07-20 10:22:46 +03:00
|
|
|
|
2022-06-17 12:56:38 +03:00
|
|
|
data UnstructuredLog = UnstructuredLog {_ulLevel :: !LogLevel, _ulPayload :: !SB.SerializableBlob}
|
|
|
|
deriving (Show)
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
debugT :: Text -> UnstructuredLog
|
2022-06-17 12:56:38 +03:00
|
|
|
debugT = UnstructuredLog LevelDebug . SB.fromText
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
debugBS :: B.ByteString -> UnstructuredLog
|
2022-06-17 12:56:38 +03:00
|
|
|
debugBS = UnstructuredLog LevelDebug . SB.fromBS
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
debugLBS :: BL.ByteString -> UnstructuredLog
|
2022-06-17 12:56:38 +03:00
|
|
|
debugLBS = UnstructuredLog LevelDebug . SB.fromLBS
|
2018-07-20 10:22:46 +03:00
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
instance ToEngineLog UnstructuredLog Hasura where
|
2020-03-05 20:59:26 +03:00
|
|
|
toEngineLog (UnstructuredLog level t) =
|
|
|
|
(level, ELTInternal ILTUnstructured, J.toJSON t)
|
2018-07-20 10:22:46 +03:00
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
data LoggerCtx impl = LoggerCtx
|
2019-07-11 08:37:06 +03:00
|
|
|
{ _lcLoggerSet :: !FL.LoggerSet,
|
|
|
|
_lcLogLevel :: !LogLevel,
|
|
|
|
_lcTimeGetter :: !(IO FormattedTime),
|
2019-11-26 15:14:21 +03:00
|
|
|
_lcEnabledLogTypes :: !(Set.HashSet (EngineLogType impl))
|
2018-07-20 10:22:46 +03:00
|
|
|
}
|
|
|
|
|
2023-05-30 15:31:14 +03:00
|
|
|
-- * Unhandled Internal Errors
|
|
|
|
|
|
|
|
-- | We expect situations where there are code paths that should not occur and we throw
|
|
|
|
-- an 'error' on this code paths. If our assumptions are incorrect and infact
|
|
|
|
-- these errors do occur, we want to log them.
|
|
|
|
newtype UnhandledInternalErrorLog = UnhandledInternalErrorLog ErrorCall
|
|
|
|
|
|
|
|
instance ToEngineLog UnhandledInternalErrorLog Hasura where
|
|
|
|
toEngineLog (UnhandledInternalErrorLog (ErrorCallWithLocation err loc)) =
|
|
|
|
( LevelError,
|
|
|
|
ELTInternal ILTUnhandledInternalError,
|
|
|
|
J.object [("error", fromString err), ("location", fromString loc)]
|
|
|
|
)
|
|
|
|
|
|
|
|
-- * LoggerSettings
|
|
|
|
|
2018-07-20 10:22:46 +03:00
|
|
|
data LoggerSettings = LoggerSettings
|
2019-11-26 15:14:21 +03:00
|
|
|
{ -- | should current time be cached (refreshed every sec)
|
2018-07-20 10:22:46 +03:00
|
|
|
_lsCachedTimestamp :: !Bool,
|
|
|
|
_lsTimeZone :: !(Maybe Time.TimeZone),
|
|
|
|
_lsLevel :: !LogLevel
|
|
|
|
}
|
|
|
|
deriving (Show, Eq)
|
2019-11-26 15:14:21 +03:00
|
|
|
|
2019-07-11 08:37:06 +03:00
|
|
|
defaultLoggerSettings :: Bool -> LogLevel -> LoggerSettings
|
2018-09-05 14:26:46 +03:00
|
|
|
defaultLoggerSettings isCached =
|
2019-07-11 08:37:06 +03:00
|
|
|
LoggerSettings isCached Nothing
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
getFormattedTime :: Maybe Time.TimeZone -> IO FormattedTime
|
|
|
|
getFormattedTime tzM = do
|
2020-10-28 19:40:33 +03:00
|
|
|
tz <- onNothing tzM Time.getCurrentTimeZone
|
2018-07-20 10:22:46 +03:00
|
|
|
t <- Time.getCurrentTime
|
|
|
|
let zt = Time.utcToZonedTime tz t
|
|
|
|
return $ FormattedTime $ T.pack $ formatTime zt
|
|
|
|
where
|
|
|
|
formatTime = Format.formatTime Format.defaultTimeLocale format
|
2018-09-05 14:26:46 +03:00
|
|
|
format = "%FT%H:%M:%S%3Q%z"
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
-- format = Format.iso8601DateFormat (Just "%H:%M:%S")
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2023-04-05 14:05:42 +03:00
|
|
|
-- | Creates a new 'LoggerCtx'.
|
|
|
|
--
|
|
|
|
-- The underlying 'LoggerSet' is bound to the 'ManagedT' context: when it exits,
|
|
|
|
-- the log will be flushed and cleared regardless of whether it was exited
|
|
|
|
-- properly or not ('ManagedT' uses 'bracket' underneath). This guarantees that
|
|
|
|
-- the logs will always be flushed, even in case of error, avoiding a repeat of
|
|
|
|
-- https://github.com/hasura/graphql-engine/issues/4772.
|
2019-11-26 15:14:21 +03:00
|
|
|
mkLoggerCtx ::
|
2020-12-21 21:56:00 +03:00
|
|
|
(MonadIO io, MonadBaseControl IO io) =>
|
|
|
|
LoggerSettings ->
|
2019-11-26 15:14:21 +03:00
|
|
|
Set.HashSet (EngineLogType impl) ->
|
2020-12-21 21:56:00 +03:00
|
|
|
ManagedT io (LoggerCtx impl)
|
2019-07-11 08:37:06 +03:00
|
|
|
mkLoggerCtx (LoggerSettings cacheTime tzM logLevel) enabledLogs = do
|
2023-04-05 14:05:42 +03:00
|
|
|
loggerSet <- allocate acquire release
|
|
|
|
timeGetter <- liftIO $ bool (pure $ getFormattedTime tzM) cachedTimeGetter cacheTime
|
|
|
|
pure $ LoggerCtx loggerSet logLevel timeGetter enabledLogs
|
2018-07-20 10:22:46 +03:00
|
|
|
where
|
2023-04-05 14:05:42 +03:00
|
|
|
acquire = liftIO do
|
|
|
|
FL.newStdoutLoggerSet FL.defaultBufSize
|
|
|
|
release loggerSet = liftIO do
|
|
|
|
FL.flushLogStr loggerSet
|
|
|
|
FL.rmLoggerSet loggerSet
|
2018-07-20 10:22:46 +03:00
|
|
|
cachedTimeGetter =
|
|
|
|
Auto.mkAutoUpdate
|
|
|
|
Auto.defaultUpdateSettings
|
|
|
|
{ Auto.updateAction = getFormattedTime tzM
|
|
|
|
}
|
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
cleanLoggerCtx :: LoggerCtx a -> IO ()
|
2018-07-20 10:22:46 +03:00
|
|
|
cleanLoggerCtx =
|
|
|
|
FL.rmLoggerSet . _lcLoggerSet
|
|
|
|
|
2021-03-02 00:37:49 +03:00
|
|
|
-- See Note [Existentially Quantified Types]
|
2019-11-26 15:14:21 +03:00
|
|
|
newtype Logger impl = Logger {unLogger :: forall a m. (ToEngineLog a impl, MonadIO m) => a -> m ()}
|
|
|
|
|
2022-09-15 12:12:09 +03:00
|
|
|
mkLogger :: (J.ToJSON (EngineLogType impl)) => LoggerCtx impl -> Logger impl
|
2019-07-11 08:37:06 +03:00
|
|
|
mkLogger (LoggerCtx loggerSet serverLogLevel timeGetter enabledLogTypes) = Logger $ \l -> do
|
2019-11-26 15:14:21 +03:00
|
|
|
localTime <- liftIO timeGetter
|
2018-07-20 10:22:46 +03:00
|
|
|
let (logLevel, logTy, logDet) = toEngineLog l
|
2023-05-24 16:51:56 +03:00
|
|
|
when (logLevel >= serverLogLevel && isLogTypeEnabled enabledLogTypes logTy)
|
|
|
|
$ liftIO
|
|
|
|
$ FL.pushLogStrLn loggerSet
|
|
|
|
$ FL.toLogStr (J.encode $ EngineLog localTime logLevel logTy logDet)
|
2019-11-26 15:14:21 +03:00
|
|
|
|
2022-07-11 11:04:30 +03:00
|
|
|
nullLogger :: Logger Hasura
|
|
|
|
nullLogger = Logger \_ -> pure ()
|
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
eventTriggerLogType :: EngineLogType Hasura
|
|
|
|
eventTriggerLogType = ELTInternal ILTEventTrigger
|
2020-05-13 15:33:16 +03:00
|
|
|
|
2023-01-30 09:06:45 +03:00
|
|
|
eventTriggerProcessLogType :: EngineLogType Hasura
|
|
|
|
eventTriggerProcessLogType = ELTInternal ILTEventTriggerProcess
|
|
|
|
|
2020-05-13 15:33:16 +03:00
|
|
|
scheduledTriggerLogType :: EngineLogType Hasura
|
|
|
|
scheduledTriggerLogType = ELTInternal ILTScheduledTrigger
|
2021-11-09 17:21:48 +03:00
|
|
|
|
2023-01-30 09:06:45 +03:00
|
|
|
scheduledTriggerProcessLogType :: EngineLogType Hasura
|
|
|
|
scheduledTriggerProcessLogType = ELTInternal ILTScheduledTriggerProcess
|
|
|
|
|
2023-02-07 15:22:08 +03:00
|
|
|
cronEventGeneratorProcessType :: EngineLogType Hasura
|
|
|
|
cronEventGeneratorProcessType = ELTInternal ILTCronEventGeneratorProcess
|
|
|
|
|
2021-11-09 17:21:48 +03:00
|
|
|
sourceCatalogMigrationLogType :: EngineLogType Hasura
|
|
|
|
sourceCatalogMigrationLogType = ELTInternal ILTSourceCatalogMigration
|
2023-03-14 07:38:09 +03:00
|
|
|
|
2023-06-12 11:50:33 +03:00
|
|
|
-- | Emit when stored introspection is used
|
2023-06-06 11:49:53 +03:00
|
|
|
data StoredIntrospectionLog = StoredIntrospectionLog
|
|
|
|
{ silMessage :: Text,
|
2023-06-12 11:50:33 +03:00
|
|
|
-- | upstream data source errors
|
|
|
|
silSourceError :: QErr
|
2023-06-06 11:49:53 +03:00
|
|
|
}
|
|
|
|
deriving stock (Generic)
|
|
|
|
|
|
|
|
instance J.ToJSON StoredIntrospectionLog where
|
|
|
|
toJSON = J.genericToJSON hasuraJSON
|
|
|
|
|
|
|
|
instance ToEngineLog StoredIntrospectionLog Hasura where
|
|
|
|
toEngineLog siLog =
|
|
|
|
(LevelInfo, ELTInternal ILTStoredIntrospection, J.toJSON siLog)
|
|
|
|
|
2023-06-12 11:50:33 +03:00
|
|
|
-- | Logs related to errors while interacting with the stored introspection
|
|
|
|
-- storage
|
|
|
|
data StoredIntrospectionStorageLog = StoredIntrospectionStorageLog
|
|
|
|
{ sislMessage :: Text,
|
|
|
|
sislError :: QErr
|
|
|
|
}
|
|
|
|
deriving stock (Generic)
|
|
|
|
|
|
|
|
instance J.ToJSON StoredIntrospectionStorageLog where
|
|
|
|
toJSON = J.genericToJSON hasuraJSON
|
|
|
|
|
|
|
|
instance ToEngineLog StoredIntrospectionStorageLog Hasura where
|
|
|
|
toEngineLog sisLog =
|
|
|
|
(LevelInfo, ELTInternal ILTStoredIntrospectionStorage, J.toJSON sisLog)
|
|
|
|
|
2023-03-14 08:52:25 +03:00
|
|
|
-- | A logger useful for accumulating and logging stats, in tight polling loops. It also
|
|
|
|
-- debounces to not flood with excessive logs. Use @'logStats' to record statistics for logging.
|
2023-03-14 07:38:09 +03:00
|
|
|
createStatsLogger ::
|
|
|
|
forall m stats impl.
|
|
|
|
( MonadIO m,
|
|
|
|
ToEngineLog stats impl,
|
|
|
|
Monoid stats
|
|
|
|
) =>
|
|
|
|
Logger impl ->
|
|
|
|
m (FDebounce.Trigger stats stats)
|
|
|
|
createStatsLogger hasuraLogger =
|
|
|
|
liftIO $ FDebounce.new debounceArgs debounceOpts
|
|
|
|
where
|
|
|
|
logDelay :: Int
|
|
|
|
logDelay =
|
|
|
|
-- Accumulate stats occurred within 10 minutes and log once.
|
|
|
|
10 * 60 * 1000_000 -- 10 minutes
|
|
|
|
debounceArgs :: FDebounce.Args stats stats
|
|
|
|
debounceArgs =
|
|
|
|
FDebounce.Args
|
|
|
|
{ FDebounce.cb = unLogger hasuraLogger, -- Log using the Hasura logger
|
|
|
|
FDebounce.fold = (<>),
|
|
|
|
FDebounce.init = mempty
|
|
|
|
}
|
|
|
|
|
|
|
|
debounceOpts :: FDebounce.Opts stats stats
|
|
|
|
debounceOpts = FDebounce.def {FDebounce.delay = logDelay}
|
|
|
|
|
|
|
|
-- Orphan instance. Required for @'closeStatsLogger'.
|
|
|
|
instance (EnabledLogTypes impl) => ToEngineLog (FDebounce.OpException, EngineLogType impl) impl where
|
|
|
|
toEngineLog (opException, logType) =
|
|
|
|
let errorMessage :: Text
|
|
|
|
errorMessage = case opException of
|
|
|
|
FDebounce.AlreadyClosedException -> "already closed"
|
|
|
|
FDebounce.UnexpectedClosedException _someException -> "closed unexpectedly"
|
|
|
|
in (LevelWarn, logType, J.object ["message" J..= ("cannot close fetched events stats logger: " <> errorMessage)])
|
|
|
|
|
|
|
|
-- | Safely close the statistics logger. When occurred, exception is logged.
|
|
|
|
closeStatsLogger :: (MonadIO m, EnabledLogTypes impl) => EngineLogType impl -> Logger impl -> FDebounce.Trigger stats stats -> m ()
|
|
|
|
closeStatsLogger logType (Logger hasuraLogger) debounceLogger =
|
|
|
|
liftIO $ catch (FDebounce.close debounceLogger) $ \(e :: FDebounce.OpException) -> hasuraLogger (e, logType)
|
|
|
|
|
|
|
|
-- | This won't log the given stats immediately.
|
|
|
|
-- The stats are accumulated over the specific timeframe and logged only once.
|
|
|
|
-- See @'createStatsLogger' for more details.
|
|
|
|
logStats :: (MonadIO m) => FDebounce.Trigger stats stats -> stats -> m ()
|
|
|
|
logStats debounceTrigger = liftIO . FDebounce.send debounceTrigger
|