module Hasura.GraphQL.Execute.Action.Types
  ( ActionContext (..),
    ActionExecution (..),
    ActionExecutionPlan (..),
    ActionHandlerLog (..),
    ActionInternalError (..),
    ActionRequestInfo (..),
    ActionResponseInfo (..),
    ActionWebhookErrorResponse (..),
    ActionWebhookPayload (..),
    ActionWebhookResponse,
    AsyncActionQueryExecution (..),
    AsyncActionQueryExecutionPlan (..),
    AsyncActionQuerySourceExecution (..),
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Int (Int64)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.RQL.IR.Select qualified as RS
import Hasura.RQL.IR.Value
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Headers (HeaderConf)
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Network.HTTP.Client.Transformable qualified as HTTP

newtype ActionExecution = ActionExecution
  { ActionExecution
-> forall (m :: * -> *).
   (MonadIO m, MonadBaseControl IO m, MonadError QErr m,
    MonadTrace m) =>
   m (EncJSON, ResponseHeaders)
unActionExecution ::
      forall m.
      (MonadIO m, MonadBaseControl IO m, MonadError QErr m, Tracing.MonadTrace m) =>
      m (EncJSON, HTTP.ResponseHeaders)
  }

data AsyncActionQuerySourceExecution v = AsyncActionQuerySourceExecution
  { forall v. AsyncActionQuerySourceExecution v -> SourceName
_aaqseSource :: !SourceName,
    forall v. AsyncActionQuerySourceExecution v -> JsonAggSelect
_aaqseJsonAggSelect :: !JsonAggSelect,
    forall v.
AsyncActionQuerySourceExecution v
-> ActionLogResponse
-> AnnSimpleSelectG ('Postgres 'Vanilla) Void v
_aaqseSelectBuilder :: !(ActionLogResponse -> RS.AnnSimpleSelectG ('Postgres 'Vanilla) Void v)
  }

data AsyncActionQueryExecution v
  = -- | Async actions associated with no relationships.
    AAQENoRelationships !(ActionLogResponse -> Either QErr EncJSON)
  | -- | Async actions with relationships defined to Postgres
    -- (as of now, we may have support for other backends as well in further iterations) tables.
    AAQEOnSourceDB !(SourceConfig ('Postgres 'Vanilla)) !(AsyncActionQuerySourceExecution v)

-- | A plan to execute async action query
data AsyncActionQueryExecutionPlan = AsyncActionQueryExecutionPlan
  { AsyncActionQueryExecutionPlan -> ActionId
_aaqepId :: !ActionId,
    AsyncActionQueryExecutionPlan
-> AsyncActionQueryExecution (UnpreparedValue ('Postgres 'Vanilla))
_aaqepExecution :: !(AsyncActionQueryExecution (UnpreparedValue ('Postgres 'Vanilla)))
  }

-- A plan to execute any action
data ActionExecutionPlan
  = AEPSync !ActionExecution
  | AEPAsyncQuery !AsyncActionQueryExecutionPlan
  | AEPAsyncMutation !ActionId

newtype ActionContext = ActionContext {ActionContext -> ActionName
_acName :: ActionName}
  deriving (Int -> ActionContext -> ShowS
[ActionContext] -> ShowS
ActionContext -> String
(Int -> ActionContext -> ShowS)
-> (ActionContext -> String)
-> ([ActionContext] -> ShowS)
-> Show ActionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionContext -> ShowS
showsPrec :: Int -> ActionContext -> ShowS
$cshow :: ActionContext -> String
show :: ActionContext -> String
$cshowList :: [ActionContext] -> ShowS
showList :: [ActionContext] -> ShowS
Show, ActionContext -> ActionContext -> Bool
(ActionContext -> ActionContext -> Bool)
-> (ActionContext -> ActionContext -> Bool) -> Eq ActionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionContext -> ActionContext -> Bool
== :: ActionContext -> ActionContext -> Bool
$c/= :: ActionContext -> ActionContext -> Bool
/= :: ActionContext -> ActionContext -> Bool
Eq, (forall x. ActionContext -> Rep ActionContext x)
-> (forall x. Rep ActionContext x -> ActionContext)
-> Generic ActionContext
forall x. Rep ActionContext x -> ActionContext
forall x. ActionContext -> Rep ActionContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionContext -> Rep ActionContext x
from :: forall x. ActionContext -> Rep ActionContext x
$cto :: forall x. Rep ActionContext x -> ActionContext
to :: forall x. Rep ActionContext x -> ActionContext
Generic)

instance J.FromJSON ActionContext where
  parseJSON :: Value -> Parser ActionContext
parseJSON = Options -> Value -> Parser ActionContext
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON (Int -> ShowS -> Options
J.aesonDrop Int
3 ShowS
J.snakeCase)

instance J.ToJSON ActionContext where
  toJSON :: ActionContext -> Value
toJSON = Options -> ActionContext -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
3 ShowS
J.snakeCase)
  toEncoding :: ActionContext -> Encoding
