{-# LANGUAGE StandaloneKindSignatures #-}

-- |
-- This module holds functions and data types used for logging at the GraphQL
-- layer. Unlike QueryLog, these are fired after queries are finished so could
-- include things like execution time in future.
module Hasura.GraphQL.Logging.ExecutionLog
  ( ExecutionLog (..),
    ExecutionStats (..),
    statsToAnyBackend,
    MonadExecutionLog (..),
  )
where

import Data.Aeson qualified as J
import Data.Kind (Type)
import Hasura.EncJSON (EncJSON)
import Hasura.GraphQL.Execute.Backend (ActionResult (..))
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.RQL.Types.Backend (Backend (ExecutionStatistics))
import Hasura.RQL.Types.BackendTag (HasTag)
import Hasura.RQL.Types.BackendType (BackendType)
import Hasura.SQL.AnyBackend (AnyBackend, dispatchAnyBackend', mkAnyBackend)
import Hasura.Server.Types (RequestId)
import Hasura.Tracing (TraceT)

-- | A GraphQL query, optionally generated SQL, and the request id makes up the
-- | 'ExecutionLog'
data ExecutionLog = ExecutionLog
  { ExecutionLog -> RequestId
_elRequestId :: !RequestId,
    ExecutionLog -> Maybe (AnyBackend ExecutionStats)
_elStatistics :: !(Maybe (AnyBackend ExecutionStats))
  }

-- | 'ExecutionStatistics' is a type family, which means we can't partially
-- apply it (in 'AnyBackend', for example). To get round this, we have a
-- newtype that really just wraps the type family.
type ExecutionStats :: BackendType -> Type
newtype ExecutionStats b = ExecutionStats (ExecutionStatistics b)

-- | When we want to log anything from 'DBStepInfo', we first need to transform
-- the backend-specific execution statistics into 'AnyBackend' statistics. This
-- is fine in practice because all we do with it is log it as JSON.
statsToAnyBackend :: forall b. (HasTag b) => ActionResult b -> (Maybe (AnyBackend ExecutionStats), EncJSON)
statsToAnyBackend :: forall (b :: BackendType).
HasTag b =>
ActionResult b -> (Maybe (AnyBackend ExecutionStats), EncJSON)
statsToAnyBackend ActionResult {Maybe (ExecutionStatistics b)
EncJSON
arStatistics :: Maybe (ExecutionStatistics b)
arResult :: EncJSON
arStatistics :: forall (b :: BackendType).
ActionResult b -> Maybe (ExecutionStatistics b)
arResult :: forall (b :: BackendType). ActionResult b -> EncJSON
..} =
  ((ExecutionStatistics b -> AnyBackend ExecutionStats)
-> Maybe (ExecutionStatistics b)
-> Maybe (AnyBackend ExecutionStats)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
mkAnyBackend @b (ExecutionStats b -> AnyBackend ExecutionStats)
-> (ExecutionStatistics b -> ExecutionStats b)
-> ExecutionStatistics b
-> AnyBackend ExecutionStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutionStatistics b -> ExecutionStats b
forall (b :: BackendType).
ExecutionStatistics b -> ExecutionStats b
ExecutionStats) Maybe (ExecutionStatistics b)
arStatistics, EncJSON
arResult)

deriving newtype instance (Backend b) => J.ToJSON (ExecutionStats b)

instance J.ToJSON ExecutionLog where
  toJSON :: ExecutionLog -> Value
toJSON (ExecutionLog RequestId
reqId Maybe (AnyBackend ExecutionStats)
mstatistics) =
    [Pair] -> Value
J.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ 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
"statistics" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= case Maybe (AnyBackend ExecutionStats)
mstatistics of
            Just AnyBackend ExecutionStats
statistics -> forall (c :: * -> Constraint) (i :: BackendType -> *) r.
SatisfiesForAllBackends i c =>
AnyBackend i
-> (forall (b :: BackendType). c (i b) => i b -> r) -> r
dispatchAnyBackend' @J.ToJSON AnyBackend ExecutionStats
statistics ExecutionStats b -> Value
forall a. ToJSON a => a -> Value
forall (b :: BackendType).
ToJSON (ExecutionStats b) =>
ExecutionStats b -> Value
J.toJSON
            Maybe (AnyBackend ExecutionStats)
Nothing -> () -> Value
forall a. ToJSON a => a -> Value
J.toJSON ()
        ]

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

class (Monad m) => MonadExecutionLog m where
  logExecutionLog ::
    L.Logger L.Hasura ->
    ExecutionLog ->
    m ()

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

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

instance (MonadExecutionLog m) => MonadExecutionLog (TraceT m) where
  logExecutionLog :: Logger Hasura -> ExecutionLog -> TraceT m ()
logExecutionLog Logger Hasura
logger ExecutionLog
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 -> ExecutionLog -> m ()
forall (m :: * -> *).
MonadExecutionLog m =>
Logger Hasura -> ExecutionLog -> m ()
logExecutionLog Logger Hasura
logger ExecutionLog
l