-- | This is taken from wai-logger and customised for our use
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 (..),
    SchemaSyncThreadType (..),
    SchemaSyncLog (..),
    HttpLogGraphQLInfo,
    emptyHttpLogGraphQLInfo,
  )
where

import Control.Lens ((^?))
import Data.Aeson qualified as J
import Data.Aeson.Lens (key, _String)
import Data.ByteString.Lazy qualified as BL
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HashMap
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.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 :: !J.Value
  }
  deriving (StartupLog -> StartupLog -> Bool
(StartupLog -> StartupLog -> Bool)
-> (StartupLog -> StartupLog -> Bool) -> Eq StartupLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StartupLog -> StartupLog -> Bool
== :: StartupLog -> StartupLog -> Bool
$c/= :: StartupLog -> StartupLog -> Bool
/= :: StartupLog -> StartupLog -> Bool
Eq)

instance J.ToJSON StartupLog where
  toJSON :: StartupLog -> Value
toJSON (StartupLog LogLevel
_ Text
k Value
info) =
    [Pair] -> Value
J.object
      [ Key
"kind" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
k,
        Key
"info" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= 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
J.toJSON StartupLog
startupLog)

data PGLog = PGLog
  { PGLog -> LogLevel
plLogLevel :: !LogLevel,
    PGLog -> Value
plMessage :: !J.Value
  }
  deriving (PGLog -> PGLog -> Bool
(PGLog -> PGLog -> Bool) -> (PGLog -> PGLog -> Bool) -> Eq PGLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGLog -> PGLog -> Bool
== :: PGLog -> PGLog -> Bool
$c/= :: PGLog -> PGLog -> Bool
/= :: PGLog -> PGLog -> Bool
Eq)

instance J.ToJSON PGLog where
  toJSON :: PGLog -> Value
toJSON (PGLog LogLevel
_ Value
msg) =
    [Pair] -> Value
J.object [Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Value
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
J.toJSON PGLog
pgLog)

data MetadataLog = MetadataLog
  { MetadataLog -> LogLevel
mlLogLevel :: !LogLevel,
    MetadataLog -> Text
mlMessage :: !Text,
    MetadataLog -> Value
mlInfo :: !J.Value
  }
  deriving (MetadataLog -> MetadataLog -> Bool
(MetadataLog -> MetadataLog -> Bool)
-> (MetadataLog -> MetadataLog -> Bool) -> Eq MetadataLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataLog -> MetadataLog -> Bool
== :: MetadataLog -> MetadataLog -> Bool
$c/= :: MetadataLog -> MetadataLog -> Bool
/= :: MetadataLog -> MetadataLog -> Bool
Eq)

instance J.ToJSON MetadataLog where
  toJSON :: MetadataLog -> Value
