{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.Logging
  ( LoggerSettings (..),
    defaultLoggerSettings,
    EngineLogType (..),
    Hasura,
    InternalLogTypes (..),
    EngineLog (..),
    userAllowedLogTypes,
    ToEngineLog (..),
    debugT,
    debugBS,
    debugLBS,
    UnstructuredLog (..),
    Logger (..),
    LogLevel (..),
    UnhandledInternalErrorLog (..),
    mkLogger,
    nullLogger,
    LoggerCtx (..),
    mkLoggerCtx,
    cleanLoggerCtx,
    eventTriggerLogType,
    eventTriggerProcessLogType,
    scheduledTriggerLogType,
    scheduledTriggerProcessLogType,
    cronEventGeneratorProcessType,
    sourceCatalogMigrationLogType,
    EnabledLogTypes (..),
    defaultEnabledEngineLogTypes,
    isEngineLogTypeEnabled,
    readLogTypes,
    getFormattedTime,

    -- * Debounced stats logger
    createStatsLogger,
    closeStatsLogger,
    logStats,

    -- * Other internal logs
    StoredIntrospectionLog (..),
    StoredIntrospectionStorageLog (..),
  )
where

import Control.AutoUpdate qualified as Auto
import Control.Exception (ErrorCall (ErrorCallWithLocation), catch)
import Control.FoldDebounce qualified as FDebounce
import Control.Monad.Trans.Control
import Control.Monad.Trans.Managed (ManagedT (..), allocate)
import Data.Aeson qualified as J
import Data.Aeson.Types qualified as J
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
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.SerializableBlob qualified as SB
import Data.String (fromString)
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
import Hasura.Base.Error (QErr)
import Hasura.Prelude
import System.Log.FastLogger qualified as FL
import Witch qualified

newtype FormattedTime = FormattedTime {FormattedTime -> Text
_unFormattedTime :: Text}
  deriving (Int -> FormattedTime -> ShowS
[FormattedTime] -> ShowS
FormattedTime -> String
(Int -> FormattedTime -> ShowS)
-> (FormattedTime -> String)
-> ([FormattedTime] -> ShowS)
-> Show FormattedTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormattedTime -> ShowS
showsPrec :: Int -> FormattedTime -> ShowS
$cshow :: FormattedTime -> String
show :: FormattedTime -> String
$cshowList :: [FormattedTime] -> ShowS
showList :: [FormattedTime] -> ShowS
Show, FormattedTime -> FormattedTime -> Bool
(FormattedTime -> FormattedTime -> Bool)
-> (FormattedTime -> FormattedTime -> Bool) -> Eq FormattedTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormattedTime -> FormattedTime -> Bool
== :: FormattedTime -> FormattedTime -> Bool
$c/= :: FormattedTime -> FormattedTime -> Bool
/= :: FormattedTime -> FormattedTime -> Bool
Eq, [FormattedTime] -> Value
[FormattedTime] -> Encoding
FormattedTime -> Value
FormattedTime -> Encoding
(FormattedTime -> Value)
-> (FormattedTime -> Encoding)
-> ([FormattedTime] -> Value)
-> ([FormattedTime] -> Encoding)
-> ToJSON FormattedTime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FormattedTime -> Value
toJSON :: FormattedTime -> Value
$ctoEncoding :: FormattedTime -> Encoding
toEncoding :: FormattedTime -> Encoding
$ctoJSONList :: [FormattedTime] -> Value
toJSONList :: [FormattedTime] -> Value
$ctoEncodingList :: [FormattedTime] -> Encoding
toEncodingList :: [FormattedTime] -> Encoding
J.ToJSON)

-- | 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
  = ELTHttpLog
  | ELTWebsocketLog
  | ELTWebhookLog
  | ELTQueryLog
  | ELTExecutionLog
  | ELTStartup
  | ELTLivequeryPollerLog
  | ELTActionHandler
  | ELTDataConnectorLog
  | ELTJwkRefreshLog
  | ELTValidateInputLog
  | -- internal log types
    ELTInternal !InternalLogTypes
  deriving (Int -> EngineLogType Hasura -> ShowS
[EngineLogType Hasura] -> ShowS
EngineLogType Hasura -> String
(Int -> EngineLogType Hasura -> ShowS)
-> (EngineLogType Hasura -> String)
-> ([EngineLogType Hasura] -> ShowS)
-> Show (EngineLogType Hasura)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EngineLogType Hasura -> ShowS
showsPrec :: Int -> EngineLogType Hasura -> ShowS
$cshow :: EngineLogType Hasura -> String
show :: EngineLogType Hasura -> String
$cshowList :: [EngineLogType Hasura] -> ShowS
showList :: [EngineLogType Hasura] -> ShowS
Show, EngineLogType Hasura -> EngineLogType Hasura -> Bool
(EngineLogType Hasura -> EngineLogType Hasura -> Bool)
-> (EngineLogType Hasura -> EngineLogType Hasura -> Bool)
-> Eq (EngineLogType Hasura)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EngineLogType Hasura -> EngineLogType Hasura -> Bool
== :: EngineLogType Hasura -> EngineLogType Hasura -> Bool
$c/= :: EngineLogType Hasura -> EngineLogType Hasura -> Bool
/= :: EngineLogType Hasura -> EngineLogType Hasura -> Bool
Eq, (forall x. EngineLogType Hasura -> Rep (EngineLogType Hasura) x)
-> (forall x. Rep (EngineLogType Hasura) x -> EngineLogType Hasura)
-> Generic (EngineLogType Hasura)
forall x. Rep (EngineLogType Hasura) x -> EngineLogType Hasura
forall x. EngineLogType Hasura -> Rep (EngineLogType Hasura) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EngineLogType Hasura -> Rep (EngineLogType Hasura) x
from :: forall x. EngineLogType Hasura -> Rep (EngineLogType Hasura) x
$cto :: forall x. Rep (EngineLogType Hasura) x -> EngineLogType Hasura
to :: forall x. Rep (EngineLogType Hasura) x -> EngineLogType Hasura
Generic)

instance Hashable (EngineLogType Hasura)

instance Witch.From (EngineLogType Hasura) Text where
  from :: EngineLogType Hasura -> Text
from = \case
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTHttpLog -> Text
"http-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTWebsocketLog -> Text
"websocket-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTWebhookLog -> Text
"webhook-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTQueryLog -> Text
"query-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTExecutionLog -> Text
"execution-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTStartup -> Text
"startup"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTLivequeryPollerLog -> Text
"livequery-poller-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTActionHandler -> Text
"action-handler-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTDataConnectorLog -> Text
"data-connector-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTJwkRefreshLog -> Text
"jwk-refresh-log"
    EngineLogType Hasura
R:EngineLogTypeHasura
ELTValidateInputLog -> Text
"validate-insert-input-log"
    ELTInternal InternalLogTypes
t -> InternalLogTypes -> Text
forall source target. From source target => source -> target
Witch.from InternalLogTypes
t

instance J.ToJSON (EngineLogType Hasura) where
  toJSON :: EngineLogType Hasura -> Value
toJSON = Text -> Value
J.String (Text -> Value)
-> (EngineLogType Hasura -> Text) -> EngineLogType Hasura -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
Witch.into @Text

instance J.FromJSON (EngineLogType Hasura) where
  parseJSON :: Value -> Parser (EngineLogType Hasura)
parseJSON = String
-> (Text -> Parser (EngineLogType Hasura))
-> Value
-> Parser (EngineLogType Hasura)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"log-type" ((Text -> Parser (EngineLogType Hasura))
 -> Value -> Parser (EngineLogType Hasura))
-> (Text -> Parser (EngineLogType Hasura))
-> Value
-> Parser (EngineLogType Hasura)
forall a b. (a -> b) -> a -> b
$ \Text
s ->
    let logTypeText :: Text
logTypeText = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
s
        logTypeMaybe :: Maybe (EngineLogType Hasura)
logTypeMaybe = Text
-> Map Text (EngineLogType Hasura) -> Maybe (EngineLogType Hasura)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
logTypeText Map Text (EngineLogType Hasura)
allowedLogTypeMapping
     in Maybe (EngineLogType Hasura)
logTypeMaybe Maybe (EngineLogType Hasura)
-> Parser (EngineLogType Hasura) -> Parser (EngineLogType Hasura)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Parser (EngineLogType Hasura)
failure
    where
      allowedLogTypeMapping :: Map Text (EngineLogType Hasura)
      allowedLogTypeMapping :: Map Text (EngineLogType Hasura)
allowedLogTypeMapping =
        [(Text, EngineLogType Hasura)] -> Map Text (EngineLogType Hasura)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, EngineLogType Hasura)] -> Map Text (EngineLogType Hasura))