toEncoding = Options -> ActionContext -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
3 ShowS
J.snakeCase)

-- _awpRequestQuery is Nothing is case of Asynchronous actions
data ActionWebhookPayload = ActionWebhookPayload
  { ActionWebhookPayload -> ActionContext
_awpAction :: !ActionContext,
    ActionWebhookPayload -> SessionVariables
_awpSessionVariables :: !SessionVariables,
    ActionWebhookPayload -> Value
_awpInput :: !J.Value,
    ActionWebhookPayload -> Maybe GQLQueryText
_awpRequestQuery :: !(Maybe GQLQueryText)
  }
  deriving (Int -> ActionWebhookPayload -> ShowS
[ActionWebhookPayload] -> ShowS
ActionWebhookPayload -> String
(Int -> ActionWebhookPayload -> ShowS)
-> (ActionWebhookPayload -> String)
-> ([ActionWebhookPayload] -> ShowS)
-> Show ActionWebhookPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionWebhookPayload -> ShowS
showsPrec :: Int -> ActionWebhookPayload -> ShowS
$cshow :: ActionWebhookPayload -> String
show :: ActionWebhookPayload -> String
$cshowList :: [ActionWebhookPayload] -> ShowS
showList :: [ActionWebhookPayload] -> ShowS
Show, ActionWebhookPayload -> ActionWebhookPayload -> Bool
(ActionWebhookPayload -> ActionWebhookPayload -> Bool)
-> (ActionWebhookPayload -> ActionWebhookPayload -> Bool)
-> Eq ActionWebhookPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionWebhookPayload -> ActionWebhookPayload -> Bool
== :: ActionWebhookPayload -> ActionWebhookPayload -> Bool
$c/= :: ActionWebhookPayload -> ActionWebhookPayload -> Bool
/= :: ActionWebhookPayload -> ActionWebhookPayload -> Bool
Eq, (forall x. ActionWebhookPayload -> Rep ActionWebhookPayload x)
-> (forall x. Rep ActionWebhookPayload x -> ActionWebhookPayload)
-> Generic ActionWebhookPayload
forall x. Rep ActionWebhookPayload x -> ActionWebhookPayload
forall x. ActionWebhookPayload -> Rep ActionWebhookPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionWebhookPayload -> Rep ActionWebhookPayload x
from :: forall x. ActionWebhookPayload -> Rep ActionWebhookPayload x
$cto :: forall x. Rep ActionWebhookPayload x -> ActionWebhookPayload
to :: forall x. Rep ActionWebhookPayload x -> ActionWebhookPayload
Generic)

instance J.FromJSON ActionWebhookPayload where
  parseJSON :: Value -> Parser ActionWebhookPayload
parseJSON = Options -> Value -> Parser ActionWebhookPayload
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase)

instance J.ToJSON ActionWebhookPayload where
  toJSON :: ActionWebhookPayload -> Value
toJSON = Options -> ActionWebhookPayload -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase)
  toEncoding :: ActionWebhookPayload -> Encoding
toEncoding = Options -> ActionWebhookPayload -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase)