toJSON (MetadataLog LogLevel
_ Text
msg Value
infoVal) =
    [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
msg,
        Key
"info" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= 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
J.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
J.object [Key
"objects" Key -> [InconsistentMetadata] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [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
J.toJSON WebHookLog
webHookLog)

instance J.ToJSON WebHookLog where
  toJSON :: WebHookLog -> Value
toJSON WebHookLog
whl =
    [Pair] -> Value
J.object
      [ Key
"status_code" Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (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
forall v. ToJSON v => Key -> v -> Pair
J..= WebHookLog -> Text
whlUrl WebHookLog
whl,
        Key
"method" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= 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
forall v. ToJSON v => Key -> v -> Pair
J..= WebHookLog -> Maybe HttpException
whlError WebHookLog
whl,
        Key
"response" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= WebHookLog -> Maybe Text
whlResponse WebHookLog
whl,
        Key
"message" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= WebHookLog -> Maybe Text
whlMessage WebHookLog
whl
      ]

-- | GQLQueryOperationSuccessLog captures all the data required to construct
--   an HTTP success log.
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
$c== :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
== :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
$c/= :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
/= :: GQLQueryOperationSuccessLog -> GQLQueryOperationSuccessLog -> Bool
Eq, (forall x.
 GQLQueryOperationSuccessLog -> Rep GQLQueryOperationSuccessLog x)
-> (forall x.
    Rep GQLQueryOperationSuccessLog x -> GQLQueryOperationSuccessLog)
-> Generic GQLQueryOperationSuccessLog
forall x.
Rep GQLQueryOperationSuccessLog x -> GQLQueryOperationSuccessLog
forall x.
GQLQueryOperationSuccessLog -> Rep GQLQueryOperationSuccessLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GQLQueryOperationSuccessLog -> Rep GQLQueryOperationSuccessLog x
from :: forall x.
GQLQueryOperationSuccessLog -> Rep GQLQueryOperationSuccessLog x
$cto :: forall x.
Rep GQLQueryOperationSuccessLog x -> GQLQueryOperationSuccessLog
to :: forall x.
Rep GQLQueryOperationSuccessLog x -> GQLQueryOperationSuccessLog
Generic)

instance J.ToJSON GQLQueryOperationSuccessLog where
  toJSON :: GQLQueryOperationSuccessLog -> Value
toJSON = Options -> GQLQueryOperationSuccessLog -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: GQLQueryOperationSuccessLog -> Encoding
toEncoding = Options -> GQLQueryOperationSuccessLog -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

-- | GQLQueryOperationErrorLog captures the request along with the error message
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
$c== :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
== :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
$c/= :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
/= :: GQLQueryOperationErrorLog -> GQLQueryOperationErrorLog -> Bool
Eq, (forall x.
 GQLQueryOperationErrorLog -> Rep GQLQueryOperationErrorLog x)
-> (forall x.
    Rep GQLQueryOperationErrorLog x -> GQLQueryOperationErrorLog)
-> Generic GQLQueryOperationErrorLog
forall x.
Rep GQLQueryOperationErrorLog x -> GQLQueryOperationErrorLog
forall x.
GQLQueryOperationErrorLog -> Rep GQLQueryOperationErrorLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GQLQueryOperationErrorLog -> Rep GQLQueryOperationErrorLog x
from :: forall x.
GQLQueryOperationErrorLog -> Rep GQLQueryOperationErrorLog x
$cto :: forall x.
Rep GQLQueryOperationErrorLog x -> GQLQueryOperationErrorLog
to :: forall x.
Rep GQLQueryOperationErrorLog x -> GQLQueryOperationErrorLog
Generic)

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

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
$c== :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
== :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
$c/= :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
/= :: GQLBatchQueryOperationLog -> GQLBatchQueryOperationLog -> Bool
Eq)

instance J.ToJSON GQLBatchQueryOperationLog where
  toJSON :: GQLBatchQueryOperationLog -> Value
toJSON = \case
    GQLQueryOperationSuccess GQLQueryOperationSuccessLog
successLog -> GQLQueryOperationSuccessLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON GQLQueryOperationSuccessLog
successLog
    GQLQueryOperationError GQLQueryOperationErrorLog
errorLog -> GQLQueryOperationErrorLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON GQLQueryOperationErrorLog
errorLog

-- | whether a request is executed in batched mode or not
data RequestMode
  = -- | this request is batched
    RequestModeBatched
  | -- | this is a single request
    RequestModeSingle
  | -- | this request is of a kind for which batching is not done or does not make sense
    RequestModeNonBatchable
  | -- | the execution of this request failed
    RequestModeError
  deriving (RequestMode -> RequestMode -> Bool
(RequestMode -> RequestMode -> Bool)
-> (RequestMode -> RequestMode -> Bool) -> Eq RequestMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestMode -> RequestMode -> Bool
== :: RequestMode -> RequestMode -> Bool
$c/= :: RequestMode -> RequestMode -> Bool
/= :: RequestMode -> RequestMode -> Bool
Eq)

instance J.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
$c== :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
== :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
$c/= :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
/= :: CommonHttpLogMetadata -> CommonHttpLogMetadata -> Bool
Eq)

-- The information from the GraphQL layer that needs to be included in the http-log.
-- This info is used to construct 'HttpLogMetadata m'
type HttpLogGraphQLInfo = (CommonHttpLogMetadata, ParameterizedQueryHashList)

emptyHttpLogGraphQLInfo :: HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo :: HttpLogGraphQLInfo
emptyHttpLogGraphQLInfo = (RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> CommonHttpLogMetadata
CommonHttpLogMetadata RequestMode
RequestModeNonBatchable Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
forall a. Maybe a
Nothing, ParameterizedQueryHashList
PQHSetEmpty)

-- | The http-log metadata attached to HTTP requests running in the monad 'm', split into a
-- common portion that is present regardless of 'm', and a monad-specific one defined in the
-- 'HttpLog' instance.
--
-- This allows us to not have to duplicate the code that generates the common part of the metadata
-- across OSS and Pro, so that instances only have to implement the part of it unique to them.
type HttpLogMetadata m = (CommonHttpLogMetadata, ExtraHttpLogMetadata m)

buildHttpLogMetadata ::
  forall m.
  (HttpLog m) =>
  HttpLogGraphQLInfo ->
  ExtraUserInfo ->
  HttpLogMetadata m