-> [(Text, EngineLogType Hasura)]
-> Map Text (EngineLogType Hasura)
forall a b. (a -> b) -> a -> b
$ (\EngineLogType Hasura
lt -> (forall target source. From source target => source -> target
Witch.into @Text EngineLogType Hasura
lt, EngineLogType Hasura
lt)) (EngineLogType Hasura -> (Text, EngineLogType Hasura))
-> [EngineLogType Hasura] -> [(Text, EngineLogType Hasura)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EngineLogType Hasura]
userAllowedLogTypes

      failure :: J.Parser (EngineLogType Hasura)
      failure :: Parser (EngineLogType Hasura)
failure =
        String -> Parser (EngineLogType Hasura)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (EngineLogType Hasura))
-> String -> Parser (EngineLogType Hasura)
forall a b. (a -> b) -> a -> b
$ String
"Valid list of comma-separated log types: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
BLC.unpack ([EngineLogType Hasura] -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode [EngineLogType Hasura]
userAllowedLogTypes)

data InternalLogTypes
  = -- | mostly for debug logs - see @debugT@, @debugBS@ and @debugLBS@ functions
    ILTUnstructured
  | ILTUnhandledInternalError
  | ILTEventTrigger
  | ILTEventTriggerProcess
  | ILTScheduledTrigger
  | ILTScheduledTriggerProcess
  | ILTCronEventGeneratorProcess
  | -- | internal logs for the websocket server
    ILTWsServer
  | ILTPgClient
  | -- | log type for logging metadata related actions; currently used in logging inconsistent metadata
    ILTMetadata
  | ILTTelemetry
  | ILTSchemaSync
  | ILTSourceCatalogMigration
  | ILTStoredIntrospection
  | ILTStoredIntrospectionStorage
  deriving (Int -> InternalLogTypes -> ShowS
[InternalLogTypes] -> ShowS
InternalLogTypes -> String
(Int -> InternalLogTypes -> ShowS)
-> (InternalLogTypes -> String)
-> ([InternalLogTypes] -> ShowS)
-> Show InternalLogTypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalLogTypes -> ShowS
showsPrec :: Int -> InternalLogTypes -> ShowS
$cshow :: InternalLogTypes -> String
show :: InternalLogTypes -> String
$cshowList :: [InternalLogTypes] -> ShowS
showList :: [InternalLogTypes] -> ShowS
Show, InternalLogTypes -> InternalLogTypes -> Bool
(InternalLogTypes -> InternalLogTypes -> Bool)
-> (InternalLogTypes -> InternalLogTypes -> Bool)
-> Eq InternalLogTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalLogTypes -> InternalLogTypes -> Bool
== :: InternalLogTypes -> InternalLogTypes -> Bool
$c/= :: InternalLogTypes -> InternalLogTypes -> Bool
/= :: InternalLogTypes -> InternalLogTypes -> Bool
Eq, (forall x. InternalLogTypes -> Rep InternalLogTypes x)
-> (forall x. Rep InternalLogTypes x -> InternalLogTypes)
-> Generic InternalLogTypes
forall x. Rep InternalLogTypes x -> InternalLogTypes
forall x. InternalLogTypes -> Rep InternalLogTypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InternalLogTypes -> Rep InternalLogTypes x
from :: forall x. InternalLogTypes -> Rep InternalLogTypes x
$cto :: forall x. Rep InternalLogTypes x -> InternalLogTypes
to :: forall x. Rep InternalLogTypes x -> InternalLogTypes
Generic)