data ActionWebhookErrorResponse = ActionWebhookErrorResponse
  { ActionWebhookErrorResponse -> Text
_awerMessage :: !Text,
    ActionWebhookErrorResponse -> Maybe Text
_awerCode :: !(Maybe Text),
    ActionWebhookErrorResponse -> Maybe Value
_awerExtensions :: !(Maybe J.Value)
  }
  deriving (Int -> ActionWebhookErrorResponse -> ShowS
[ActionWebhookErrorResponse] -> ShowS
ActionWebhookErrorResponse -> String
(Int -> ActionWebhookErrorResponse -> ShowS)
-> (ActionWebhookErrorResponse -> String)
-> ([ActionWebhookErrorResponse] -> ShowS)
-> Show ActionWebhookErrorResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionWebhookErrorResponse -> ShowS
showsPrec :: Int -> ActionWebhookErrorResponse -> ShowS
$cshow :: ActionWebhookErrorResponse -> String
show :: ActionWebhookErrorResponse -> String
$cshowList :: [ActionWebhookErrorResponse] -> ShowS
showList :: [ActionWebhookErrorResponse] -> ShowS
Show, ActionWebhookErrorResponse -> ActionWebhookErrorResponse -> Bool
(ActionWebhookErrorResponse -> ActionWebhookErrorResponse -> Bool)
-> (ActionWebhookErrorResponse
    -> ActionWebhookErrorResponse -> Bool)
-> Eq ActionWebhookErrorResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionWebhookErrorResponse -> ActionWebhookErrorResponse -> Bool
== :: ActionWebhookErrorResponse -> ActionWebhookErrorResponse -> Bool
$c/= :: ActionWebhookErrorResponse -> ActionWebhookErrorResponse -> Bool
/= :: ActionWebhookErrorResponse -> ActionWebhookErrorResponse -> Bool
Eq, (forall x.
 ActionWebhookErrorResponse -> Rep ActionWebhookErrorResponse x)
-> (forall x.
    Rep ActionWebhookErrorResponse x -> ActionWebhookErrorResponse)
-> Generic ActionWebhookErrorResponse
forall x.
Rep ActionWebhookErrorResponse x -> ActionWebhookErrorResponse
forall x.
ActionWebhookErrorResponse -> Rep ActionWebhookErrorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ActionWebhookErrorResponse -> Rep ActionWebhookErrorResponse x
from :: forall x.
ActionWebhookErrorResponse -> Rep ActionWebhookErrorResponse x
$cto :: forall x.
Rep ActionWebhookErrorResponse x -> ActionWebhookErrorResponse
to :: forall x.
Rep ActionWebhookErrorResponse x -> ActionWebhookErrorResponse
Generic)

instance J.FromJSON ActionWebhookErrorResponse where
  parseJSON :: Value -> Parser ActionWebhookErrorResponse
parseJSON = Options -> Value -> Parser ActionWebhookErrorResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON (Int -> ShowS -> Options
J.aesonDrop Int
5 ShowS
J.snakeCase)

instance J.ToJSON ActionWebhookErrorResponse where
  toJSON :: ActionWebhookErrorResponse -> Value
toJSON = Options -> ActionWebhookErrorResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
5 ShowS
J.snakeCase)
  toEncoding :: ActionWebhookErrorResponse -> Encoding
toEncoding = Options -> ActionWebhookErrorResponse -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
5 ShowS
J.snakeCase)

type ActionWebhookResponse = J.Value

data ActionRequestInfo = ActionRequestInfo
  { ActionRequestInfo -> Text
_areqiUrl :: !Text,
    ActionRequestInfo -> Value
_areqiBody :: !J.Value,
    ActionRequestInfo -> [HeaderConf]
_areqiHeaders :: ![HeaderConf],
    ActionRequestInfo -> Maybe Request
_areqiTransformedRequest :: !(Maybe HTTP.Request)
  }
  deriving (Int -> ActionRequestInfo -> ShowS
[ActionRequestInfo] -> ShowS
ActionRequestInfo -> String
(Int -> ActionRequestInfo -> ShowS)
-> (ActionRequestInfo -> String)
-> ([ActionRequestInfo] -> ShowS)
-> Show ActionRequestInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionRequestInfo -> ShowS
showsPrec :: Int -> ActionRequestInfo -> ShowS
$cshow :: ActionRequestInfo -> String
show :: ActionRequestInfo -> String
$cshowList :: [ActionRequestInfo] -> ShowS
showList :: [ActionRequestInfo] -> ShowS
Show, (forall x. ActionRequestInfo -> Rep ActionRequestInfo x)
-> (forall x. Rep ActionRequestInfo x -> ActionRequestInfo)
-> Generic ActionRequestInfo
forall x. Rep ActionRequestInfo x -> ActionRequestInfo
forall x. ActionRequestInfo -> Rep ActionRequestInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionRequestInfo -> Rep ActionRequestInfo x
from :: forall x. ActionRequestInfo -> Rep ActionRequestInfo x
$cto :: forall x. Rep ActionRequestInfo x -> ActionRequestInfo
to :: forall x. Rep ActionRequestInfo x -> ActionRequestInfo
Generic)