buildHttpLogMetadata :: forall (m :: * -> *).
HttpLog m =>
HttpLogGraphQLInfo -> ExtraUserInfo -> HttpLogMetadata m
buildHttpLogMetadata (CommonHttpLogMetadata
commonHttpLogMetadata, ParameterizedQueryHashList
paramQueryHashList) ExtraUserInfo
extraUserInfo =
  (CommonHttpLogMetadata
commonHttpLogMetadata, forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList
-> ExtraUserInfo -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
paramQueryHashList ExtraUserInfo
extraUserInfo)

-- | synonym for clarity, writing `emptyHttpLogMetadata @m` instead of `def @(HttpLogMetadata m)`
emptyHttpLogMetadata :: forall m. (HttpLog m) => HttpLogMetadata m
emptyHttpLogMetadata :: forall (m :: * -> *). HttpLog m => HttpLogMetadata m
emptyHttpLogMetadata = (RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> CommonHttpLogMetadata
CommonHttpLogMetadata RequestMode
RequestModeNonBatchable Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
forall a. Maybe a
Nothing, forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m)

-- See Note [Disable query printing for metadata queries]
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
$cshowsPrec :: Int -> MetadataQueryLoggingMode -> ShowS
showsPrec :: Int -> MetadataQueryLoggingMode -> ShowS
$cshow :: MetadataQueryLoggingMode -> String
show :: MetadataQueryLoggingMode -> String
$cshowList :: [MetadataQueryLoggingMode] -> ShowS
showList :: [MetadataQueryLoggingMode] -> ShowS
Show, MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
(MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool)
-> (MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool)
-> Eq MetadataQueryLoggingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
== :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
$c/= :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
/= :: MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
Eq)

instance J.FromJSON MetadataQueryLoggingMode where
  parseJSON :: Value -> Parser MetadataQueryLoggingMode
parseJSON =
    String
-> (Bool -> Parser MetadataQueryLoggingMode)
-> Value
-> Parser MetadataQueryLoggingMode
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
J.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 a. a -> Parser a
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 J.ToJSON MetadataQueryLoggingMode where
  toJSON :: MetadataQueryLoggingMode -> Value
toJSON = \case
    MetadataQueryLoggingMode
MetadataQueryLoggingEnabled -> Bool -> Value
J.Bool Bool
True
    MetadataQueryLoggingMode
MetadataQueryLoggingDisabled -> Bool -> Value
J.Bool Bool
False

-- | Setting used to control the information in logs
data LoggingSettings = LoggingSettings
  { -- | this is only required for the short-term fix in https://github.com/hasura/graphql-engine-mono/issues/1770
    -- See Note [Disable query printing when query-log is disabled]
    LoggingSettings -> HashSet (EngineLogType Hasura)
_lsEnabledLogTypes :: HashSet (EngineLogType Hasura),
    -- See Note [Disable query printing for metadata queries]
    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
$c== :: LoggingSettings -> LoggingSettings -> Bool
== :: LoggingSettings -> LoggingSettings -> Bool
$c/= :: LoggingSettings -> LoggingSettings -> Bool
/= :: LoggingSettings -> LoggingSettings -> Bool
Eq)