instance Hashable InternalLogTypes

instance Witch.From InternalLogTypes Text where
  from :: InternalLogTypes -> Text
from = \case
    InternalLogTypes
ILTUnstructured -> Text
"unstructured"
    InternalLogTypes
ILTUnhandledInternalError -> Text
"unhandled-internal-error"
    InternalLogTypes
ILTEventTrigger -> Text
"event-trigger"
    InternalLogTypes
ILTEventTriggerProcess -> Text
"event-trigger-process"
    InternalLogTypes
ILTScheduledTrigger -> Text
"scheduled-trigger"
    InternalLogTypes
ILTScheduledTriggerProcess -> Text
"scheduled-trigger-process"
    InternalLogTypes
ILTCronEventGeneratorProcess -> Text
"cron-event-generator-process"
    InternalLogTypes
ILTWsServer -> Text
"ws-server"
    InternalLogTypes
ILTPgClient -> Text
"pg-client"
    InternalLogTypes
ILTMetadata -> Text
"metadata"
    InternalLogTypes
ILTTelemetry -> Text
"telemetry-log"
    InternalLogTypes
ILTSchemaSync -> Text
"schema-sync"
    InternalLogTypes
ILTSourceCatalogMigration -> Text
"source-catalog-migration"
    InternalLogTypes
ILTStoredIntrospection -> Text
"stored-introspection"
    InternalLogTypes
ILTStoredIntrospectionStorage -> Text
"stored-introspection-storage"

instance J.ToJSON InternalLogTypes where
  toJSON :: InternalLogTypes -> Value
toJSON = Text -> Value
J.String (Text -> Value)
-> (InternalLogTypes -> Text) -> InternalLogTypes -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
Witch.into @Text

-- the default enabled log-types
defaultEnabledEngineLogTypes :: Set.HashSet (EngineLogType Hasura)
defaultEnabledEngineLogTypes :: HashSet (EngineLogType Hasura)
defaultEnabledEngineLogTypes =
  [EngineLogType Hasura] -> HashSet (EngineLogType Hasura)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList [EngineLogType Hasura
ELTStartup, EngineLogType Hasura
ELTHttpLog, EngineLogType Hasura
ELTWebhookLog, EngineLogType Hasura
ELTWebsocketLog, EngineLogType Hasura
ELTJwkRefreshLog]

isEngineLogTypeEnabled :: Set.HashSet (EngineLogType Hasura) -> EngineLogType Hasura -> Bool
isEngineLogTypeEnabled :: HashSet (EngineLogType Hasura) -> EngineLogType Hasura -> Bool
isEngineLogTypeEnabled HashSet (EngineLogType Hasura)
enabledTypes EngineLogType Hasura
logTy = case EngineLogType Hasura
logTy of
  ELTInternal InternalLogTypes
_ -> Bool
True
  EngineLogType Hasura
_ -> EngineLogType Hasura
logTy EngineLogType Hasura -> HashSet (EngineLogType Hasura) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet (EngineLogType Hasura)
enabledTypes

readLogTypes :: String -> Either String [EngineLogType Hasura]
readLogTypes :: String -> Either String [EngineLogType Hasura]
readLogTypes = (Text -> Either String (EngineLogType Hasura))
-> [Text] -> Either String [EngineLogType Hasura]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ByteString -> Either String (EngineLogType Hasura)
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict' (ByteString -> Either String (EngineLogType Hasura))
-> (Text -> ByteString)
-> Text
-> Either String (EngineLogType Hasura)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall {a}. (Semigroup a, IsString a) => a -> a
quote (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
txtToBs) ([Text] -> Either String [EngineLogType Hasura])
-> (String -> [Text])
-> String
-> Either String [EngineLogType Hasura]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  where
    quote :: a -> a
