-- |
-- This module holds functions and data types used for logging at the GraphQL
-- layer. In contrast with, logging at the HTTP server layer.
module Hasura.GraphQL.Logging.QueryLog
  ( QueryLog (..),
    GeneratedQuery (..),
    MonadQueryLog (..),
    QueryLogKind (..),
  )
where

import Data.Aeson qualified as J
import Data.HashMap.Strict qualified as HashMap
import Data.Text.Extended
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed)
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.RQL.DDL.ConnectionTemplate (BackendResolvedConnectionTemplate (..))
import Hasura.Server.Types (RequestId)
import Hasura.Tracing (TraceT)

-- | A GraphQL query, optionally generated SQL, and the request id makes up the
-- | 'QueryLog'
data QueryLog = QueryLog
  { QueryLog -> GQLReqUnparsed
_qlQuery :: !GQLReqUnparsed,
    QueryLog -> Maybe (RootFieldAlias, GeneratedQuery)
_qlGeneratedSql :: !(Maybe (RootFieldAlias, GeneratedQuery)),
    QueryLog -> RequestId
_qlRequestId :: !RequestId,
    QueryLog -> QueryLogKind
_qlKind :: !QueryLogKind
  }

data QueryLogKind
  = QueryLogKindDatabase (Maybe (BackendResolvedConnectionTemplate))
  | QueryLogKindAction
  | QueryLogKindRemoteSchema
  | QueryLogKindCached
  | QueryLogKindIntrospection

instance J.ToJSON QueryLogKind where
  toJSON :: QueryLogKind -> Value
toJSON = \case
    QueryLogKindDatabase Maybe BackendResolvedConnectionTemplate
_ -> Value
"database"
    QueryLogKind
QueryLogKindAction -> Value
"action"
    QueryLogKind
QueryLogKindRemoteSchema -> Value
"remote-schema"
    QueryLogKind
QueryLogKindCached -> Value
"cached"
    QueryLogKind
QueryLogKindIntrospection -> Value
"introspection"

data GeneratedQuery = GeneratedQuery
  { GeneratedQuery -> Text
_gqQueryString :: Text,
    GeneratedQuery -> Value
_gqPreparedArgs :: J.Value
  }

instance J.ToJSON QueryLog where
  toJSON :: QueryLog -> Value
toJSON (QueryLog GQLReqUnparsed
gqlQuery Maybe (RootFieldAlias, GeneratedQuery)
generatedQuery RequestId
reqId QueryLogKind
kind) =
    [Pair] -> Value
J.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"query" Key -> GQLReqUnparsed -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= GQLReqUnparsed
gqlQuery,
          -- NOTE: this customizes the default JSON instance of a pair
          Key
"generated_sql" Key -> Maybe (HashMap Text GeneratedQuery) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= ((RootFieldAlias, GeneratedQuery) -> HashMap Text GeneratedQuery)
-> Maybe (RootFieldAlias, GeneratedQuery)
-> Maybe (HashMap Text GeneratedQuery)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RootFieldAlias, GeneratedQuery) -> HashMap Text GeneratedQuery
forall {b} {v}. ToTxt b => (b, v) -> HashMap Text v
fromPair Maybe (RootFieldAlias, GeneratedQuery)
generatedQuery,
          Key
"request_id" Key -> RequestId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RequestId
reqId,
          Key
"kind" Key -> QueryLogKind -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= QueryLogKind
kind
        ]
      [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
-> (BackendResolvedConnectionTemplate -> [Pair])
-> Maybe BackendResolvedConnectionTemplate
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\BackendResolvedConnectionTemplate
val -> [Key
"connection_template" Key -> BackendResolvedConnectionTemplate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= BackendResolvedConnectionTemplate
val]) (QueryLogKind -> Maybe BackendResolvedConnectionTemplate
getResolvedConnectionTemplate QueryLogKind
kind)
    where
      fromPair :: (b, v) -> HashMap Text v
fromPair (b, v)
p = [(Text, v)] -> HashMap Text v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(b -> Text) -> (b, v) -> (Text, v)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first b -> Text
forall a. ToTxt a => a -> Text
toTxt (b, v)
p]
      getResolvedConnectionTemplate :: QueryLogKind -> Maybe (BackendResolvedConnectionTemplate)
      getResolvedConnectionTemplate :: QueryLogKind -> Maybe BackendResolvedConnectionTemplate
getResolvedConnectionTemplate (QueryLogKindDatabase Maybe BackendResolvedConnectionTemplate
x) = Maybe BackendResolvedConnectionTemplate
x
      getResolvedConnectionTemplate QueryLogKind
_ = Maybe BackendResolvedConnectionTemplate
forall a. Maybe a
Nothing

instance J.ToJSON GeneratedQuery where
  toJSON :: GeneratedQuery -> Value
toJSON (GeneratedQuery Text
queryString Value
preparedArgs) =
    [Pair] -> Value
J.object
      [ Key
"query" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
queryString,
        Key
"prepared_arguments" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Value
preparedArgs
      ]

instance L.ToEngineLog QueryLog L.Hasura where
  toEngineLog :: QueryLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog QueryLog
ql = (LogLevel
L.LevelInfo, EngineLogType Hasura
L.ELTQueryLog, QueryLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON QueryLog
ql)

class (Monad m) => MonadQueryLog m where
  logQueryLog ::
    L.Logger L.Hasura ->
    QueryLog ->
    m ()

instance (MonadQueryLog m) => MonadQueryLog (ExceptT e m) where
  logQueryLog :: Logger Hasura -> QueryLog -> ExceptT e m ()
logQueryLog Logger Hasura
logger QueryLog
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 -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger QueryLog
l

instance (MonadQueryLog m) => MonadQueryLog (ReaderT r m) where
  logQueryLog :: Logger Hasura -> QueryLog -> ReaderT r m ()
logQueryLog Logger Hasura
logger QueryLog
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 -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger QueryLog
l

instance (MonadQueryLog m) => MonadQueryLog (TraceT m) where
  logQueryLog :: Logger Hasura -> QueryLog -> TraceT m ()
logQueryLog Logger Hasura
logger QueryLog
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 -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
logQueryLog Logger Hasura
logger QueryLog
l