{- Note [Disable query printing when query-log is disabled]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As a temporary hack (as per https://github.com/hasura/graphql-engine-mono/issues/1770),
we want to print the graphql query string in `http-log` or `websocket-log` only
when `query-log` is enabled.
-}

{- Note [Disable query printing for metadata queries]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The 'olQuery' in the 'OperationLog' logs the actual query that is sent over HTTP.
This can lead to security issues, since the request sent in metadata queries may
include sensitive information such as DB URLS. Thus it is important that we hide
these sensitive information for the metadata URL.

As a temporary hotfix (ref: https://github.com/hasura/graphql-engine-mono/issues/3937),
If the URL path of HTTP requests is for a metadata operation and the
HASURA_GRAPHQL_ENABLE_METADATA_QUERY_LOGGING envirnoment variables is not set, then
we disable the 'query' field in HTTP logs.
-}

class (Monad m) => HttpLog m where
  -- | Extra http-log metadata that we attach when operating in 'm'.
  type ExtraHttpLogMetadata m

  emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata m

  buildExtraHttpLogMetadata :: ParameterizedQueryHashList -> ExtraUserInfo -> ExtraHttpLogMetadata m

  logHttpError ::
    -- | the logger
    Logger Hasura ->
    -- | setting used to control the information in logs
    LoggingSettings ->
    -- | user info may or may not be present (error can happen during user resolution)
    Maybe UserInfo ->
    -- | request id of the request
    RequestId ->
    -- | the Wai.Request object
    Wai.Request ->
    -- | the request body and parsed request
    (BL.ByteString, Maybe J.Value) ->
    -- | the error
    QErr ->
    -- | list of request headers
    [HTTP.Header] ->
    HttpLogMetadata m ->
    m ()

  logHttpSuccess ::
    -- | the logger
    Logger Hasura ->
    -- | setting used to control the information in logs
    LoggingSettings ->
    -- | user info may or may not be present (error can happen during user resolution)
    Maybe UserInfo ->
    -- | request id of the request
    RequestId ->
    -- | the Wai.Request object
    Wai.Request ->
    -- | the request body and parsed request
    (BL.ByteString, Maybe J.Value) ->
    -- | the response bytes
    BL.ByteString ->
    -- | the compressed response bytes
    -- ^ TODO (from master): make the above two type represented
    BL.ByteString ->
    -- | IO/network wait time and service time (respectively) for this request, if available.
    Maybe (DiffTime, DiffTime) ->
    -- | possible compression type
    Maybe CompressionType ->
    -- | list of request headers
    [HTTP.Header] ->
    HttpLogMetadata m ->
    m ()

instance (HttpLog m) => HttpLog (TraceT m) where
  type ExtraHttpLogMetadata (TraceT m) = ExtraHttpLogMetadata m

  buildExtraHttpLogMetadata :: ParameterizedQueryHashList
-> ExtraUserInfo -> ExtraHttpLogMetadata (TraceT m)
buildExtraHttpLogMetadata ParameterizedQueryHashList
a = forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList
-> ExtraUserInfo -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
a
  emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata (TraceT m)
emptyExtraHttpLogMetadata = forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m

  logHttpError :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata (TraceT m)
-> TraceT m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h HttpLogMetadata (TraceT m)
i = m () -> TraceT m ()
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
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]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h HttpLogMetadata m
HttpLogMetadata (TraceT m)
i

  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 (m :: * -> *) a. Monad m => m a -> TraceT m a
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 ExtraHttpLogMetadata (ReaderT r m) = ExtraHttpLogMetadata m

  buildExtraHttpLogMetadata :: ParameterizedQueryHashList
-> ExtraUserInfo -> ExtraHttpLogMetadata (ReaderT r m)
buildExtraHttpLogMetadata ParameterizedQueryHashList
a = forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList
-> ExtraUserInfo -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
a
  emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata (ReaderT r m)
emptyExtraHttpLogMetadata = forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m

  logHttpError :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata (ReaderT r m)
-> ReaderT r m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h HttpLogMetadata (ReaderT r m)
i = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
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]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h HttpLogMetadata m
HttpLogMetadata (ReaderT r m)
i

  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 (m :: * -> *) a. Monad m => m a -> ReaderT r m a
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 (ExceptT e m) where
  type ExtraHttpLogMetadata (ExceptT e m) = ExtraHttpLogMetadata m

  buildExtraHttpLogMetadata :: ParameterizedQueryHashList
-> ExtraUserInfo -> ExtraHttpLogMetadata (ExceptT e m)
buildExtraHttpLogMetadata ParameterizedQueryHashList
a = forall (m :: * -> *).
HttpLog m =>
ParameterizedQueryHashList
-> ExtraUserInfo -> ExtraHttpLogMetadata m
buildExtraHttpLogMetadata @m ParameterizedQueryHashList
a
  emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata (ExceptT e m)
emptyExtraHttpLogMetadata = forall (m :: * -> *). HttpLog m => ExtraHttpLogMetadata m
emptyExtraHttpLogMetadata @m

  logHttpError :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata (ExceptT e m)
-> ExceptT e m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h HttpLogMetadata (ExceptT e m)
i = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> m () -> ExceptT e m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
forall (m :: * -> *).
HttpLog m =>
Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> QErr
-> [Header]
-> HttpLogMetadata m
-> m ()
logHttpError Logger Hasura
a LoggingSettings
b Maybe UserInfo
c RequestId
d Request
e (ByteString, Maybe Value)
f QErr
g [Header]
h HttpLogMetadata m
HttpLogMetadata (ExceptT e m)
i

  logHttpSuccess :: Logger Hasura
-> LoggingSettings
-> Maybe UserInfo
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> ByteString
-> ByteString
-> Maybe (DiffTime, DiffTime)
-> Maybe CompressionType
-> [Header]
-> HttpLogMetadata (ExceptT e m)
-> ExceptT e 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 (ExceptT e m)
l = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> m () -> ExceptT e 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 (ExceptT e m)
l

-- | Log information about the HTTP request
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),
    -- | all the request headers
    HttpInfoLog -> [Header]