quote a
x = a
"\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""

instance EnabledLogTypes Hasura where
  parseEnabledLogTypes :: String -> Either String [EngineLogType Hasura]
parseEnabledLogTypes = String -> Either String [EngineLogType Hasura]
readLogTypes
  defaultEnabledLogTypes :: HashSet (EngineLogType Hasura)
defaultEnabledLogTypes = HashSet (EngineLogType Hasura)
defaultEnabledEngineLogTypes
  isLogTypeEnabled :: HashSet (EngineLogType Hasura) -> EngineLogType Hasura -> Bool
isLogTypeEnabled = HashSet (EngineLogType Hasura) -> EngineLogType Hasura -> Bool
isEngineLogTypeEnabled

-- log types that can be set by the user
userAllowedLogTypes :: [EngineLogType Hasura]
userAllowedLogTypes :: [EngineLogType Hasura]
userAllowedLogTypes =
  [ EngineLogType Hasura
ELTStartup,
    EngineLogType Hasura
ELTHttpLog,
    EngineLogType Hasura
ELTWebhookLog,
    EngineLogType Hasura
ELTWebsocketLog,
    EngineLogType Hasura
ELTQueryLog,
    EngineLogType Hasura
ELTExecutionLog,
    EngineLogType Hasura
ELTLivequeryPollerLog,
    EngineLogType Hasura
ELTActionHandler,
    EngineLogType Hasura
ELTDataConnectorLog,
    EngineLogType Hasura
ELTJwkRefreshLog,
    EngineLogType Hasura
ELTValidateInputLog
  ]

data LogLevel
  = LevelDebug
  | LevelInfo
  | LevelWarn
  | LevelError
  | LevelOther Text
  deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LogLevel -> LogLevel -> Ordering
compare :: LogLevel -> LogLevel -> Ordering
$c< :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
>= :: LogLevel -> LogLevel -> Bool
$cmax :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
min :: LogLevel -> LogLevel -> LogLevel
Ord)

instance J.ToJSON LogLevel where
  toJSON :: LogLevel -> Value
toJSON =
    Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> (LogLevel -> Text) -> LogLevel -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      LogLevel
LevelDebug -> Text
"debug"
      LogLevel
LevelInfo -> Text
"info"
      LogLevel
LevelWarn -> Text
"warn"
      LogLevel
LevelError -> Text
"error"
      LevelOther Text
t -> Text
t

data EngineLog impl = EngineLog
  { forall impl. EngineLog impl -> FormattedTime
_elTimestamp :: !FormattedTime,
    forall impl. EngineLog impl -> LogLevel
_elLevel :: !LogLevel,
    forall impl. EngineLog impl -> EngineLogType impl
_elType :: !(EngineLogType impl),
    forall impl. EngineLog impl -> Value
_elDetail :: !J.Value
  }
  deriving stock ((forall x. EngineLog impl -> Rep (EngineLog impl) x)
-> (forall x. Rep (EngineLog impl) x -> EngineLog impl)
-> Generic (EngineLog impl)
forall x. Rep (EngineLog impl) x -> EngineLog impl
forall x. EngineLog impl -> Rep (EngineLog impl) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall impl x. Rep (EngineLog impl) x -> EngineLog impl
forall impl x. EngineLog impl -> Rep (EngineLog impl) x
$cfrom :: forall impl x. EngineLog impl -> Rep (EngineLog impl) x
from :: forall x. EngineLog impl -> Rep (EngineLog impl) x
$cto :: forall impl x. Rep (EngineLog impl) x -> EngineLog impl
to :: forall x. Rep (EngineLog impl) x -> EngineLog impl
Generic)

deriving instance (Show (EngineLogType impl)) => Show (EngineLog impl)

deriving instance (Eq (EngineLogType impl)) => Eq (EngineLog impl)

instance (J.ToJSON (EngineLogType impl)) => J.ToJSON (EngineLog impl) where
  toJSON :: EngineLog impl -> Value
toJSON = Options -> EngineLog impl -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON

-- | Typeclass representing any data type that can be converted to @EngineLog@ for the purpose of
-- logging
class (EnabledLogTypes impl) => ToEngineLog a impl where
  toEngineLog :: a -> (LogLevel, EngineLogType impl, J.Value)

data UnstructuredLog = UnstructuredLog {UnstructuredLog -> LogLevel
_ulLevel :: !LogLevel, UnstructuredLog -> SerializableBlob
_ulPayload :: !SB.SerializableBlob}
  deriving (Int -> UnstructuredLog -> ShowS
[UnstructuredLog] -> ShowS
UnstructuredLog -> String
(Int -> UnstructuredLog -> ShowS)
-> (UnstructuredLog -> String)
-> ([UnstructuredLog] -> ShowS)
-> Show UnstructuredLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnstructuredLog -> ShowS
showsPrec :: Int -> UnstructuredLog -> ShowS
$cshow :: UnstructuredLog -> String
show :: UnstructuredLog -> String
$cshowList :: [UnstructuredLog] -> ShowS
showList :: [UnstructuredLog] -> ShowS
Show)

