{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

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

import Control.AutoUpdate qualified as Auto
import Control.Monad.Trans.Control
import Control.Monad.Trans.Managed (ManagedT (..), allocate)
import Data.Aeson qualified as J
import Data.Aeson.TH 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.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.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
showList :: [FormattedTime] -> ShowS
$cshowList :: [FormattedTime] -> ShowS
show :: FormattedTime -> String
$cshow :: FormattedTime -> String
showsPrec :: Int -> FormattedTime -> ShowS
$cshowsPrec :: Int -> FormattedTime -> ShowS
Show, FormattedTime -> FormattedTime -> Bool
(FormattedTime -> FormattedTime -> Bool)
-> (FormattedTime -> FormattedTime -> Bool) -> Eq FormattedTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattedTime -> FormattedTime -> Bool
$c/= :: FormattedTime -> FormattedTime -> Bool
== :: FormattedTime -> FormattedTime -> Bool
$c== :: 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
toEncodingList :: [FormattedTime] -> Encoding
$ctoEncodingList :: [FormattedTime] -> Encoding
toJSONList :: [FormattedTime] -> Value
$ctoJSONList :: [FormattedTime] -> Value
toEncoding :: FormattedTime -> Encoding
$ctoEncoding :: FormattedTime -> Encoding
toJSON :: FormattedTime -> Value
$ctoJSON :: FormattedTime -> Value
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
  | ELTStartup
  | ELTLivequeryPollerLog
  | ELTActionHandler
  | ELTDataConnectorLog
  | -- 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
showList :: [EngineLogType Hasura] -> ShowS
$cshowList :: [EngineLogType Hasura] -> ShowS
show :: EngineLogType Hasura -> String
$cshow :: EngineLogType Hasura -> String
showsPrec :: Int -> EngineLogType Hasura -> ShowS
$cshowsPrec :: Int -> 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
/= :: EngineLogType Hasura -> EngineLogType Hasura -> Bool
$c/= :: EngineLogType Hasura -> EngineLogType Hasura -> Bool
== :: EngineLogType Hasura -> EngineLogType Hasura -> Bool
$c== :: 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
$cto :: forall x. Rep (EngineLogType Hasura) x -> EngineLogType Hasura
$cfrom :: forall x. EngineLogType Hasura -> Rep (EngineLogType Hasura) x
Generic)

instance Hashable (EngineLogType Hasura)

instance Witch.From (EngineLogType Hasura) Text where
  from :: EngineLogType Hasura -> Text
from = \case
    EngineLogType Hasura
ELTHttpLog -> Text
"http-log"
    EngineLogType Hasura
ELTWebsocketLog -> Text
"websocket-log"
    EngineLogType Hasura
ELTWebhookLog -> Text
"webhook-log"
    EngineLogType Hasura
ELTQueryLog -> Text
"query-log"
    EngineLogType Hasura
ELTStartup -> Text
"startup"
    EngineLogType Hasura
ELTLivequeryPollerLog -> Text
"livequery-poller-log"
    EngineLogType Hasura
ELTActionHandler -> Text
"action-handler-log"
    EngineLogType Hasura
ELTDataConnectorLog -> Text
"data-connector-log"
    ELTInternal 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 source. From source Text => source -> Text
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 -> (EngineLogType Hasura -> Text
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 (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
  | ILTEventTrigger
  | ILTScheduledTrigger
  | -- | internal logs for the websocket server
    ILTWsServer
  | ILTPgClient
  | -- | log type for logging metadata related actions; currently used in logging inconsistent metadata
    ILTMetadata
  | ILTJwkRefreshLog
  | ILTTelemetry
  | ILTSchemaSyncThread
  | ILTSourceCatalogMigration
  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
showList :: [InternalLogTypes] -> ShowS
$cshowList :: [InternalLogTypes] -> ShowS
show :: InternalLogTypes -> String
$cshow :: InternalLogTypes -> String
showsPrec :: Int -> InternalLogTypes -> ShowS
$cshowsPrec :: Int -> InternalLogTypes -> ShowS
Show, InternalLogTypes -> InternalLogTypes -> Bool
(InternalLogTypes -> InternalLogTypes -> Bool)
-> (InternalLogTypes -> InternalLogTypes -> Bool)
-> Eq InternalLogTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalLogTypes -> InternalLogTypes -> Bool
$c/= :: InternalLogTypes -> InternalLogTypes -> Bool
== :: InternalLogTypes -> InternalLogTypes -> Bool
$c== :: 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
$cto :: forall x. Rep InternalLogTypes x -> InternalLogTypes
$cfrom :: forall x. InternalLogTypes -> Rep InternalLogTypes x
Generic)

instance Hashable InternalLogTypes

instance Witch.From InternalLogTypes Text where
  from :: InternalLogTypes -> Text
from = \case
    InternalLogTypes
ILTUnstructured -> Text
"unstructured"
    InternalLogTypes
ILTEventTrigger -> Text
"event-trigger"
    InternalLogTypes
ILTScheduledTrigger -> Text
"scheduled-trigger"
    InternalLogTypes
ILTWsServer -> Text
"ws-server"
    InternalLogTypes
ILTPgClient -> Text
"pg-client"
    InternalLogTypes
ILTMetadata -> Text
"metadata"
    InternalLogTypes
ILTJwkRefreshLog -> Text
"jwk-refresh-log"
    InternalLogTypes
ILTTelemetry -> Text
"telemetry-log"
    InternalLogTypes
ILTSchemaSyncThread -> Text
"schema-sync-thread"
    InternalLogTypes
ILTSourceCatalogMigration -> Text
"source-catalog-migration"

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 source. From source Text => source -> Text
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]

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 _ -> 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)
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
. 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
ELTLivequeryPollerLog,
    EngineLogType Hasura