hlHeaders :: ![HTTP.Header]
  }
  deriving (HttpInfoLog -> HttpInfoLog -> Bool
(HttpInfoLog -> HttpInfoLog -> Bool)
-> (HttpInfoLog -> HttpInfoLog -> Bool) -> Eq HttpInfoLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HttpInfoLog -> HttpInfoLog -> Bool
== :: HttpInfoLog -> HttpInfoLog -> Bool
$c/= :: HttpInfoLog -> HttpInfoLog -> Bool
/= :: HttpInfoLog -> HttpInfoLog -> Bool
Eq)

instance J.ToJSON HttpInfoLog where
  toJSON :: HttpInfoLog -> Value
toJSON (HttpInfoLog Status
st Text
met IpAddress
src Text
path HttpVersion
hv Maybe CompressionType
compressTypeM [Header]
_) =
    [Pair] -> Value
J.object
      [ Key
"status" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Status -> Int
HTTP.statusCode Status
st,
        Key
"method" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
met,
        Key
"ip" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= IpAddress -> Text
Wai.showIPAddress IpAddress
src,
        Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
path,
        Key
"http_version" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= 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
forall v. ToJSON v => Key -> v -> Pair
J..= (CompressionType -> Text
compressionTypeToTxt (CompressionType -> Text) -> Maybe CompressionType -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CompressionType
compressTypeM)
      ]