debugT :: Text -> UnstructuredLog
debugT :: Text -> UnstructuredLog
debugT = LogLevel -> SerializableBlob -> UnstructuredLog
UnstructuredLog LogLevel
LevelDebug (SerializableBlob -> UnstructuredLog)
-> (Text -> SerializableBlob) -> Text -> UnstructuredLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SerializableBlob
SB.fromText

debugBS :: B.ByteString -> UnstructuredLog
debugBS :: ByteString -> UnstructuredLog
debugBS = LogLevel -> SerializableBlob -> UnstructuredLog
UnstructuredLog LogLevel
LevelDebug (SerializableBlob -> UnstructuredLog)
-> (ByteString -> SerializableBlob)
-> ByteString
-> UnstructuredLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SerializableBlob
SB.fromBS

debugLBS :: BL.ByteString -> UnstructuredLog
debugLBS :: ByteString -> UnstructuredLog
debugLBS = LogLevel -> SerializableBlob -> UnstructuredLog
UnstructuredLog LogLevel
LevelDebug (SerializableBlob -> UnstructuredLog)
-> (ByteString -> SerializableBlob)
-> ByteString
-> UnstructuredLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SerializableBlob
SB.fromLBS

instance ToEngineLog UnstructuredLog Hasura where
  toEngineLog :: UnstructuredLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog (UnstructuredLog LogLevel
level SerializableBlob
t) =
    (LogLevel
level, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTUnstructured, SerializableBlob -> Value
forall a. ToJSON a => a -> Value
J.toJSON SerializableBlob
t)

data LoggerCtx impl = LoggerCtx
  { forall impl. LoggerCtx impl -> LoggerSet
_lcLoggerSet :: !FL.LoggerSet,
    forall impl. LoggerCtx impl -> LogLevel
_lcLogLevel :: !LogLevel,
    forall impl. LoggerCtx impl -> IO FormattedTime
_lcTimeGetter :: !(IO FormattedTime),
    forall impl. LoggerCtx impl -> HashSet (EngineLogType impl)
_lcEnabledLogTypes :: !(Set.HashSet (EngineLogType impl))
  }

-- * 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
-> (LogLevel, EngineLogType Hasura, Value)
toEngineLog (UnhandledInternalErrorLog (ErrorCallWithLocation String
err String
loc)) =
    ( LogLevel
LevelError,
      InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTUnhandledInternalError,
      [Pair] -> Value
J.object [(Key
"error", String -> Value
forall a. IsString a => String -> a
fromString String
err), (Key
"location", String -> Value
forall a. IsString a => String -> a
fromString String
loc)]
    )

-- * LoggerSettings

data LoggerSettings = LoggerSettings
  { -- | should current time be cached (refreshed every sec)
    LoggerSettings -> Bool
_lsCachedTimestamp :: !Bool,
    LoggerSettings -> Maybe TimeZone
_lsTimeZone :: !(Maybe Time.TimeZone),
    LoggerSettings -> LogLevel
_lsLevel :: !LogLevel
  }
  deriving (Int -> LoggerSettings -> ShowS
[LoggerSettings] -> ShowS
LoggerSettings -> String
(Int -> LoggerSettings -> ShowS)
-> (LoggerSettings -> String)
-> ([LoggerSettings] -> ShowS)
-> Show LoggerSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoggerSettings -> ShowS
showsPrec :: Int -> LoggerSettings -> ShowS
$cshow :: LoggerSettings -> String
show :: LoggerSettings -> String
$cshowList :: [LoggerSettings] -> ShowS
showList :: [LoggerSettings] -> ShowS
Show, LoggerSettings -> LoggerSettings -> Bool
(LoggerSettings -> LoggerSettings -> Bool)
-> (LoggerSettings -> LoggerSettings -> Bool) -> Eq LoggerSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoggerSettings -> LoggerSettings -> Bool
== :: LoggerSettings -> LoggerSettings -> Bool
$c/= :: LoggerSettings -> LoggerSettings -> Bool
/= :: LoggerSettings -> LoggerSettings -> Bool
Eq)

defaultLoggerSettings :: Bool -> LogLevel -> LoggerSettings
defaultLoggerSettings :: Bool -> LogLevel -> LoggerSettings
defaultLoggerSettings Bool
isCached =
  Bool -> Maybe TimeZone -> LogLevel -> LoggerSettings
LoggerSettings Bool
isCached Maybe TimeZone
forall a. Maybe a
Nothing

getFormattedTime :: Maybe Time.TimeZone -> IO FormattedTime
getFormattedTime :: Maybe TimeZone -> IO FormattedTime
getFormattedTime Maybe TimeZone
tzM = do
  TimeZone
tz <- Maybe TimeZone -> IO TimeZone -> IO TimeZone
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe TimeZone
tzM IO TimeZone
Time.getCurrentTimeZone
  UTCTime
t <- IO UTCTime
Time.getCurrentTime
  let zt :: ZonedTime
zt = TimeZone -> UTCTime -> ZonedTime
Time.utcToZonedTime TimeZone
tz UTCTime
t
  FormattedTime -> IO FormattedTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FormattedTime -> IO FormattedTime)
-> FormattedTime -> IO FormattedTime
forall a b. (a -> b) -> a -> b
$ Text -> FormattedTime
FormattedTime (Text -> FormattedTime) -> Text -> FormattedTime
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ZonedTime -> String
formatTime ZonedTime
zt
  where
    formatTime :: ZonedTime -> String