ELTActionHandler,
    EngineLogType Hasura
ELTDataConnectorLog
  ]

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
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: 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
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$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
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq 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
  { EngineLog impl -> FormattedTime
_elTimestamp :: !FormattedTime,
    EngineLog impl -> LogLevel
_elLevel :: !LogLevel,
    EngineLog impl -> EngineLogType impl
_elType :: !(EngineLogType impl),
    EngineLog impl -> Value
_elDetail :: !J.Value
  }

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

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

-- Empty splice to bring all the above definitions in scope.
--
-- TODO: Restructure the code so that we can avoid this.
$(pure [])

instance J.ToJSON (EngineLogType impl) => J.ToJSON (EngineLog impl) where
  toJSON :: EngineLog impl -> Value
toJSON = $(J.mkToJSON hasuraJSON ''EngineLog)

-- | 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
showList :: [UnstructuredLog] -> ShowS
$cshowList :: [UnstructuredLog] -> ShowS
show :: UnstructuredLog -> String
$cshow :: UnstructuredLog -> String
showsPrec :: Int -> UnstructuredLog -> ShowS
$cshowsPrec :: Int -> 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
  { LoggerCtx impl -> LoggerSet
_lcLoggerSet :: !FL.LoggerSet,
    LoggerCtx impl -> LogLevel
_lcLogLevel :: !LogLevel,
    LoggerCtx impl -> IO FormattedTime
_lcTimeGetter :: !(IO FormattedTime),
    LoggerCtx impl -> HashSet (EngineLogType impl)
_lcEnabledLogTypes :: !(Set.HashSet (EngineLogType impl))
  }

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
showList :: [LoggerSettings] -> ShowS
$cshowList :: [LoggerSettings] -> ShowS
show :: LoggerSettings -> String
$cshow :: LoggerSettings -> String
showsPrec :: Int -> LoggerSettings -> ShowS
$cshowsPrec :: Int -> LoggerSettings -> ShowS
Show, LoggerSettings -> LoggerSettings -> Bool
(LoggerSettings -> LoggerSettings -> Bool)
-> (LoggerSettings -> LoggerSettings -> Bool) -> Eq LoggerSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoggerSettings -> LoggerSettings -> Bool
$c/= :: LoggerSettings -> LoggerSettings -> Bool
== :: LoggerSettings -> LoggerSettings -> Bool
$c== :: 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 (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")

mkLoggerCtx ::
  (MonadIO io, MonadBaseControl IO io) =>
  LoggerSettings ->
  Set.HashSet (EngineLogType impl) ->
  ManagedT io (LoggerCtx impl)
mkLoggerCtx :: 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 -> io LoggerSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LoggerSet -> io LoggerSet) -> IO LoggerSet -> io LoggerSet
forall a b. (a -> b) -> a -> b
$ Int -> IO LoggerSet
FL.newStdoutLoggerSet Int
FL.defaultBufSize)
      (IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> (LoggerSet -> IO ()) -> LoggerSet -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerSet -> IO ()
FL.rmLoggerSet)
  IO FormattedTime
timeGetter <- IO (IO FormattedTime) -> ManagedT io (IO FormattedTime)
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 (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) a. Monad m => a -> m a
return (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
    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 :: 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 {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 :: 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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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