-- | Information about a GraphQL/Hasura metadata operation over HTTP
data OperationLog = OperationLog
  { OperationLog -> RequestId
olRequestId :: !RequestId,
    OperationLog -> Maybe SessionVariables
olUserVars :: !(Maybe SessionVariables),
    OperationLog -> Maybe Int64
olResponseSize :: !(Maybe Int64),
    -- | Response size before compression
    OperationLog -> Int64
olUncompressedResponseSize :: !Int64,
    -- | Request IO wait time, i.e. time spent reading the full request from the socket.
    OperationLog -> Maybe Seconds
olRequestReadTime :: !(Maybe Seconds),
    -- | Service time, not including request IO wait time.
    OperationLog -> Maybe Seconds
olQueryExecutionTime :: !(Maybe Seconds),
    OperationLog -> Maybe Value
olQuery :: !(Maybe J.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
$c== :: OperationLog -> OperationLog -> Bool
== :: OperationLog -> OperationLog -> Bool
$c/= :: OperationLog -> OperationLog -> Bool
/= :: OperationLog -> OperationLog -> Bool
Eq, (forall x. OperationLog -> Rep OperationLog x)
-> (forall x. Rep OperationLog x -> OperationLog)
-> Generic OperationLog
forall x. Rep OperationLog x -> OperationLog
forall x. OperationLog -> Rep OperationLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OperationLog -> Rep OperationLog x
from :: forall x. OperationLog -> Rep OperationLog x
$cto :: forall x. Rep OperationLog x -> OperationLog
to :: forall x. Rep OperationLog x -> OperationLog
Generic)

instance J.ToJSON OperationLog where
  toJSON :: OperationLog -> Value
toJSON = Options -> OperationLog -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: OperationLog -> Encoding
toEncoding = Options -> OperationLog -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

-- | @BatchOperationSuccessLog@ contains the information required for a single
--   successful operation in a batch request for OSS. This type is a subset of the @GQLQueryOperationSuccessLog@
data BatchOperationSuccessLog = BatchOperationSuccessLog
  { BatchOperationSuccessLog -> Maybe Value
_bolQuery :: !(Maybe J.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
$c== :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
== :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
$c/= :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
/= :: BatchOperationSuccessLog -> BatchOperationSuccessLog -> Bool
Eq, (forall x.
 BatchOperationSuccessLog -> Rep BatchOperationSuccessLog x)
-> (forall x.
    Rep BatchOperationSuccessLog x -> BatchOperationSuccessLog)
-> Generic BatchOperationSuccessLog
forall x.
Rep BatchOperationSuccessLog x -> BatchOperationSuccessLog
forall x.
BatchOperationSuccessLog -> Rep BatchOperationSuccessLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
BatchOperationSuccessLog -> Rep BatchOperationSuccessLog x
from :: forall x.
BatchOperationSuccessLog -> Rep BatchOperationSuccessLog x
$cto :: forall x.
Rep BatchOperationSuccessLog x -> BatchOperationSuccessLog
to :: forall x.
Rep BatchOperationSuccessLog x -> BatchOperationSuccessLog
Generic)

instance J.ToJSON BatchOperationSuccessLog where
  toJSON :: BatchOperationSuccessLog -> Value
toJSON = Options -> BatchOperationSuccessLog -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: BatchOperationSuccessLog -> Encoding
toEncoding = Options -> BatchOperationSuccessLog -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

-- | @BatchOperationSuccessLog@ contains the information required for a single
--   erroneous operation in a batch request for OSS. This type is a subset of the @GQLQueryOperationErrorLog@
data BatchOperationErrorLog = BatchOperationErrorLog
  { BatchOperationErrorLog -> Maybe Value
_belQuery :: !(Maybe J.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
$c== :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
== :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
$c/= :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
/= :: BatchOperationErrorLog -> BatchOperationErrorLog -> Bool
Eq, (forall x. BatchOperationErrorLog -> Rep BatchOperationErrorLog x)
-> (forall x.
    Rep BatchOperationErrorLog x -> BatchOperationErrorLog)
-> Generic BatchOperationErrorLog
forall x. Rep BatchOperationErrorLog x -> BatchOperationErrorLog
forall x. BatchOperationErrorLog -> Rep BatchOperationErrorLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BatchOperationErrorLog -> Rep BatchOperationErrorLog x
from :: forall x. BatchOperationErrorLog -> Rep BatchOperationErrorLog x
$cto :: forall x. Rep BatchOperationErrorLog x -> BatchOperationErrorLog
to :: forall x. Rep BatchOperationErrorLog x -> BatchOperationErrorLog
Generic)

instance J.ToJSON BatchOperationErrorLog where
  toJSON :: BatchOperationErrorLog -> Value
toJSON = Options -> BatchOperationErrorLog -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: BatchOperationErrorLog -> Encoding
toEncoding = Options -> BatchOperationErrorLog -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

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
$c== :: BatchOperationLog -> BatchOperationLog -> Bool
== :: BatchOperationLog -> BatchOperationLog -> Bool
$c/= :: BatchOperationLog -> BatchOperationLog -> Bool
/= :: BatchOperationLog -> BatchOperationLog -> Bool
Eq)

instance J.ToJSON BatchOperationLog where
  toJSON :: BatchOperationLog -> Value
toJSON = \case
    BatchOperationSuccess BatchOperationSuccessLog
successLog -> BatchOperationSuccessLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON BatchOperationSuccessLog
successLog
    BatchOperationError BatchOperationErrorLog
errorLog -> BatchOperationErrorLog -> Value
forall a. ToJSON a => a -> Value
J.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
$c== :: HttpLogContext -> HttpLogContext -> Bool
== :: HttpLogContext -> HttpLogContext -> Bool
$c/= :: HttpLogContext -> HttpLogContext -> Bool
/= :: HttpLogContext -> HttpLogContext -> Bool
Eq, (forall x. HttpLogContext -> Rep HttpLogContext x)
-> (forall x. Rep HttpLogContext x -> HttpLogContext)
-> Generic HttpLogContext
forall x. Rep HttpLogContext x -> HttpLogContext
forall x. HttpLogContext -> Rep HttpLogContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HttpLogContext -> Rep HttpLogContext x
from :: forall x. HttpLogContext -> Rep HttpLogContext x
$cto :: forall x. Rep HttpLogContext x -> HttpLogContext
to :: forall x. Rep HttpLogContext x -> HttpLogContext
Generic)

instance J.ToJSON HttpLogContext where
  toJSON :: HttpLogContext -> Value
toJSON = Options -> HttpLogContext -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: HttpLogContext -> Encoding
toEncoding = Options -> HttpLogContext -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

-- | Check if the 'query' field should be included in the http-log
isQueryIncludedInLogs :: Text -> LoggingSettings -> Bool
isQueryIncludedInLogs :: Text -> LoggingSettings -> Bool
isQueryIncludedInLogs Text
urlPath LoggingSettings {HashSet (EngineLogType Hasura)
MetadataQueryLoggingMode
_lsEnabledLogTypes :: LoggingSettings -> HashSet (EngineLogType Hasura)
_lsMetadataQueryLoggingMode :: LoggingSettings -> MetadataQueryLoggingMode
_lsEnabledLogTypes :: HashSet (EngineLogType Hasura)
_lsMetadataQueryLoggingMode :: MetadataQueryLoggingMode
..}
  -- See Note [Disable query printing for metadata queries]
  | Bool
isQueryLogEnabled Bool -> Bool -> Bool
&& Bool
isMetadataRequest = MetadataQueryLoggingMode
_lsMetadataQueryLoggingMode MetadataQueryLoggingMode -> MetadataQueryLoggingMode -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataQueryLoggingMode
MetadataQueryLoggingEnabled
  -- See Note [Disable query printing when query-log is disabled]
  | 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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
metadataUrlPaths

-- | Add the 'query' field to the http-log if `MetadataQueryLoggingMode`
-- is set to `MetadataQueryLoggingEnabled` else only adds the `query.type` field.
addQuery :: Maybe J.Value -> Text -> LoggingSettings -> Maybe J.Value
addQuery :: Maybe Value -> Text -> LoggingSettings -> Maybe Value
addQuery Maybe Value
parsedReq Text
path LoggingSettings
loggingSettings =
  if Text -> LoggingSettings -> Bool
isQueryIncludedInLogs Text
path LoggingSettings
loggingSettings
    then Maybe Value
parsedReq
    else Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object [Key
"type" Key -> Maybe (Maybe Text) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= ((Value -> Maybe Text) -> Maybe Value -> Maybe (Maybe Text)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"type" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)) Maybe Value
parsedReq]