formatTime = TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Format.formatTime TimeLocale
Format.defaultTimeLocale String
format
    format :: String
format = String
"%FT%H:%M:%S%3Q%z"

-- format = Format.iso8601DateFormat (Just "%H:%M:%S")

-- | 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.
mkLoggerCtx ::
  (MonadIO io, MonadBaseControl IO io) =>
  LoggerSettings ->
  Set.HashSet (EngineLogType impl) ->
  ManagedT io (LoggerCtx impl)
mkLoggerCtx :: forall (io :: * -> *) impl.
(MonadIO io, MonadBaseControl IO io) =>
LoggerSettings
-> HashSet (EngineLogType impl) -> ManagedT io (LoggerCtx impl)
mkLoggerCtx (LoggerSettings Bool
cacheTime Maybe TimeZone
tzM LogLevel
logLevel) HashSet (EngineLogType impl)
enabledLogs = do
  LoggerSet
loggerSet <- io LoggerSet -> (LoggerSet -> io ()) -> ManagedT io LoggerSet
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (a -> m b) -> ManagedT m a
allocate io LoggerSet
acquire LoggerSet -> io ()
forall {m :: * -> *}. MonadIO m => LoggerSet -> m ()
release
  IO FormattedTime
timeGetter <- IO (IO FormattedTime) -> ManagedT io (IO FormattedTime)
forall a. IO a -> ManagedT io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO FormattedTime) -> ManagedT io (IO FormattedTime))
-> IO (IO FormattedTime) -> ManagedT io (IO FormattedTime)
forall a b. (a -> b) -> a -> b
$ IO (IO FormattedTime)
-> IO (IO FormattedTime) -> Bool -> IO (IO FormattedTime)
forall a. a -> a -> Bool -> a
bool (IO FormattedTime -> IO (IO FormattedTime)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO FormattedTime -> IO (IO FormattedTime))
-> IO FormattedTime -> IO (IO FormattedTime)
forall a b. (a -> b) -> a -> b
$ Maybe TimeZone -> IO FormattedTime
getFormattedTime Maybe TimeZone
tzM) IO (IO FormattedTime)
cachedTimeGetter Bool
cacheTime
  LoggerCtx impl -> ManagedT io (LoggerCtx impl)
forall a. a -> ManagedT io a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoggerCtx impl -> ManagedT io (LoggerCtx impl))
-> LoggerCtx impl -> ManagedT io (LoggerCtx impl)
forall a b. (a -> b) -> a -> b
$ LoggerSet
-> LogLevel
-> IO FormattedTime
-> HashSet (EngineLogType impl)
-> LoggerCtx impl
forall impl.
LoggerSet
-> LogLevel
-> IO FormattedTime
-> HashSet (EngineLogType impl)
-> LoggerCtx impl
LoggerCtx LoggerSet
loggerSet LogLevel
logLevel IO FormattedTime
timeGetter HashSet (EngineLogType impl)
enabledLogs
  where
    acquire :: io LoggerSet
acquire = IO LoggerSet -> io LoggerSet
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      Int -> IO LoggerSet
FL.newStdoutLoggerSet Int
FL.defaultBufSize
    release :: LoggerSet -> m ()
release LoggerSet
loggerSet = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      LoggerSet -> IO ()
FL.flushLogStr LoggerSet
loggerSet
      LoggerSet -> IO ()
FL.rmLoggerSet LoggerSet
loggerSet
    cachedTimeGetter :: IO (IO FormattedTime)
cachedTimeGetter =
      UpdateSettings FormattedTime -> IO (IO FormattedTime)
forall a. UpdateSettings a -> IO (IO a)
Auto.mkAutoUpdate
        UpdateSettings ()
Auto.defaultUpdateSettings
          { updateAction :: IO FormattedTime
Auto.updateAction = Maybe TimeZone -> IO FormattedTime
getFormattedTime Maybe TimeZone
tzM
          }

cleanLoggerCtx :: LoggerCtx a -> IO ()
cleanLoggerCtx :: forall a. LoggerCtx a -> IO ()
cleanLoggerCtx =
  LoggerSet -> IO ()
FL.rmLoggerSet (LoggerSet -> IO ())
-> (LoggerCtx a -> LoggerSet) -> LoggerCtx a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerCtx a -> LoggerSet
forall impl. LoggerCtx impl -> LoggerSet
_lcLoggerSet

-- See Note [Existentially Quantified Types]
newtype Logger impl = Logger {forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger :: forall a m. (ToEngineLog a impl, MonadIO m) => a -> m ()}

mkLogger :: (J.ToJSON (EngineLogType impl)) => LoggerCtx impl -> Logger impl
mkLogger :: forall impl.
ToJSON (EngineLogType impl) =>
LoggerCtx impl -> Logger impl
mkLogger (LoggerCtx LoggerSet
loggerSet LogLevel
serverLogLevel IO FormattedTime
timeGetter HashSet (EngineLogType impl)
enabledLogTypes) = (forall a (m :: * -> *).
 (ToEngineLog a impl, MonadIO m) =>
 a -> m ())
-> Logger impl
forall impl.
(forall a (m :: * -> *).
 (ToEngineLog a impl, MonadIO m) =>
 a -> m ())
-> Logger impl
Logger ((forall a (m :: * -> *).
  (ToEngineLog a impl, MonadIO m) =>
  a -> m ())
 -> Logger impl)