instance J.ToJSON ActionRequestInfo where
  toJSON :: ActionRequestInfo -> Value
toJSON = Options -> ActionRequestInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
6 ShowS
J.snakeCase)
  toEncoding :: ActionRequestInfo -> Encoding
toEncoding = Options -> ActionRequestInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
6 ShowS
J.snakeCase)

data ActionResponseInfo = ActionResponseInfo
  { ActionResponseInfo -> Int
_aresiStatus :: !Int,
    ActionResponseInfo -> Value
_aresiBody :: !J.Value,
    ActionResponseInfo -> [HeaderConf]
_aresiHeaders :: ![HeaderConf]
  }
  deriving (Int -> ActionResponseInfo -> ShowS
[ActionResponseInfo] -> ShowS
ActionResponseInfo -> String
(Int -> ActionResponseInfo -> ShowS)
-> (ActionResponseInfo -> String)
-> ([ActionResponseInfo] -> ShowS)
-> Show ActionResponseInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionResponseInfo -> ShowS
showsPrec :: Int -> ActionResponseInfo -> ShowS
$cshow :: ActionResponseInfo -> String
show :: ActionResponseInfo -> String
$cshowList :: [ActionResponseInfo] -> ShowS
showList :: [ActionResponseInfo] -> ShowS
Show, ActionResponseInfo -> ActionResponseInfo -> Bool
(ActionResponseInfo -> ActionResponseInfo -> Bool)
-> (ActionResponseInfo -> ActionResponseInfo -> Bool)
-> Eq ActionResponseInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionResponseInfo -> ActionResponseInfo -> Bool
== :: ActionResponseInfo -> ActionResponseInfo -> Bool
$c/= :: ActionResponseInfo -> ActionResponseInfo -> Bool
/= :: ActionResponseInfo -> ActionResponseInfo -> Bool
Eq, (forall x. ActionResponseInfo -> Rep ActionResponseInfo x)
-> (forall x. Rep ActionResponseInfo x -> ActionResponseInfo)
-> Generic ActionResponseInfo
forall x. Rep ActionResponseInfo x -> ActionResponseInfo
forall x. ActionResponseInfo -> Rep ActionResponseInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionResponseInfo -> Rep ActionResponseInfo x
from :: forall x. ActionResponseInfo -> Rep ActionResponseInfo x
$cto :: forall x. Rep ActionResponseInfo x -> ActionResponseInfo
to :: forall x. Rep ActionResponseInfo x -> ActionResponseInfo
Generic)

instance J.FromJSON ActionResponseInfo where
  parseJSON :: Value -> Parser ActionResponseInfo
parseJSON = Options -> Value -> Parser ActionResponseInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON (Int -> ShowS -> Options
J.aesonDrop Int
6 ShowS
J.snakeCase)

instance J.ToJSON ActionResponseInfo where
  toJSON :: ActionResponseInfo -> Value
toJSON = Options -> ActionResponseInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
6 ShowS
J.snakeCase)
  toEncoding :: ActionResponseInfo -> Encoding
toEncoding = Options -> ActionResponseInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
6 ShowS
J.snakeCase)