mkHttpAccessLogContext ::
  -- | Maybe because it may not have been resolved
  Maybe UserInfo ->
  LoggingSettings ->
  RequestId ->
  Wai.Request ->
  (BL.ByteString, Maybe J.Value) ->
  -- | Size of response body, before compression
  Int64 ->
  BL.ByteString ->
  Maybe (DiffTime, DiffTime) ->
  Maybe CompressionType ->
  [HTTP.Header] ->
  RequestMode ->
  Maybe (GH.GQLBatchedReqs GQLBatchQueryOperationLog) ->
  HttpLogContext
mkHttpAccessLogContext :: Maybe UserInfo
-> LoggingSettings
-> RequestId
-> Request
-> (ByteString, Maybe Value)
-> Int64
-> 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) Int64
uncompressedResponseSize ByteString
res Maybe (DiffTime, DiffTime)
mTiming Maybe CompressionType
compressTypeM [Header]
headers RequestMode
batching Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
queryLogMetadata =
  let http :: HttpInfoLog
http =
        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
          { 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,
            olUncompressedResponseSize :: Int64
olUncompressedResponseSize = Int64
uncompressedResponseSize,
            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 = Maybe Value -> Text -> LoggingSettings -> Maybe Value
addQuery Maybe Value
parsedReq (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings,
            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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 -- This case is aleady handled in the `OperationLog`
                  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
gqolQuery :: GQLQueryOperationSuccessLog -> GQLReqUnparsed
gqolQueryExecutionTime :: GQLQueryOperationSuccessLog -> DiffTime
gqolResponseSize :: GQLQueryOperationSuccessLog -> Int64
gqolRequestSize :: GQLQueryOperationSuccessLog -> Int64
gqolParameterizedQueryHash :: GQLQueryOperationSuccessLog -> ParameterizedQueryHash
gqolQuery :: GQLReqUnparsed
gqolQueryExecutionTime :: DiffTime
gqolResponseSize :: Int64
gqolRequestSize :: Int64
gqolParameterizedQueryHash :: ParameterizedQueryHash
..}) ->
                              BatchOperationSuccessLog -> BatchOperationLog
BatchOperationSuccess
                                (BatchOperationSuccessLog -> BatchOperationLog)