-> (forall a (m :: * -> *).
    (ToEngineLog a impl, MonadIO m) =>
    a -> m ())
-> Logger impl
forall a b. (a -> b) -> a -> b
$ \a
l -> do
  FormattedTime
localTime <- IO FormattedTime -> m FormattedTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FormattedTime
timeGetter
  let (LogLevel
logLevel, EngineLogType impl
logTy, Value
logDet) = a -> (LogLevel, EngineLogType impl, Value)
forall a impl.
ToEngineLog a impl =>
a -> (LogLevel, EngineLogType impl, Value)
toEngineLog a
l
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel
logLevel LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
serverLogLevel Bool -> Bool -> Bool
&& HashSet (EngineLogType impl) -> EngineLogType impl -> Bool
forall impl.
EnabledLogTypes impl =>
HashSet (EngineLogType impl) -> EngineLogType impl -> Bool
isLogTypeEnabled HashSet (EngineLogType impl)
enabledLogTypes EngineLogType impl
logTy)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LoggerSet -> LogStr -> IO ()
FL.pushLogStrLn LoggerSet
loggerSet
    (LogStr -> IO ()) -> LogStr -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
FL.toLogStr (EngineLog impl -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode (EngineLog impl -> ByteString) -> EngineLog impl -> ByteString
forall a b. (a -> b) -> a -> b
$ FormattedTime
-> LogLevel -> EngineLogType impl -> Value -> EngineLog impl
forall impl.
FormattedTime
-> LogLevel -> EngineLogType impl -> Value -> EngineLog impl
EngineLog FormattedTime
localTime LogLevel
logLevel EngineLogType impl
logTy Value
logDet)

nullLogger :: Logger Hasura
nullLogger :: Logger Hasura
nullLogger = (forall a (m :: * -> *).
 (ToEngineLog a Hasura, MonadIO m) =>
 a -> m ())
-> Logger Hasura
forall impl.
(forall a (m :: * -> *).
 (ToEngineLog a impl, MonadIO m) =>
 a -> m ())
-> Logger impl
Logger \a
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

eventTriggerLogType :: EngineLogType Hasura
eventTriggerLogType :: EngineLogType Hasura
eventTriggerLogType = InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTEventTrigger

eventTriggerProcessLogType :: EngineLogType Hasura
eventTriggerProcessLogType :: EngineLogType Hasura
eventTriggerProcessLogType = InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTEventTriggerProcess

scheduledTriggerLogType :: EngineLogType Hasura
scheduledTriggerLogType :: EngineLogType Hasura
scheduledTriggerLogType = InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTScheduledTrigger

scheduledTriggerProcessLogType :: EngineLogType Hasura
scheduledTriggerProcessLogType :: EngineLogType Hasura
scheduledTriggerProcessLogType = InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTScheduledTriggerProcess

cronEventGeneratorProcessType :: EngineLogType Hasura
cronEventGeneratorProcessType :: EngineLogType Hasura
cronEventGeneratorProcessType = InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTCronEventGeneratorProcess

sourceCatalogMigrationLogType :: EngineLogType Hasura
sourceCatalogMigrationLogType :: EngineLogType Hasura
sourceCatalogMigrationLogType = InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTSourceCatalogMigration

-- | Emit when stored introspection is used
data StoredIntrospectionLog = StoredIntrospectionLog
  { StoredIntrospectionLog -> Text
silMessage :: Text,
    -- | upstream data source errors
    StoredIntrospectionLog -> QErr
silSourceError :: QErr
  }
  deriving stock ((forall x. StoredIntrospectionLog -> Rep StoredIntrospectionLog x)
-> (forall x.
    Rep StoredIntrospectionLog x -> StoredIntrospectionLog)
-> Generic StoredIntrospectionLog
forall x. Rep StoredIntrospectionLog x -> StoredIntrospectionLog
forall x. StoredIntrospectionLog -> Rep StoredIntrospectionLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoredIntrospectionLog -> Rep StoredIntrospectionLog x
from :: forall x. StoredIntrospectionLog -> Rep StoredIntrospectionLog x
$cto :: forall x. Rep StoredIntrospectionLog x -> StoredIntrospectionLog
to :: forall x. Rep StoredIntrospectionLog x -> StoredIntrospectionLog
Generic)

instance J.ToJSON StoredIntrospectionLog where
  toJSON :: StoredIntrospectionLog -> Value
toJSON = Options -> StoredIntrospectionLog -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON

instance ToEngineLog StoredIntrospectionLog Hasura where
  toEngineLog :: StoredIntrospectionLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog StoredIntrospectionLog
siLog =
    (LogLevel
LevelInfo, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTStoredIntrospection, StoredIntrospectionLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON StoredIntrospectionLog
siLog)