data ActionInternalError = ActionInternalError
  { ActionInternalError -> Value
_aieError :: !J.Value,
    ActionInternalError -> ActionRequestInfo
_aieRequest :: !ActionRequestInfo,
    ActionInternalError -> Maybe ActionResponseInfo
_aieResponse :: !(Maybe ActionResponseInfo)
  }
  deriving (Int -> ActionInternalError -> ShowS
[ActionInternalError] -> ShowS
ActionInternalError -> String
(Int -> ActionInternalError -> ShowS)
-> (ActionInternalError -> String)
-> ([ActionInternalError] -> ShowS)
-> Show ActionInternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionInternalError -> ShowS
showsPrec :: Int -> ActionInternalError -> ShowS
$cshow :: ActionInternalError -> String
show :: ActionInternalError -> String
$cshowList :: [ActionInternalError] -> ShowS
showList :: [ActionInternalError] -> ShowS
Show, (forall x. ActionInternalError -> Rep ActionInternalError x)
-> (forall x. Rep ActionInternalError x -> ActionInternalError)
-> Generic ActionInternalError
forall x. Rep ActionInternalError x -> ActionInternalError
forall x. ActionInternalError -> Rep ActionInternalError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionInternalError -> Rep ActionInternalError x
from :: forall x. ActionInternalError -> Rep ActionInternalError x
$cto :: forall x. Rep ActionInternalError x -> ActionInternalError
to :: forall x. Rep ActionInternalError x -> ActionInternalError
Generic)

instance J.ToJSON ActionInternalError where
  toJSON :: ActionInternalError -> Value
toJSON = Options -> ActionInternalError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase)
  toEncoding :: ActionInternalError -> Encoding
toEncoding = Options -> ActionInternalError -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase)

-- * Action handler logging related

data ActionHandlerLog = ActionHandlerLog
  { ActionHandlerLog -> Request
_ahlRequest :: !HTTP.Request,
    ActionHandlerLog -> Maybe Request
_ahlRequestTrans :: !(Maybe HTTP.Request),
    ActionHandlerLog -> Int64
_ahlRequestSize :: !Int64,
    ActionHandlerLog -> Maybe Int64
_ahlTransformedRequestSize :: !(Maybe Int64),
    ActionHandlerLog -> Int64
_ahlResponseSize :: !Int64,
    ActionHandlerLog -> ActionName
_ahlActionName :: !ActionName
  }
  deriving (Int -> ActionHandlerLog -> ShowS
[ActionHandlerLog] -> ShowS
ActionHandlerLog -> String
(Int -> ActionHandlerLog -> ShowS)
-> (ActionHandlerLog -> String)
-> ([ActionHandlerLog] -> ShowS)
-> Show ActionHandlerLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionHandlerLog -> ShowS
showsPrec :: Int -> ActionHandlerLog -> ShowS
$cshow :: ActionHandlerLog -> String
show :: ActionHandlerLog -> String
$cshowList :: [ActionHandlerLog] -> ShowS
showList :: [ActionHandlerLog] -> ShowS
Show, (forall x. ActionHandlerLog -> Rep ActionHandlerLog x)
-> (forall x. Rep ActionHandlerLog x -> ActionHandlerLog)
-> Generic ActionHandlerLog
forall x. Rep ActionHandlerLog x -> ActionHandlerLog
forall x. ActionHandlerLog -> Rep ActionHandlerLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionHandlerLog -> Rep ActionHandlerLog x
from :: forall x. ActionHandlerLog -> Rep ActionHandlerLog x
$cto :: forall x. Rep ActionHandlerLog x -> ActionHandlerLog
to :: forall x. Rep ActionHandlerLog x -> ActionHandlerLog
Generic)

instance J.ToJSON ActionHandlerLog where
  toJSON :: ActionHandlerLog -> Value
toJSON = Options -> ActionHandlerLog -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}
  toEncoding :: ActionHandlerLog -> Encoding
toEncoding = Options -> ActionHandlerLog -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding (Int -> ShowS -> Options
J.aesonDrop Int
4 ShowS
J.snakeCase) {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

instance L.ToEngineLog ActionHandlerLog L.Hasura where
  toEngineLog :: ActionHandlerLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog ActionHandlerLog
ahl = (LogLevel
L.LevelInfo, EngineLogType Hasura
L.ELTActionHandler, ActionHandlerLog -> Value
forall a. ToJSON a => a -> Value
J.toJSON ActionHandlerLog
ahl)