{-# LANGUAGE TemplateHaskell #-}
module Hasura.Server.Logging
( StartupLog (..),
PGLog (..),
RequestMode (..),
mkInconsMetadataLog,
mkHttpAccessLogContext,
mkHttpErrorLogContext,
mkHttpLog,
HttpInfoLog (..),
OperationLog (..),
HttpLogContext (..),
WebHookLog (..),
HttpException,
HttpLog (..),
GQLBatchQueryOperationLog (..),
GQLQueryOperationSuccessLog (..),
GQLQueryOperationErrorLog (..),
MetadataLog (..),
EnvVarsMovedToMetadata (..),
DeprecatedEnvVars (..),
logDeprecatedEnvVars,
CommonHttpLogMetadata (..),
HttpLogMetadata,
buildHttpLogMetadata,
emptyHttpLogMetadata,
MetadataQueryLoggingMode (..),
LoggingSettings (..),
)
where
import Data.Aeson
import Data.Aeson.TH
import Data.ByteString.Lazy qualified as BL
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as Set
import Data.Int (Int64)
import Data.List.NonEmpty qualified as NE
import Data.SerializableBlob qualified as SB
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.GraphQL.Transport.HTTP.Protocol qualified as GH
import Hasura.HTTP
import Hasura.Logging
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Source
import Hasura.Server.Compression
import Hasura.Server.Types
import Hasura.Server.Utils
( DeprecatedEnvVars (..),
EnvVarsMovedToMetadata (..),
deprecatedEnvVars,
envVarsMovedToMetadata,
)
import Hasura.Session
import Hasura.Tracing (TraceT)
import Network.HTTP.Types qualified as HTTP
import Network.Wai.Extended qualified as Wai
data StartupLog = StartupLog
{ StartupLog -> LogLevel
slLogLevel :: !LogLevel,
StartupLog -> Text
slKind :: !Text,
StartupLog -> Value
slInfo :: !Value
}
deriving (StartupLog -> StartupLog -> Bool
(StartupLog -> StartupLog -> Bool)
-> (StartupLog -> StartupLog -> Bool) -> Eq StartupLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartupLog -> StartupLog -> Bool
$c/= :: StartupLog -> StartupLog -> Bool
== :: StartupLog -> StartupLog -> Bool
$c== :: StartupLog -> StartupLog -> Bool
Eq)
instance ToJSON StartupLog where
toJSON :: StartupLog -> Value
toJSON (StartupLog LogLevel
_ Text
k Value
info) =
[Pair] -> Value
object
[ Key
"kind" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
k,
Key
"info" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
info
]
instance ToEngineLog StartupLog Hasura where
toEngineLog :: StartupLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog StartupLog
startupLog =
(StartupLog -> LogLevel
slLogLevel StartupLog
startupLog, EngineLogType Hasura
ELTStartup, StartupLog -> Value
forall a. ToJSON a => a -> Value
toJSON StartupLog
startupLog)
data PGLog = PGLog
{ PGLog -> LogLevel
plLogLevel :: !LogLevel,
PGLog -> Text
plMessage :: !Text
}
deriving (PGLog -> PGLog -> Bool
(PGLog -> PGLog -> Bool) -> (PGLog -> PGLog -> Bool) -> Eq PGLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PGLog -> PGLog -> Bool
$c/= :: PGLog -> PGLog -> Bool
== :: PGLog -> PGLog -> Bool
$c== :: PGLog -> PGLog -> Bool
Eq)
instance ToJSON PGLog where
toJSON :: PGLog -> Value
toJSON (PGLog LogLevel
_ Text
msg) =
[Pair] -> Value
object [Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg]
instance ToEngineLog PGLog Hasura where
toEngineLog :: PGLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog PGLog
pgLog =
(PGLog -> LogLevel
plLogLevel PGLog
pgLog, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTPgClient, PGLog -> Value
forall a. ToJSON a => a -> Value
toJSON PGLog
pgLog)
data MetadataLog = MetadataLog
{ MetadataLog -> LogLevel
mlLogLevel :: !LogLevel,
MetadataLog -> Text
mlMessage :: !Text,
MetadataLog -> Value
mlInfo :: !Value
}
deriving (MetadataLog -> MetadataLog -> Bool
(MetadataLog -> MetadataLog -> Bool)
-> (MetadataLog -> MetadataLog -> Bool) -> Eq MetadataLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetadataLog -> MetadataLog -> Bool
$c/= :: MetadataLog -> MetadataLog -> Bool
== :: MetadataLog -> MetadataLog -> Bool
$c== :: MetadataLog -> MetadataLog -> Bool
Eq)
instance ToJSON MetadataLog where
toJSON :: MetadataLog -> Value
toJSON (MetadataLog LogLevel
_ Text
msg Value
infoVal) =
[Pair] -> Value
object
[ Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg,
Key
"info" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
infoVal
]
instance ToEngineLog MetadataLog Hasura where
toEngineLog :: MetadataLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog MetadataLog
ml =
(MetadataLog -> LogLevel
mlLogLevel MetadataLog
ml, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTMetadata, MetadataLog -> Value
forall a. ToJSON a => a -> Value
toJSON MetadataLog
ml)
mkInconsMetadataLog :: [InconsistentMetadata] -> MetadataLog
mkInconsMetadataLog :: [InconsistentMetadata] -> MetadataLog
mkInconsMetadataLog [InconsistentMetadata]
objs =
LogLevel -> Text -> Value -> MetadataLog
MetadataLog LogLevel
LevelWarn Text
"Inconsistent Metadata!" (Value -> MetadataLog) -> Value -> MetadataLog
forall a b. (a -> b) -> a -> b
$
[Pair] -> Value
object [Key
"objects" Key -> [InconsistentMetadata] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [InconsistentMetadata]
objs]
data WebHookLog = WebHookLog
{ WebHookLog -> LogLevel
whlLogLevel :: !LogLevel,
WebHookLog -> Maybe Status
whlStatusCode :: !(Maybe HTTP.Status),
WebHookLog -> Text
whlUrl :: !Text,
WebHookLog -> StdMethod
whlMethod :: !HTTP.StdMethod,
WebHookLog -> Maybe HttpException
whlError :: !(Maybe HttpException),
WebHookLog -> Maybe Text
whlResponse :: !(Maybe Text),
WebHookLog -> Maybe Text
whlMessage :: !(Maybe Text)
}
instance ToEngineLog WebHookLog Hasura where
toEngineLog :: WebHookLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog WebHookLog
webHookLog =
(WebHookLog -> LogLevel
whlLogLevel WebHookLog
webHookLog, EngineLogType Hasura
ELTWebhookLog, WebHookLog -> Value
forall a. ToJSON a => a -> Value
toJSON WebHookLog
webHookLog)
instance ToJSON WebHookLog where
toJSON :: WebHookLog -> Value
toJSON WebHookLog
whl =
[Pair] -> Value
object
[ Key
"status_code" Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Status -> Int
HTTP.statusCode (Status -> Int) -> Maybe Status -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebHookLog -> Maybe Status
whlStatusCode WebHookLog
whl),
Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebHookLog -> Text
whlUrl WebHookLog
whl,
Key
"method" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StdMethod -> String
forall a. Show a => a -> String
show (WebHookLog -> StdMethod
whlMethod WebHookLog
whl),
Key
"http_error" Key -> Maybe HttpException -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebHookLog -> Maybe HttpException
whlError WebHookLog
whl,
Key
"response" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebHookLog -> Maybe Text
whlResponse WebHookLog
whl,
Key
"message" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebHookLog -> Maybe Text
whlMessage WebHookLog
whl
]
data GQLQueryOperationSuccessLog = GQLQueryOperationSuccessLog
{ GQLQueryOperationSuccessLog -> GQLReqUnparsed
gqolQuery :: !GH.GQLReqUnparsed,
GQLQueryOperationSuccessLog -> DiffTime
gqolQueryExecutionTime :: !DiffTime,
GQLQueryOperationSuccessLog -> Int64
gqolResponseSize :: !Int64,
GQLQueryOperationSuccessLog -> Int64
gqolRequestSize :: !Int64,
GQLQueryOperationSuccessLog -> ParameterizedQueryHash
gqolParameterizedQueryHash :: !ParameterizedQueryHash
}
deriving (GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
(GQLQueryOperationSuccessLog
-> GQLQueryOperationSuccessLog -> Bool)
-> (GQLQueryOperationSuccessLog
-> GQLQueryOperationSuccessLog -> Bool)
-> Eq GQLQueryOperationSuccessLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
$c/= :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
== :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
$c== :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
Eq)
$(deriveToJSON hasuraJSON {omitNothingFields = True} ''GQLQueryOperationSuccessLog)
data GQLQueryOperationErrorLog = GQLQueryOperationErrorLog
{ GQLQueryOperationErrorLog -> GQLReqUnparsed
gqelQuery :: !GH.GQLReqUnparsed,
GQLQueryOperationErrorLog -> QErr
gqelError :: !QErr
}
deriving (GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
(GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool)
-> (GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool)
-> Eq GQLQueryOperationErrorLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
$c/= :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
== :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
$c== :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
Eq)
$(deriveToJSON hasuraJSON ''GQLQueryOperationErrorLog)
data GQLBatchQueryOperationLog
= GQLQueryOperationSuccess !GQLQueryOperationSuccessLog
| GQLQueryOperationError !GQLQueryOperationErrorLog
deriving (GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
(GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool)
-> (GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool)
-> Eq GQLBatchQueryOperationLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
$c/= :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
== :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
$c== :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
Eq)
instance ToJSON GQLBatchQueryOperationLog where
toJSON :: GQLBatchQueryOperationLog -> Value
toJSON = \case
GQLQueryOperationSuccess GQLQueryOperationSuccessLog
successLog -> GQLQueryOperationSuccessLog -> Value
forall a. ToJSON a => a -> Value
toJSON GQLQueryOperationSuccessLog
successLog
GQLQueryOperationError GQLQueryOperationErrorLog
errorLog -> GQLQueryOperationErrorLog -> Value
forall a. ToJSON a => a -> Value
toJSON GQLQueryOperationErrorLog
errorLog
data RequestMode
=
RequestModeBatched
|
RequestModeSingle
|
RequestModeNonBatchable
|
RequestModeError
deriving (RequestMode -> RequestMode -> Bool
(RequestMode -> RequestMode -> Bool)
-> (RequestMode -> RequestMode -> Bool) -> Eq RequestMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestMode -> RequestMode -> Bool
$c/= :: RequestMode -> RequestMode -> Bool
== :: RequestMode -> RequestMode -> Bool
$c== :: RequestMode -> RequestMode -> Bool
Eq)
instance ToJSON RequestMode where
toJSON :: RequestMode -> Value
toJSON = \case
RequestMode
RequestModeBatched -> Value
"batched"
RequestMode
RequestModeSingle -> Value
"single"
RequestMode
RequestModeNonBatchable -> Value
"non-graphql"
RequestMode
RequestModeError -> Value
"error"
data CommonHttpLogMetadata = CommonHttpLogMetadata
{ CommonHttpLogMetadata -> RequestMode
_chlmRequestMode :: !RequestMode,
CommonHttpLogMetadata
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
_chlmBatchOperationLog :: !(Maybe (GH.GQLBatchedReqs GQLBatchQueryOperationLog))
}
deriving (CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
(CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool)
-> (CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool)
-> Eq CommonHttpLogMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
$c/= :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
== :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
$c== :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
Eq)
type HttpLogMetadata m = (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
buildHttpLogMetadata ::
forall m.
HttpLog m =>
ParameterizedQueryHashList ->
RequestMode ->
Maybe (GH.GQLBatchedReqs GQLBatchQueryOperationLog) ->
HttpLogMetadata m
buildHttpLogMetadata :: ParameterizedQueryHashList
-> RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> HttpLogMetadata m
buildHttpLogMetadata ParameterizedQueryHashList
paramQueryHashList RequestMode
requestMode Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
batchQueryOperationLog =
(RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> CommonHttpLogMetadata
CommonHttpLogMetadata RequestMode
requestMode Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
batchQueryOperationLog, ParameterizedQueryHashList -> ExtraHttpLogMetadata m
forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
paramQueryHashList)
emptyHttpLogMetadata :: forall m. HttpLog m => HttpLogMetadata m
emptyHttpLogMetadata :: HttpLogMetadata m
emptyHttpLogMetadata = (RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> CommonHttpLogMetadata
CommonHttpLogMetadata RequestMode
RequestModeNonBatchable Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
forall a. Maybe a
Nothing, HttpLog m => ExtraHttpLogMetadata m
forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m)
data MetadataQueryLoggingMode = MetadataQueryLoggingEnabled | MetadataQueryLoggingDisabled
deriving (Int -> MetadataQueryLoggingMode -> ShowS
[MetadataQueryLoggingMode] -> ShowS
MetadataQueryLoggingMode -> String
(Int -> MetadataQueryLoggingMode -> ShowS)
-> (MetadataQueryLoggingMode -> String)
-> ([MetadataQueryLoggingMode] -> ShowS)
-> Show MetadataQueryLoggingMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetadataQueryLoggingMode] -> ShowS
$cshowList :: [MetadataQueryLoggingMode] -> ShowS
show :: MetadataQueryLoggingMode -> String
$cshow :: MetadataQueryLoggingMode -> String
showsPrec :: Int -> MetadataQueryLoggingMode -> ShowS
$cshowsPrec :: Int -> MetadataQueryLoggingMode -> ShowS
Show, MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
(MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool)
-> (MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool)
-> Eq MetadataQueryLoggingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
$c/= :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
== :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
$c== :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
Eq)
instance FromJSON MetadataQueryLoggingMode where
parseJSON :: Value -> Parser MetadataQueryLoggingMode
parseJSON =
String
-> (Bool -> Parser MetadataQueryLoggingMode)
-> Value
-> Parser MetadataQueryLoggingMode
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
"MetadataQueryLoggingMode" ((Bool -> Parser MetadataQueryLoggingMode)
-> Value -> Parser MetadataQueryLoggingMode)
-> (Bool -> Parser MetadataQueryLoggingMode)
-> Value
-> Parser MetadataQueryLoggingMode
forall a b. (a -> b) -> a -> b
$
MetadataQueryLoggingMode -> Parser MetadataQueryLoggingMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataQueryLoggingMode -> Parser MetadataQueryLoggingMode)
-> (Bool -> MetadataQueryLoggingMode)
-> Bool
-> Parser MetadataQueryLoggingMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataQueryLoggingMode
-> MetadataQueryLoggingMode -> Bool -> MetadataQueryLoggingMode
forall a. a -> a -> Bool -> a
bool MetadataQueryLoggingMode
MetadataQueryLoggingDisabled MetadataQueryLoggingMode
MetadataQueryLoggingEnabled
instance ToJSON MetadataQueryLoggingMode where
toJSON :: MetadataQueryLoggingMode -> Value
toJSON = \case
MetadataQueryLoggingMode
MetadataQueryLoggingEnabled -> Bool -> Value
Bool Bool
True
MetadataQueryLoggingMode
MetadataQueryLoggingDisabled -> Bool -> Value
Bool Bool
False
data LoggingSettings = LoggingSettings
{
LoggingSettings -> HashSet (EngineLogType Hasura)
_lsEnabledLogTypes :: HashSet (EngineLogType Hasura),
LoggingSettings -> MetadataQueryLoggingMode
_lsMetadataQueryLoggingMode :: MetadataQueryLoggingMode
}
deriving (LoggingSettings -> LoggingSettings -> Bool
(LoggingSettings -> LoggingSettings -> Bool)
-> (LoggingSettings -> LoggingSettings -> Bool)
-> Eq LoggingSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoggingSettings -> LoggingSettings -> Bool
$c/= :: LoggingSettings -> LoggingSettings -> Bool
== :: LoggingSettings -> LoggingSettings -> Bool
$c== :: LoggingSettings -> LoggingSettings -> Bool
Eq)
class Monad m => HttpLog m where
type m
:: ExtraHttpLogMetadata m
:: ParameterizedQueryHashList -> ExtraHttpLogMetadata m
logHttpError ::
Logger Hasura ->
LoggingSettings ->
Maybe UserInfo ->
RequestId ->
Wai.Request ->
(BL.ByteString, Maybe Value) ->
QErr ->
[HTTP.Header] ->
m ()
logHttpSuccess ::
Logger Hasura ->
LoggingSettings ->
Maybe UserInfo ->
RequestId ->
Wai.Request ->
(BL.ByteString, Maybe Value) ->
BL.ByteString ->
BL.ByteString ->
Maybe (DiffTime, DiffTime) ->
Maybe CompressionType ->
[HTTP.Header] ->
HttpLogMetadata m ->
m ()
instance HttpLog m => HttpLog (TraceT m) where
type (TraceT m) = ExtraHttpLogMetadata m
buildExtraHttpLogMetadata :: ParameterizedQueryHashList -> ExtraHttpLogMetadata (TraceT m)
buildExtraHttpLogMetadata ParameterizedQueryHashList
a = ParameterizedQueryHashList -> ExtraHttpLogMetadata m
forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
a
emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata (TraceT m)
emptyExtraHttpLogMetadata = HttpLog m => ExtraHttpLogMetadata m
forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m
logHttpError :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> TraceT m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h = m () -> TraceT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TraceT m ()) -> m () -> TraceT m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h
logHttpSuccess :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata (TraceT m)
-> TraceT m ()
logHttpSuccess Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f ByteString
g ByteString
h Maybe (DiffTime, DiffTime)
i Maybe CompressionType
j [Header]
k HttpLogMetadata (TraceT m)
l = m () -> TraceT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TraceT m ()) -> m () -> TraceT m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpSuccess Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f ByteString
g ByteString
h Maybe (DiffTime, DiffTime)
i Maybe CompressionType
j [Header]
k HttpLogMetadata m
HttpLogMetadata (TraceT m)
l
instance HttpLog m => HttpLog (ReaderT r m) where
type (ReaderT r m) = ExtraHttpLogMetadata m
buildExtraHttpLogMetadata :: ParameterizedQueryHashList -> ExtraHttpLogMetadata (ReaderT r m)
buildExtraHttpLogMetadata ParameterizedQueryHashList
a = ParameterizedQueryHashList -> ExtraHttpLogMetadata m
forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
a
emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata (ReaderT r m)
emptyExtraHttpLogMetadata = HttpLog m => ExtraHttpLogMetadata m
forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m
logHttpError :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> ReaderT r m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ()) -> m () -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h
logHttpSuccess :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata (ReaderT r m)
-> ReaderT r m ()
logHttpSuccess Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f ByteString
g ByteString
h Maybe (DiffTime, DiffTime)
i Maybe CompressionType
j [Header]
k HttpLogMetadata (ReaderT r m)
l = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ()) -> m () -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpSuccess Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f ByteString
g ByteString
h Maybe (DiffTime, DiffTime)
i Maybe CompressionType
j [Header]
k HttpLogMetadata m
HttpLogMetadata (ReaderT r m)
l
instance HttpLog m => HttpLog (MetadataStorageT m) where
type (MetadataStorageT m) = ExtraHttpLogMetadata m
buildExtraHttpLogMetadata :: ParameterizedQueryHashList
-> ExtraHttpLogMetadata (MetadataStorageT m)
buildExtraHttpLogMetadata ParameterizedQueryHashList
a = ParameterizedQueryHashList -> ExtraHttpLogMetadata m
forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
a
emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata (MetadataStorageT m)
emptyExtraHttpLogMetadata = HttpLog m => ExtraHttpLogMetadata m
forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m
logHttpError :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> MetadataStorageT m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h = m () -> MetadataStorageT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> MetadataStorageT m ()) -> m () -> MetadataStorageT m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h
logHttpSuccess :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata (MetadataStorageT m)
-> MetadataStorageT m ()
logHttpSuccess Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f ByteString
g ByteString
h Maybe (DiffTime, DiffTime)
i Maybe CompressionType
j [Header]
k HttpLogMetadata (MetadataStorageT m)
l = m () -> MetadataStorageT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> MetadataStorageT m ()) -> m () -> MetadataStorageT m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpSuccess Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f ByteString
g ByteString
h Maybe (DiffTime, DiffTime)
i Maybe CompressionType
j [Header]
k HttpLogMetadata m
HttpLogMetadata (MetadataStorageT m)
l
data HttpInfoLog = HttpInfoLog
{ HttpInfoLog -> Status
hlStatus :: !HTTP.Status,
HttpInfoLog -> Text
hlMethod :: !Text,
HttpInfoLog -> IpAddress
hlSource :: !Wai.IpAddress,
HttpInfoLog -> Text
hlPath :: !Text,
HttpInfoLog -> HttpVersion
hlHttpVersion :: !HTTP.HttpVersion,
HttpInfoLog -> Maybe CompressionType
hlCompression :: !(Maybe CompressionType),
:: ![HTTP.Header]
}
deriving (HttpInfoLog -> HttpInfoLog -> Bool
(HttpInfoLog -> HttpInfoLog -> Bool)
-> (HttpInfoLog -> HttpInfoLog -> Bool) -> Eq HttpInfoLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpInfoLog -> HttpInfoLog -> Bool
$c/= :: HttpInfoLog -> HttpInfoLog -> Bool
== :: HttpInfoLog -> HttpInfoLog -> Bool
$c== :: HttpInfoLog -> HttpInfoLog -> Bool
Eq)
instance ToJSON HttpInfoLog where
toJSON :: HttpInfoLog -> Value
toJSON (HttpInfoLog Status
st Text
met IpAddress
src Text
path HttpVersion
hv Maybe CompressionType
compressTypeM [Header]
_) =
[Pair] -> Value
object
[ Key
"status" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status -> Int
HTTP.statusCode Status
st,
Key
"method" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
met,
Key
"ip" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IpAddress -> Text
Wai.showIPAddress IpAddress
src,
Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
path,
Key
"http_version" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HttpVersion -> String
forall a. Show a => a -> String
show HttpVersion
hv,
Key
"content_encoding" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (CompressionType -> Text
compressionTypeToTxt (CompressionType -> Text) -> Maybe CompressionType -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CompressionType
compressTypeM)
]
data OperationLog = OperationLog
{ OperationLog -> RequestId
olRequestId :: !RequestId,
OperationLog -> Maybe SessionVariables
olUserVars :: !(Maybe SessionVariables),
OperationLog -> Maybe Int64
olResponseSize :: !(Maybe Int64),
OperationLog -> Maybe Seconds
olRequestReadTime :: !(Maybe Seconds),
OperationLog -> Maybe Seconds
olQueryExecutionTime :: !(Maybe Seconds),
OperationLog -> Maybe Value
olQuery :: !(Maybe Value),
OperationLog -> Maybe Text
olRawQuery :: !(Maybe Text),
OperationLog -> Maybe QErr
olError :: !(Maybe QErr),
OperationLog -> RequestMode
olRequestMode :: !RequestMode
}
deriving (OperationLog -> OperationLog -> Bool
(OperationLog -> OperationLog -> Bool)
-> (OperationLog -> OperationLog -> Bool) -> Eq OperationLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationLog -> OperationLog -> Bool
$c/= :: OperationLog -> OperationLog -> Bool
== :: OperationLog -> OperationLog -> Bool
$c== :: OperationLog -> OperationLog -> Bool
Eq)
$(deriveToJSON hasuraJSON {omitNothingFields = True} ''OperationLog)
data BatchOperationSuccessLog = BatchOperationSuccessLog
{ BatchOperationSuccessLog -> Maybe Value
_bolQuery :: !(Maybe Value),
BatchOperationSuccessLog -> Int64
_bolResponseSize :: !Int64,
BatchOperationSuccessLog -> Seconds
_bolQueryExecutionTime :: !Seconds
}
deriving (BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
(BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool)
-> (BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool)
-> Eq BatchOperationSuccessLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
$c/= :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
== :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
$c== :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
Eq)
$(deriveToJSON hasuraJSON {omitNothingFields = True} ''BatchOperationSuccessLog)
data BatchOperationErrorLog = BatchOperationErrorLog
{ BatchOperationErrorLog -> Maybe Value
_belQuery :: !(Maybe Value),
BatchOperationErrorLog -> QErr
_belError :: !QErr
}
deriving (BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
(BatchOperationErrorLog -> BatchOperationErrorLog -> Bool)
-> (BatchOperationErrorLog -> BatchOperationErrorLog -> Bool)
-> Eq BatchOperationErrorLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
$c/= :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
== :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
$c== :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
Eq)
$(deriveToJSON hasuraJSON {omitNothingFields = True} ''BatchOperationErrorLog)
data BatchOperationLog
= BatchOperationSuccess !BatchOperationSuccessLog
| BatchOperationError !BatchOperationErrorLog
deriving (BatchOperationLog -> BatchOperationLog -> Bool
(BatchOperationLog -> BatchOperationLog -> Bool)
-> (BatchOperationLog -> BatchOperationLog -> Bool)
-> Eq BatchOperationLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchOperationLog -> BatchOperationLog -> Bool
$c/= :: BatchOperationLog -> BatchOperationLog -> Bool
== :: BatchOperationLog -> BatchOperationLog -> Bool
$c== :: BatchOperationLog -> BatchOperationLog -> Bool
Eq)
instance ToJSON BatchOperationLog where
toJSON :: BatchOperationLog -> Value
toJSON = \case
BatchOperationSuccess BatchOperationSuccessLog
successLog -> BatchOperationSuccessLog -> Value
forall a. ToJSON a => a -> Value
toJSON BatchOperationSuccessLog
successLog
BatchOperationError BatchOperationErrorLog
errorLog -> BatchOperationErrorLog -> Value
forall a. ToJSON a => a -> Value
toJSON BatchOperationErrorLog
errorLog
data HttpLogContext = HttpLogContext
{ HttpLogContext -> HttpInfoLog
hlcHttpInfo :: !HttpInfoLog,
HttpLogContext -> OperationLog
hlcOperation :: !OperationLog,
HttpLogContext -> RequestId
hlcRequestId :: !RequestId,
HttpLogContext -> Maybe (NonEmpty BatchOperationLog)
hlcBatchedOperations :: !(Maybe (NE.NonEmpty BatchOperationLog))
}
deriving (HttpLogContext -> HttpLogContext -> Bool
(HttpLogContext -> HttpLogContext -> Bool)
-> (HttpLogContext -> HttpLogContext -> Bool) -> Eq HttpLogContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpLogContext -> HttpLogContext -> Bool
$c/= :: HttpLogContext -> HttpLogContext -> Bool
== :: HttpLogContext -> HttpLogContext -> Bool
$c== :: HttpLogContext -> HttpLogContext -> Bool
Eq)
$(deriveToJSON hasuraJSON {omitNothingFields = True} ''HttpLogContext)
isQueryIncludedInLogs :: Text -> LoggingSettings -> Bool
isQueryIncludedInLogs :: Text -> LoggingSettings -> Bool
isQueryIncludedInLogs Text
urlPath LoggingSettings {HashSet (EngineLogType Hasura)
MetadataQueryLoggingMode
_lsMetadataQueryLoggingMode :: MetadataQueryLoggingMode
_lsEnabledLogTypes :: HashSet (EngineLogType Hasura)
_lsMetadataQueryLoggingMode :: LoggingSettings -> MetadataQueryLoggingMode
_lsEnabledLogTypes :: LoggingSettings -> HashSet (EngineLogType Hasura)
..}
| Bool
isQueryLogEnabled Bool -> Bool -> Bool
&& Bool
isMetadataRequest = MetadataQueryLoggingMode
_lsMetadataQueryLoggingMode MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataQueryLoggingMode
MetadataQueryLoggingEnabled
| Bool
isQueryLogEnabled = Bool
True
| Bool
otherwise = Bool
False
where
isQueryLogEnabled :: Bool
isQueryLogEnabled = EngineLogType Hasura -> HashSet (EngineLogType Hasura) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Set.member EngineLogType Hasura
ELTQueryLog HashSet (EngineLogType Hasura)
_lsEnabledLogTypes
metadataUrlPaths :: [Text]
metadataUrlPaths = [Text
"/v1/metadata", Text
"/v1/query"]
isMetadataRequest :: Bool
isMetadataRequest = Text
urlPath Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
metadataUrlPaths
mkHttpAccessLogContext ::
Maybe UserInfo ->
LoggingSettings ->
RequestId ->
Wai.Request ->
(BL.ByteString, Maybe Value) ->
BL.ByteString ->
Maybe (DiffTime, DiffTime) ->
Maybe CompressionType ->
[HTTP.Header] ->
RequestMode ->
Maybe (GH.GQLBatchedReqs GQLBatchQueryOperationLog) ->
HttpLogContext
mkHttpAccessLogContext :: Maybe UserInfo
-> LoggingSettings
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> HttpLogContext
mkHttpAccessLogContext Maybe UserInfo
userInfoM LoggingSettings
loggingSettings RequestId
reqId Request
req (ByteString
_, Maybe Value
parsedReq) ByteString
res Maybe (DiffTime, DiffTime)
mTiming Maybe CompressionType
compressTypeM [Header]
headers RequestMode
batching Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
queryLogMetadata =
let http :: HttpInfoLog
http =
HttpInfoLog :: Status
-> Text
-> IpAddress
-> Text
-> HttpVersion
-> Maybe CompressionType
-> [Header]
-> HttpInfoLog
HttpInfoLog
{ hlStatus :: Status
hlStatus = Status
status,
hlMethod :: Text
hlMethod = ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
Wai.requestMethod Request
req,
hlSource :: IpAddress
hlSource = Request -> IpAddress
Wai.getSourceFromFallback Request
req,
hlPath :: Text
hlPath = ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
Wai.rawPathInfo Request
req,
hlHttpVersion :: HttpVersion
hlHttpVersion = Request -> HttpVersion
Wai.httpVersion Request
req,
hlCompression :: Maybe CompressionType
hlCompression = Maybe CompressionType
compressTypeM,
hlHeaders :: [Header]
hlHeaders = [Header]
headers
}
op :: OperationLog
op =
OperationLog :: RequestId
-> Maybe SessionVariables
-> Maybe Int64
-> Maybe Seconds
-> Maybe Seconds
-> Maybe Value
-> Maybe Text
-> Maybe QErr
-> RequestMode
-> OperationLog
OperationLog
{ olRequestId :: RequestId
olRequestId = RequestId
reqId,
olUserVars :: Maybe SessionVariables
olUserVars = UserInfo -> SessionVariables
_uiSession (UserInfo -> SessionVariables)
-> Maybe UserInfo -> Maybe SessionVariables
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserInfo
userInfoM,
olResponseSize :: Maybe Int64
olResponseSize = Maybe Int64
respSize,
olRequestReadTime :: Maybe Seconds
olRequestReadTime = DiffTime -> Seconds
Seconds (DiffTime -> Seconds)
-> ((DiffTime, DiffTime) -> DiffTime)
-> (DiffTime, DiffTime)
-> Seconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffTime, DiffTime) -> DiffTime
forall a b. (a, b) -> a
fst ((DiffTime, DiffTime) -> Seconds)
-> Maybe (DiffTime, DiffTime) -> Maybe Seconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (DiffTime, DiffTime)
mTiming,
olQueryExecutionTime :: Maybe Seconds
olQueryExecutionTime = DiffTime -> Seconds
Seconds (DiffTime -> Seconds)
-> ((DiffTime, DiffTime) -> DiffTime)
-> (DiffTime, DiffTime)
-> Seconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffTime, DiffTime) -> DiffTime
forall a b. (a, b) -> b
snd ((DiffTime, DiffTime) -> Seconds)
-> Maybe (DiffTime, DiffTime) -> Maybe Seconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (DiffTime, DiffTime)
mTiming,
olRequestMode :: RequestMode
olRequestMode = RequestMode
batching,
olQuery :: Maybe Value
olQuery = if (Text -> LoggingSettings -> Bool
isQueryIncludedInLogs (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings) then Maybe Value
parsedReq else Maybe Value
forall a. Maybe a
Nothing,
olRawQuery :: Maybe Text
olRawQuery = Maybe Text
forall a. Maybe a
Nothing,
olError :: Maybe QErr
olError = Maybe QErr
forall a. Maybe a
Nothing
}
batchOpLog :: Maybe (NonEmpty BatchOperationLog)
batchOpLog =
Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
queryLogMetadata
Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> (GQLBatchedReqs GQLBatchQueryOperationLog
-> Maybe (NonEmpty BatchOperationLog))
-> Maybe (NonEmpty BatchOperationLog)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \case
GH.GQLSingleRequest GQLBatchQueryOperationLog
_ -> Maybe (NonEmpty BatchOperationLog)
forall a. Maybe a
Nothing
GH.GQLBatchedReqs [GQLBatchQueryOperationLog]
opLogs ->
[BatchOperationLog] -> Maybe (NonEmpty BatchOperationLog)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([BatchOperationLog] -> Maybe (NonEmpty BatchOperationLog))
-> [BatchOperationLog] -> Maybe (NonEmpty BatchOperationLog)
forall a b. (a -> b) -> a -> b
$
(GQLBatchQueryOperationLog -> BatchOperationLog)
-> [GQLBatchQueryOperationLog] -> [BatchOperationLog]
forall a b. (a -> b) -> [a] -> [b]
map
( \case
GQLQueryOperationSuccess (GQLQueryOperationSuccessLog {Int64
DiffTime
ParameterizedQueryHash
GQLReqUnparsed
gqolParameterizedQueryHash :: ParameterizedQueryHash
gqolRequestSize :: Int64
gqolResponseSize :: Int64
gqolQueryExecutionTime :: DiffTime
gqolQuery :: GQLReqUnparsed
gqolParameterizedQueryHash :: GQLQueryOperationSuccessLog -> ParameterizedQueryHash
gqolRequestSize :: GQLQueryOperationSuccessLog -> Int64
gqolResponseSize :: GQLQueryOperationSuccessLog -> Int64
gqolQueryExecutionTime :: GQLQueryOperationSuccessLog -> DiffTime
gqolQuery :: GQLQueryOperationSuccessLog -> GQLReqUnparsed
..}) ->
BatchOperationSuccessLog -> BatchOperationLog
BatchOperationSuccess (BatchOperationSuccessLog -> BatchOperationLog)
-> BatchOperationSuccessLog -> BatchOperationLog
forall a b. (a -> b) -> a -> b
$
Maybe Value -> Int64 -> Seconds -> BatchOperationSuccessLog
BatchOperationSuccessLog
(if (Text -> LoggingSettings -> Bool
isQueryIncludedInLogs (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings) then Maybe Value
parsedReq else Maybe Value
forall a. Maybe a
Nothing)
Int64
gqolResponseSize
(DiffTime -> Seconds
forall x y. (Duration x, Duration y) => x -> y
convertDuration DiffTime
gqolQueryExecutionTime)
GQLQueryOperationError (GQLQueryOperationErrorLog {QErr
GQLReqUnparsed
gqelError :: QErr
gqelQuery :: GQLReqUnparsed
gqelError :: GQLQueryOperationErrorLog -> QErr
gqelQuery :: GQLQueryOperationErrorLog -> GQLReqUnparsed
..}) ->
BatchOperationErrorLog -> BatchOperationLog
BatchOperationError (BatchOperationErrorLog -> BatchOperationLog)
-> BatchOperationErrorLog -> BatchOperationLog
forall a b. (a -> b) -> a -> b
$
Maybe Value -> QErr -> BatchOperationErrorLog
BatchOperationErrorLog
(if (Text -> LoggingSettings -> Bool
isQueryIncludedInLogs (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings) then Maybe Value
parsedReq else Maybe Value
forall a. Maybe a
Nothing)
QErr
gqelError
)
[GQLBatchQueryOperationLog]
opLogs
)
in HttpInfoLog
-> OperationLog
-> RequestId
-> Maybe (NonEmpty BatchOperationLog)
-> HttpLogContext
HttpLogContext HttpInfoLog
http OperationLog
op RequestId
reqId Maybe (NonEmpty BatchOperationLog)
batchOpLog
where
status :: Status
status = Status
HTTP.status200
respSize :: Maybe Int64
respSize = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
res
mkHttpErrorLogContext ::
Maybe UserInfo ->
LoggingSettings ->
RequestId ->
Wai.Request ->
(BL.ByteString, Maybe Value) ->
QErr ->
Maybe (DiffTime, DiffTime) ->
Maybe CompressionType ->
[HTTP.Header] ->
HttpLogContext
mkHttpErrorLogContext :: Maybe UserInfo
-> LoggingSettings
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogContext
mkHttpErrorLogContext Maybe UserInfo
userInfoM LoggingSettings
loggingSettings RequestId
reqId Request
waiReq (ByteString
reqBody, Maybe Value
parsedReq) QErr
err Maybe (DiffTime, DiffTime)
mTiming Maybe CompressionType
compressTypeM [Header]
headers =
let http :: HttpInfoLog
http =
HttpInfoLog :: Status
-> Text
-> IpAddress
-> Text
-> HttpVersion
-> Maybe CompressionType
-> [Header]
-> HttpInfoLog
HttpInfoLog
{ hlStatus :: Status
hlStatus = QErr -> Status
qeStatus QErr
err,
hlMethod :: Text
hlMethod = ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
Wai.requestMethod Request
waiReq,
hlSource :: IpAddress
hlSource = Request -> IpAddress
Wai.getSourceFromFallback Request
waiReq,
hlPath :: Text
hlPath = ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
Wai.rawPathInfo Request
waiReq,
hlHttpVersion :: HttpVersion
hlHttpVersion = Request -> HttpVersion
Wai.httpVersion Request
waiReq,
hlCompression :: Maybe CompressionType
hlCompression = Maybe CompressionType
compressTypeM,
hlHeaders :: [Header]
hlHeaders = [Header]
headers
}
op :: OperationLog
op =
OperationLog :: RequestId
-> Maybe SessionVariables
-> Maybe Int64
-> Maybe Seconds
-> Maybe Seconds
-> Maybe Value
-> Maybe Text
-> Maybe QErr
-> RequestMode
-> OperationLog
OperationLog
{ olRequestId :: RequestId
olRequestId = RequestId
reqId,
olUserVars :: Maybe SessionVariables
olUserVars = UserInfo -> SessionVariables
_uiSession (UserInfo -> SessionVariables)
-> Maybe UserInfo -> Maybe SessionVariables
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserInfo
userInfoM,
olResponseSize :: Maybe Int64
olResponseSize = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ QErr -> ByteString
forall a. ToJSON a => a -> ByteString
encode QErr
err,
olRequestReadTime :: Maybe Seconds
olRequestReadTime = DiffTime -> Seconds
Seconds (DiffTime -> Seconds)
-> ((DiffTime, DiffTime) -> DiffTime)
-> (DiffTime, DiffTime)
-> Seconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffTime, DiffTime) -> DiffTime
forall a b. (a, b) -> a
fst ((DiffTime, DiffTime) -> Seconds)
-> Maybe (DiffTime, DiffTime) -> Maybe Seconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (DiffTime, DiffTime)
mTiming,
olQueryExecutionTime :: Maybe Seconds
olQueryExecutionTime = DiffTime -> Seconds
Seconds (DiffTime -> Seconds)
-> ((DiffTime, DiffTime) -> DiffTime)
-> (DiffTime, DiffTime)
-> Seconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffTime, DiffTime) -> DiffTime
forall a b. (a, b) -> b
snd ((DiffTime, DiffTime) -> Seconds)
-> Maybe (DiffTime, DiffTime) -> Maybe Seconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (DiffTime, DiffTime)
mTiming,
olQuery :: Maybe Value
olQuery = if (Text -> LoggingSettings -> Bool
isQueryIncludedInLogs (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings) then Maybe Value
parsedReq else Maybe Value
forall a. Maybe a
Nothing,
olRawQuery :: Maybe Text
olRawQuery = Maybe Text -> (Value -> Maybe Text) -> Maybe Value -> Maybe Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a
reqToLog (Maybe Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
reqBody) (Maybe Text -> Value -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Maybe Value
parsedReq,
olError :: Maybe QErr
olError = QErr -> Maybe QErr
forall a. a -> Maybe a
Just QErr
err,
olRequestMode :: RequestMode
olRequestMode = RequestMode
RequestModeError
}
reqToLog :: Maybe a -> Maybe a
reqToLog :: Maybe a -> Maybe a
reqToLog Maybe a
req = if (Text -> LoggingSettings -> Bool
isQueryIncludedInLogs (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings) then Maybe a
req else Maybe a
forall a. Maybe a
Nothing
in HttpInfoLog
-> OperationLog
-> RequestId
-> Maybe (NonEmpty BatchOperationLog)
-> HttpLogContext
HttpLogContext HttpInfoLog
http OperationLog
op RequestId
reqId Maybe (NonEmpty BatchOperationLog)
forall a. Maybe a
Nothing
data HttpLogLine = HttpLogLine
{ HttpLogLine -> LogLevel
_hlLogLevel :: !LogLevel,
HttpLogLine -> HttpLogContext
_hlLogLine :: !HttpLogContext
}
instance ToEngineLog HttpLogLine Hasura where
toEngineLog :: HttpLogLine -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog (HttpLogLine LogLevel
logLevel HttpLogContext
logLine) =
(LogLevel
logLevel, EngineLogType Hasura
ELTHttpLog, HttpLogContext -> Value
forall a. ToJSON a => a -> Value
toJSON HttpLogContext
logLine)
mkHttpLog :: HttpLogContext -> HttpLogLine
mkHttpLog :: HttpLogContext -> HttpLogLine
mkHttpLog HttpLogContext
httpLogCtx =
let isError :: Bool
isError = Maybe QErr -> Bool
forall a. Maybe a -> Bool
isJust (Maybe QErr -> Bool) -> Maybe QErr -> Bool
forall a b. (a -> b) -> a -> b
$ OperationLog -> Maybe QErr
olError (OperationLog -> Maybe QErr) -> OperationLog -> Maybe QErr
forall a b. (a -> b) -> a -> b
$ HttpLogContext -> OperationLog
hlcOperation HttpLogContext
httpLogCtx
logLevel :: LogLevel
logLevel = LogLevel -> LogLevel -> Bool -> LogLevel
forall a. a -> a -> Bool -> a
bool LogLevel
LevelInfo LogLevel
LevelError Bool
isError
in LogLevel -> HttpLogContext -> HttpLogLine
HttpLogLine LogLevel
logLevel HttpLogContext
httpLogCtx
logDeprecatedEnvVars ::
Logger Hasura ->
Env.Environment ->
SourceCache ->
IO ()
logDeprecatedEnvVars :: Logger Hasura -> Environment -> SourceCache -> IO ()
logDeprecatedEnvVars Logger Hasura
logger Environment
env SourceCache
sources = do
let toText :: f t -> Text
toText f t
envVars = f t -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated f t
envVars
envVarsInitialized :: [String]
envVarsInitialized = ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String) -> String
forall a b. (a, b) -> a
fst (Environment -> [(String, String)]
Env.toList Environment
env)
checkDeprecatedEnvVars :: [String] -> [Text]
checkDeprecatedEnvVars [String]
envs = String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
envVarsInitialized [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [String]
envs
Maybe BackendSourceInfo -> (BackendSourceInfo -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust (SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup SourceName
SNDefault SourceCache
sources) ((BackendSourceInfo -> IO ()) -> IO ())
-> (BackendSourceInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BackendSourceInfo
_defSource -> do
let deprecated :: [Text]
deprecated = [String] -> [Text]
checkDeprecatedEnvVars (EnvVarsMovedToMetadata -> [String]
unEnvVarsMovedToMetadata EnvVarsMovedToMetadata
envVarsMovedToMetadata)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
deprecated) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger Hasura
-> forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
(ToEngineLog a impl, MonadIO m) =>
a -> m ()
unLogger Logger Hasura
logger (UnstructuredLog -> IO ()) -> UnstructuredLog -> IO ()
forall a b. (a -> b) -> a -> b
$
LogLevel -> SerializableBlob -> UnstructuredLog
UnstructuredLog LogLevel
LevelWarn (SerializableBlob -> UnstructuredLog)
-> SerializableBlob -> UnstructuredLog
forall a b. (a -> b) -> a -> b
$
Text -> SerializableBlob
SB.fromText (Text -> SerializableBlob) -> Text -> SerializableBlob
forall a b. (a -> b) -> a -> b
$
Text
"The following environment variables are deprecated and moved to metadata: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
toText [Text]
deprecated
let deprecated :: [Text]
deprecated = [String] -> [Text]
checkDeprecatedEnvVars (DeprecatedEnvVars -> [String]
unDeprecatedEnvVars DeprecatedEnvVars
deprecatedEnvVars)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
deprecated) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger Hasura
-> forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
(ToEngineLog a impl, MonadIO m) =>
a -> m ()
unLogger Logger Hasura
logger (UnstructuredLog -> IO ()) -> UnstructuredLog -> IO ()
forall a b. (a -> b) -> a -> b
$
LogLevel -> SerializableBlob -> UnstructuredLog
UnstructuredLog LogLevel
LevelWarn (SerializableBlob -> UnstructuredLog)
-> SerializableBlob -> UnstructuredLog
forall a b. (a -> b) -> a -> b
$
Text -> SerializableBlob
SB.fromText (Text -> SerializableBlob) -> Text -> SerializableBlob
forall a b. (a -> b) -> a -> b
$
Text
"The following environment variables are deprecated: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
toText [Text]
deprecated