-- | Logs related to errors while interacting with the stored introspection
-- storage
data StoredIntrospectionStorageLog = StoredIntrospectionStorageLog
  { StoredIntrospectionStorageLog -> Text
sislMessage :: Text,
    StoredIntrospectionStorageLog -> QErr
sislError :: QErr
  }
  deriving stock ((forall x.
 StoredIntrospectionStorageLog
 -> Rep StoredIntrospectionStorageLog x)
-> (forall x.
    Rep StoredIntrospectionStorageLog x
    -> StoredIntrospectionStorageLog)
-> Generic StoredIntrospectionStorageLog
forall x.
Rep StoredIntrospectionStorageLog x
-> StoredIntrospectionStorageLog
forall x.
StoredIntrospectionStorageLog
-> Rep StoredIntrospectionStorageLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
StoredIntrospectionStorageLog
-> Rep StoredIntrospectionStorageLog x
from :: forall x.
StoredIntrospectionStorageLog
-> Rep StoredIntrospectionStorageLog x
$cto :: forall x.
Rep StoredIntrospectionStorageLog x
-> StoredIntrospectionStorageLog
to :: forall x.
Rep StoredIntrospectionStorageLog x
-> StoredIntrospectionStorageLog
Generic)

instance J.ToJSON StoredIntrospectionStorageLog where
  toJSON :: StoredIntrospectionStorageLog -> Value
toJSON = Options -> StoredIntrospectionStorageLog -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON

instance ToEngineLog StoredIntrospectionStorageLog Hasura where
  toEngineLog :: StoredIntrospectionStorageLog
-> (LogLevel, EngineLogType Hasura, Value)
toEngineLog StoredIntrospectionStorageLog
sisLog =
    (LogLevel
LevelInfo, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTStoredIntrospectionStorage, StoredIntrospectionStorageLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON StoredIntrospectionStorageLog
sisLog)

-- | 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.
createStatsLogger ::
  forall m stats impl.
  ( MonadIO m,
    ToEngineLog stats impl,
    Monoid stats
  ) =>
  Logger impl ->
  m (FDebounce.Trigger stats stats)
createStatsLogger :: forall (m :: * -> *) stats impl.
(MonadIO m, ToEngineLog stats impl, Monoid stats) =>
Logger impl -> m (Trigger stats stats)
createStatsLogger Logger impl
hasuraLogger =
  IO (Trigger stats stats) -> m (Trigger stats stats)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Trigger stats stats) -> m (Trigger stats stats))
-> IO (Trigger stats stats) -> m (Trigger stats stats)
forall a b. (a -> b) -> a -> b
$ Args stats stats -> Opts stats stats -> IO (Trigger stats stats)
forall i o. Args i o -> Opts i o -> IO (Trigger i o)
FDebounce.new Args stats stats
debounceArgs Opts stats stats
debounceOpts
  where
    logDelay :: Int
    logDelay :: Int
logDelay =
      -- Accumulate stats occurred within 10 minutes and log once.
      Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000_000 -- 10 minutes
    debounceArgs :: FDebounce.Args stats stats
    debounceArgs :: Args stats stats
debounceArgs =
      FDebounce.Args
        { cb :: stats -> IO ()
FDebounce.cb = Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger Logger impl
hasuraLogger, -- Log using the Hasura logger
          fold :: stats -> stats -> stats
FDebounce.fold = stats -> stats -> stats
forall a. Semigroup a => a -> a -> a
(<>),
          init :: stats
FDebounce.init = stats
forall a. Monoid a => a
mempty
        }

    debounceOpts :: FDebounce.Opts stats stats
    debounceOpts :: Opts stats stats
debounceOpts = Opts Any Any
forall a. Default a => a
FDebounce.def {delay :: Int
FDebounce.delay = Int
logDelay}

-- Orphan instance. Required for @'closeStatsLogger'.
instance (EnabledLogTypes impl) => ToEngineLog (FDebounce.OpException, EngineLogType impl) impl where
  toEngineLog :: (OpException, EngineLogType impl)
-> (LogLevel, EngineLogType impl, Value)
toEngineLog (OpException
opException, EngineLogType impl
logType) =
    let errorMessage :: Text
        errorMessage :: Text
errorMessage = case OpException
opException of
          OpException
FDebounce.AlreadyClosedException -> Text
"already closed"
          FDebounce.UnexpectedClosedException SomeException
_someException -> Text
"closed unexpectedly"
     in (LogLevel
LevelWarn, EngineLogType impl
logType, [Pair] -> Value
J.object [Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (Text
"cannot close fetched events stats logger: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 :: forall (m :: * -> *) impl stats.
(MonadIO m, EnabledLogTypes impl) =>
EngineLogType impl -> Logger impl -> Trigger stats stats -> m ()
closeStatsLogger EngineLogType impl
logType (Logger forall a (m :: * -> *).
(ToEngineLog a impl, MonadIO m) =>
a -> m ()
hasuraLogger) Trigger stats stats
debounceLogger =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> (OpException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Trigger stats stats -> IO ()
forall i o. Trigger i o -> IO ()
FDebounce.close Trigger stats stats
debounceLogger) ((OpException -> IO ()) -> IO ())
-> (OpException -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(OpException
e :: FDebounce.OpException) -> (OpException, EngineLogType impl) -> IO ()
forall a (m :: * -> *).
(ToEngineLog a impl, MonadIO m) =>
a -> m ()
hasuraLogger (OpException
e, EngineLogType impl
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 :: forall (m :: * -> *) stats.
MonadIO m =>
Trigger stats stats -> stats -> m ()
logStats Trigger stats stats
debounceTrigger = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (stats -> IO ()) -> stats -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trigger stats stats -> stats -> IO ()
forall i o. Trigger i o -> i -> IO ()
FDebounce.send Trigger stats stats
debounceTrigger