-- |
-- 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 (..),
    GeneratedQuery (..),
    MonadQueryLog (..),
    QueryLogKind (..),
  )
where

import Data.Aeson qualified as J
import Data.HashMap.Strict qualified as Map
import Data.Text.Extended
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed)
import Hasura.Logging qualified as L
import Hasura.Metadata.Class
import Hasura.Prelude
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
  | QueryLogKindAction
  | QueryLogKindRemoteSchema
  | QueryLogKindCached
  | QueryLogKindIntrospection

instance J.ToJSON QueryLogKind where
  toJSON :: QueryLogKind -> Value
toJSON = \case
    QueryLogKind
QueryLogKindDatabase -> 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
      [ Key
"query" Key -> GQLReqUnparsed -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
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
J..= ((RootFieldAlias, GeneratedQuery) -> HashMap Text GeneratedQuery)
-> Maybe (RootFieldAlias, GeneratedQuery)
-> Maybe (HashMap Text GeneratedQuery)
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
J..= RequestId
reqId,
        Key
"kind" Key -> QueryLogKind -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= 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
Map.fromList [(b -> Text) -> (b, v) -> (Text, v)
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]

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
J..= Text
queryString,
        Key
"prepared_arguments" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
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 (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 (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 (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

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