-> BatchOperationSuccessLog -> BatchOperationLog
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Int64 -> Seconds -> BatchOperationSuccessLog
BatchOperationSuccessLog
                                  (Maybe Value -> Text -> LoggingSettings -> Maybe Value
addQuery Maybe Value
parsedReq (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings)
                                  Int64
gqolResponseSize
                                  (DiffTime -> Seconds
forall x y. (Duration x, Duration y) => x -> y
convertDuration DiffTime
gqolQueryExecutionTime)
                            GQLQueryOperationError (GQLQueryOperationErrorLog {QErr
GQLReqUnparsed
gqelQuery :: GQLQueryOperationErrorLog -> GQLReqUnparsed
gqelError :: GQLQueryOperationErrorLog -> QErr
gqelQuery :: GQLReqUnparsed
gqelError :: QErr
..}) ->
                              BatchOperationErrorLog -> BatchOperationLog
BatchOperationError
                                (BatchOperationErrorLog -> BatchOperationLog)
-> BatchOperationErrorLog -> BatchOperationLog
forall a b. (a -> b) -> a -> b
$ Maybe Value -> QErr -> BatchOperationErrorLog
BatchOperationErrorLog
                                  (Maybe Value -> Text -> LoggingSettings -> Maybe Value
addQuery Maybe Value
parsedReq (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings)
                                  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 because it may not have been resolved
  Maybe UserInfo ->
  LoggingSettings ->
  RequestId ->
  Wai.Request ->
  (BL.ByteString, Maybe J.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
          { 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
          }
      responseSize :: Int64
responseSize = ByteString -> Int64
BL.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ QErr -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode QErr
err
      op :: OperationLog
op =
        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
responseSize,
            olUncompressedResponseSize :: Int64
olUncompressedResponseSize = Int64
responseSize,
            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 = Maybe Value -> Text -> LoggingSettings -> Maybe Value
addQuery Maybe Value
parsedReq (HttpInfoLog -> Text
hlPath HttpInfoLog
http) LoggingSettings
loggingSettings,
            -- if parsedReq is Nothing, add the raw query
            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 :: forall a. 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 -- Batched operation logs are always reported in logHttpSuccess even if there are errors

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
J.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

-- | Log warning messages for deprecated environment variables
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
      -- The environment variables that have been initialized by user
      envVarsInitialized :: [String]
envVarsInitialized = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
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

  -- When a source named 'default' is present, it means that it is a migrated v2
  -- hasura project. In such cases log those environment variables that are moved
  -- to the metadata
  Maybe BackendSourceInfo -> (BackendSourceInfo -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.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 a. [a] -> 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

  -- Log when completely deprecated environment variables are present
  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 a. [a] -> 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

data SchemaSyncThreadType
  = TTListener
  | TTProcessor
  | TTMetadataApi
  deriving (SchemaSyncThreadType -> SchemaSyncThreadType -> Bool
(SchemaSyncThreadType -> SchemaSyncThreadType -> Bool)
-> (SchemaSyncThreadType -> SchemaSyncThreadType -> Bool)
-> Eq SchemaSyncThreadType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaSyncThreadType -> SchemaSyncThreadType -> Bool
== :: SchemaSyncThreadType -> SchemaSyncThreadType -> Bool
$c/= :: SchemaSyncThreadType -> SchemaSyncThreadType -> Bool
/= :: SchemaSyncThreadType -> SchemaSyncThreadType -> Bool
Eq)

instance Show SchemaSyncThreadType where
  show :: SchemaSyncThreadType -> String
show SchemaSyncThreadType
TTListener = String
"listener"
  show SchemaSyncThreadType
TTProcessor = String
"processor"
  show SchemaSyncThreadType
TTMetadataApi = String
"metadata-api"

data SchemaSyncLog = SchemaSyncLog
  { SchemaSyncLog -> LogLevel
sslLogLevel :: !LogLevel,
    SchemaSyncLog -> SchemaSyncThreadType
sslThreadType :: !SchemaSyncThreadType,
    SchemaSyncLog -> Value
sslInfo :: !J.Value
  }
  deriving (Int -> SchemaSyncLog -> ShowS
[SchemaSyncLog] -> ShowS
SchemaSyncLog -> String
(Int -> SchemaSyncLog -> ShowS)
-> (SchemaSyncLog -> String)
-> ([SchemaSyncLog] -> ShowS)
-> Show SchemaSyncLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaSyncLog -> ShowS
showsPrec :: Int -> SchemaSyncLog -> ShowS
$cshow :: SchemaSyncLog -> String
show :: SchemaSyncLog -> String
$cshowList :: [SchemaSyncLog] -> ShowS
showList :: [SchemaSyncLog] -> ShowS
Show, SchemaSyncLog -> SchemaSyncLog -> Bool
(SchemaSyncLog -> SchemaSyncLog -> Bool)
-> (SchemaSyncLog -> SchemaSyncLog -> Bool) -> Eq SchemaSyncLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaSyncLog -> SchemaSyncLog -> Bool
== :: SchemaSyncLog -> SchemaSyncLog -> Bool
$c/= :: SchemaSyncLog -> SchemaSyncLog -> Bool
/= :: SchemaSyncLog -> SchemaSyncLog -> Bool
Eq)

instance J.ToJSON SchemaSyncLog where
  toJSON :: SchemaSyncLog -> Value
toJSON (SchemaSyncLog LogLevel
_ SchemaSyncThreadType
t Value
info) =
    [Pair] -> Value
J.object
      [ Key
"thread_type" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= SchemaSyncThreadType -> String
forall a. Show a => a -> String
show SchemaSyncThreadType
t,
        Key
"info" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Value
info
      ]

instance ToEngineLog SchemaSyncLog Hasura where
  toEngineLog :: SchemaSyncLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog SchemaSyncLog
threadLog =
    (SchemaSyncLog -> LogLevel
sslLogLevel SchemaSyncLog
threadLog, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTSchemaSync, SchemaSyncLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON SchemaSyncLog
threadLog)