{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.Action
  ( -- * Metadata
    ActionMetadata (..),
    amName,
    amComment,
    amDefinition,
    amPermissions,
    ActionPermissionMetadata (..),
    ActionName (..),
    ActionId (..),
    actionIdToText,
    ActionDefinitionInput,

    -- ** Definition
    ActionDefinition (..),
    adArguments,
    adOutputType,
    adType,
    adForwardClientHeaders,
    adHeaders,
    adHandler,
    adTimeout,
    adRequestTransform,
    adResponseTransform,
    ActionType (..),
    ActionMutationKind (..),

    -- ** Arguments
    ArgumentDefinition (..),
    ArgumentName (..),

    -- * Schema cache
    ActionInfo (..),
    aiName,
    aiComment,
    aiDefinition,
    aiOutputType,
    aiPermissions,
    aiForwardedClientHeaders,
    ActionPermissionInfo (..),
    ResolvedActionDefinition,

    -- * Execution types
    ActionExecContext (..),
    ActionLogResponse (..),
    ActionLogResponseMap,
    ActionLogItem (..),
    LockedActionEventId,
    LockedActionIdArray (..),
    AsyncActionStatus (..),
    ActionsInfo (..),
  )
where

import Autodocodec (HasCodec, dimapCodec, disjointEitherCodec, optionalField', optionalFieldWith', optionalFieldWithDefault', optionalFieldWithOmittedDefault', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (boundedEnumCodec, discriminatorField, graphQLFieldDescriptionCodec, graphQLFieldNameCodec, typeableName)
import Control.Lens (makeLenses)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Aeson.Extended
import Data.Text.Extended
import Data.Time.Clock qualified as UTC
import Data.Typeable (Typeable)
import Data.UUID qualified as UUID
import Database.PG.Query qualified as PG
import Database.PG.Query.PTI qualified as PTI
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Eventing (EventId (..))
import Hasura.RQL.Types.Headers
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RQL.Types.Session (SessionVariables)
import Hasura.RQL.Types.Webhook.Transform (MetadataResponseTransform, RequestTransform)
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Types qualified as HTTP
import PostgreSQL.Binary.Encoding qualified as PE

--------------------------------------------------------------------------------
-- Metadata

data ActionMetadata = ActionMetadata
  { ActionMetadata -> ActionName
_amName :: ActionName,
    ActionMetadata -> Maybe Text
_amComment :: Maybe Text,
    ActionMetadata -> ActionDefinitionInput
_amDefinition :: ActionDefinitionInput,
    ActionMetadata -> [ActionPermissionMetadata]
_amPermissions :: [ActionPermissionMetadata]
  }
  deriving (Int -> ActionMetadata -> ShowS
[ActionMetadata] -> ShowS
ActionMetadata -> String
(Int -> ActionMetadata -> ShowS)
-> (ActionMetadata -> String)
-> ([ActionMetadata] -> ShowS)
-> Show ActionMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionMetadata -> ShowS
showsPrec :: Int -> ActionMetadata -> ShowS
$cshow :: ActionMetadata -> String
show :: ActionMetadata -> String
$cshowList :: [ActionMetadata] -> ShowS
showList :: [ActionMetadata] -> ShowS
Show, ActionMetadata -> ActionMetadata -> Bool
(ActionMetadata -> ActionMetadata -> Bool)
-> (ActionMetadata -> ActionMetadata -> Bool) -> Eq ActionMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionMetadata -> ActionMetadata -> Bool
== :: ActionMetadata -> ActionMetadata -> Bool
$c/= :: ActionMetadata -> ActionMetadata -> Bool
/= :: ActionMetadata -> ActionMetadata -> Bool
Eq, (forall x. ActionMetadata -> Rep ActionMetadata x)
-> (forall x. Rep ActionMetadata x -> ActionMetadata)
-> Generic ActionMetadata
forall x. Rep ActionMetadata x -> ActionMetadata
forall x. ActionMetadata -> Rep ActionMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionMetadata -> Rep ActionMetadata x
from :: forall x. ActionMetadata -> Rep ActionMetadata x
$cto :: forall x. Rep ActionMetadata x -> ActionMetadata
to :: forall x. Rep ActionMetadata x -> ActionMetadata
Generic)

instance NFData ActionMetadata

instance HasCodec ActionMetadata where
  codec :: JSONCodec ActionMetadata
codec =
    Text
-> ObjectCodec ActionMetadata ActionMetadata
-> JSONCodec ActionMetadata
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ActionMetadata"
      (ObjectCodec ActionMetadata ActionMetadata
 -> JSONCodec ActionMetadata)
-> ObjectCodec ActionMetadata ActionMetadata
-> JSONCodec ActionMetadata
forall a b. (a -> b) -> a -> b
$ ActionName
-> Maybe Text
-> ActionDefinitionInput
-> [ActionPermissionMetadata]
-> ActionMetadata
ActionMetadata
      (ActionName
 -> Maybe Text
 -> ActionDefinitionInput
 -> [ActionPermissionMetadata]
 -> ActionMetadata)
-> Codec Object ActionMetadata ActionName
-> Codec
     Object
     ActionMetadata
     (Maybe Text
      -> ActionDefinitionInput
      -> [ActionPermissionMetadata]
      -> ActionMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec ActionName ActionName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec ActionName ActionName
-> (ActionMetadata -> ActionName)
-> Codec Object ActionMetadata ActionName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionMetadata -> ActionName
_amName
        Codec
  Object
  ActionMetadata
  (Maybe Text
   -> ActionDefinitionInput
   -> [ActionPermissionMetadata]
   -> ActionMetadata)
-> Codec Object ActionMetadata (Maybe Text)
-> Codec
     Object
     ActionMetadata
     (ActionDefinitionInput
      -> [ActionPermissionMetadata] -> ActionMetadata)
forall a b.
Codec Object ActionMetadata (a -> b)
-> Codec Object ActionMetadata a -> Codec Object ActionMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"comment"
      ObjectCodec (Maybe Text) (Maybe Text)
-> (ActionMetadata -> Maybe Text)
-> Codec Object ActionMetadata (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionMetadata -> Maybe Text
_amComment
        Codec
  Object
  ActionMetadata
  (ActionDefinitionInput
   -> [ActionPermissionMetadata] -> ActionMetadata)
-> Codec Object ActionMetadata ActionDefinitionInput
-> Codec
     Object
     ActionMetadata
     ([ActionPermissionMetadata] -> ActionMetadata)
forall a b.
Codec Object ActionMetadata (a -> b)
-> Codec Object ActionMetadata a -> Codec Object ActionMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ActionDefinitionInput ActionDefinitionInput
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"definition"
      ObjectCodec ActionDefinitionInput ActionDefinitionInput
-> (ActionMetadata -> ActionDefinitionInput)
-> Codec Object ActionMetadata ActionDefinitionInput
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionMetadata -> ActionDefinitionInput
_amDefinition
        Codec
  Object
  ActionMetadata
  ([ActionPermissionMetadata] -> ActionMetadata)
-> Codec Object ActionMetadata [ActionPermissionMetadata]
-> ObjectCodec ActionMetadata ActionMetadata
forall a b.
Codec Object ActionMetadata (a -> b)
-> Codec Object ActionMetadata a -> Codec Object ActionMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> [ActionPermissionMetadata]
-> ObjectCodec
     [ActionPermissionMetadata] [ActionPermissionMetadata]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"permissions" []
      ObjectCodec [ActionPermissionMetadata] [ActionPermissionMetadata]
-> (ActionMetadata -> [ActionPermissionMetadata])
-> Codec Object ActionMetadata [ActionPermissionMetadata]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionMetadata -> [ActionPermissionMetadata]
_amPermissions

data ActionPermissionMetadata = ActionPermissionMetadata
  { ActionPermissionMetadata -> RoleName
_apmRole :: RoleName,
    ActionPermissionMetadata -> Maybe Text
_apmComment :: Maybe Text
  }
  deriving (Int -> ActionPermissionMetadata -> ShowS
[ActionPermissionMetadata] -> ShowS
ActionPermissionMetadata -> String
(Int -> ActionPermissionMetadata -> ShowS)
-> (ActionPermissionMetadata -> String)
-> ([ActionPermissionMetadata] -> ShowS)
-> Show ActionPermissionMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionPermissionMetadata -> ShowS
showsPrec :: Int -> ActionPermissionMetadata -> ShowS
$cshow :: ActionPermissionMetadata -> String
show :: ActionPermissionMetadata -> String
$cshowList :: [ActionPermissionMetadata] -> ShowS
showList :: [ActionPermissionMetadata] -> ShowS
Show, ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
(ActionPermissionMetadata -> ActionPermissionMetadata -> Bool)
-> (ActionPermissionMetadata -> ActionPermissionMetadata -> Bool)
-> Eq ActionPermissionMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
== :: ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
$c/= :: ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
/= :: ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
Eq, (forall x.
 ActionPermissionMetadata -> Rep ActionPermissionMetadata x)
-> (forall x.
    Rep ActionPermissionMetadata x -> ActionPermissionMetadata)
-> Generic ActionPermissionMetadata
forall x.
Rep ActionPermissionMetadata x -> ActionPermissionMetadata
forall x.
ActionPermissionMetadata -> Rep ActionPermissionMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ActionPermissionMetadata -> Rep ActionPermissionMetadata x
from :: forall x.
ActionPermissionMetadata -> Rep ActionPermissionMetadata x
$cto :: forall x.
Rep ActionPermissionMetadata x -> ActionPermissionMetadata
to :: forall x.
Rep ActionPermissionMetadata x -> ActionPermissionMetadata
Generic)

instance NFData ActionPermissionMetadata

instance HasCodec ActionPermissionMetadata where
  codec :: JSONCodec ActionPermissionMetadata
codec =
    Text
-> ObjectCodec ActionPermissionMetadata ActionPermissionMetadata
-> JSONCodec ActionPermissionMetadata
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ActionPermissionMetadata"
      (ObjectCodec ActionPermissionMetadata ActionPermissionMetadata
 -> JSONCodec ActionPermissionMetadata)
-> ObjectCodec ActionPermissionMetadata ActionPermissionMetadata
-> JSONCodec ActionPermissionMetadata
forall a b. (a -> b) -> a -> b
$ RoleName -> Maybe Text -> ActionPermissionMetadata
ActionPermissionMetadata
      (RoleName -> Maybe Text -> ActionPermissionMetadata)
-> Codec Object ActionPermissionMetadata RoleName
-> Codec
     Object
     ActionPermissionMetadata
     (Maybe Text -> ActionPermissionMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RoleName RoleName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"role"
      ObjectCodec RoleName RoleName
-> (ActionPermissionMetadata -> RoleName)
-> Codec Object ActionPermissionMetadata RoleName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionPermissionMetadata -> RoleName
_apmRole
        Codec
  Object
  ActionPermissionMetadata
  (Maybe Text -> ActionPermissionMetadata)
-> Codec Object ActionPermissionMetadata (Maybe Text)
-> ObjectCodec ActionPermissionMetadata ActionPermissionMetadata
forall a b.
Codec Object ActionPermissionMetadata (a -> b)
-> Codec Object ActionPermissionMetadata a
-> Codec Object ActionPermissionMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"comment"
      ObjectCodec (Maybe Text) (Maybe Text)
-> (ActionPermissionMetadata -> Maybe Text)
-> Codec Object ActionPermissionMetadata (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionPermissionMetadata -> Maybe Text
_apmComment

newtype ActionName = ActionName {ActionName -> Name
unActionName :: G.Name}
  deriving (Int -> ActionName -> ShowS
[ActionName] -> ShowS
ActionName -> String
(Int -> ActionName -> ShowS)
-> (ActionName -> String)
-> ([ActionName] -> ShowS)
-> Show ActionName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionName -> ShowS
showsPrec :: Int -> ActionName -> ShowS
$cshow :: ActionName -> String
show :: ActionName -> String
$cshowList :: [ActionName] -> ShowS
showList :: [ActionName] -> ShowS
Show, ActionName -> ActionName -> Bool
(ActionName -> ActionName -> Bool)
-> (ActionName -> ActionName -> Bool) -> Eq ActionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionName -> ActionName -> Bool
== :: ActionName -> ActionName -> Bool
$c/= :: ActionName -> ActionName -> Bool
/= :: ActionName -> ActionName -> Bool
Eq, Eq ActionName
Eq ActionName
-> (ActionName -> ActionName -> Ordering)
-> (ActionName -> ActionName -> Bool)
-> (ActionName -> ActionName -> Bool)
-> (ActionName -> ActionName -> Bool)
-> (ActionName -> ActionName -> Bool)
-> (ActionName -> ActionName -> ActionName)
-> (ActionName -> ActionName -> ActionName)
-> Ord ActionName
ActionName -> ActionName -> Bool
ActionName -> ActionName -> Ordering
ActionName -> ActionName -> ActionName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ActionName -> ActionName -> Ordering
compare :: ActionName -> ActionName -> Ordering
$c< :: ActionName -> ActionName -> Bool
< :: ActionName -> ActionName -> Bool
$c<= :: ActionName -> ActionName -> Bool
<= :: ActionName -> ActionName -> Bool
$c> :: ActionName -> ActionName -> Bool
> :: ActionName -> ActionName -> Bool
$c>= :: ActionName -> ActionName -> Bool
>= :: ActionName -> ActionName -> Bool
$cmax :: ActionName -> ActionName -> ActionName
max :: ActionName -> ActionName -> ActionName
$cmin :: ActionName -> ActionName -> ActionName
min :: ActionName -> ActionName -> ActionName
Ord, Value -> Parser [ActionName]
Value -> Parser ActionName
(Value -> Parser ActionName)
-> (Value -> Parser [ActionName]) -> FromJSON ActionName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActionName
parseJSON :: Value -> Parser ActionName
$cparseJSONList :: Value -> Parser [ActionName]
parseJSONList :: Value -> Parser [ActionName]
J.FromJSON, [ActionName] -> Value
[ActionName] -> Encoding
ActionName -> Value
ActionName -> Encoding
(ActionName -> Value)
-> (ActionName -> Encoding)
-> ([ActionName] -> Value)
-> ([ActionName] -> Encoding)
-> ToJSON ActionName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActionName -> Value
toJSON :: ActionName -> Value
$ctoEncoding :: ActionName -> Encoding
toEncoding :: ActionName -> Encoding
$ctoJSONList :: [ActionName] -> Value
toJSONList :: [ActionName] -> Value
$ctoEncodingList :: [ActionName] -> Encoding
toEncodingList :: [ActionName] -> Encoding
J.ToJSON, FromJSONKeyFunction [ActionName]
FromJSONKeyFunction ActionName
FromJSONKeyFunction ActionName
-> FromJSONKeyFunction [ActionName] -> FromJSONKey ActionName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction ActionName
fromJSONKey :: FromJSONKeyFunction ActionName
$cfromJSONKeyList :: FromJSONKeyFunction [ActionName]
fromJSONKeyList :: FromJSONKeyFunction [ActionName]
J.FromJSONKey, ToJSONKeyFunction [ActionName]
ToJSONKeyFunction ActionName
ToJSONKeyFunction ActionName
-> ToJSONKeyFunction [ActionName] -> ToJSONKey ActionName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ActionName
toJSONKey :: ToJSONKeyFunction ActionName
$ctoJSONKeyList :: ToJSONKeyFunction [ActionName]
toJSONKeyList :: ToJSONKeyFunction [ActionName]
J.ToJSONKey, ActionName -> Text
(ActionName -> Text) -> ToTxt ActionName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ActionName -> Text
toTxt :: ActionName -> Text
ToTxt, (forall x. ActionName -> Rep ActionName x)
-> (forall x. Rep ActionName x -> ActionName) -> Generic ActionName
forall x. Rep ActionName x -> ActionName
forall x. ActionName -> Rep ActionName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionName -> Rep ActionName x
from :: forall x. ActionName -> Rep ActionName x
$cto :: forall x. Rep ActionName x -> ActionName
to :: forall x. Rep ActionName x -> ActionName
Generic, ActionName -> ()
(ActionName -> ()) -> NFData ActionName
forall a. (a -> ()) -> NFData a
$crnf :: ActionName -> ()
rnf :: ActionName -> ()
NFData, Eq ActionName
Eq ActionName
-> (Int -> ActionName -> Int)
-> (ActionName -> Int)
-> Hashable ActionName
Int -> ActionName -> Int
ActionName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ActionName -> Int
hashWithSalt :: Int -> ActionName -> Int
$chash :: ActionName -> Int
hash :: ActionName -> Int
Hashable)

instance HasCodec ActionName where
  codec :: JSONCodec ActionName
codec = (Name -> ActionName)
-> (ActionName -> Name)
-> Codec Value Name Name
-> JSONCodec ActionName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> ActionName
ActionName ActionName -> Name
unActionName Codec Value Name Name
graphQLFieldNameCodec

newtype ActionId = ActionId {ActionId -> UUID
unActionId :: UUID.UUID}
  deriving (Int -> ActionId -> ShowS
[ActionId] -> ShowS
ActionId -> String
(Int -> ActionId -> ShowS)
-> (ActionId -> String) -> ([ActionId] -> ShowS) -> Show ActionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionId -> ShowS
showsPrec :: Int -> ActionId -> ShowS
$cshow :: ActionId -> String
show :: ActionId -> String
$cshowList :: [ActionId] -> ShowS
showList :: [ActionId] -> ShowS
Show, ActionId -> ActionId -> Bool
(ActionId -> ActionId -> Bool)
-> (ActionId -> ActionId -> Bool) -> Eq ActionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionId -> ActionId -> Bool
== :: ActionId -> ActionId -> Bool
$c/= :: ActionId -> ActionId -> Bool
/= :: ActionId -> ActionId -> Bool
Eq, ActionId -> PrepArg
(ActionId -> PrepArg) -> ToPrepArg ActionId
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: ActionId -> PrepArg
toPrepVal :: ActionId -> PrepArg
PG.ToPrepArg, Maybe ByteString -> Either Text ActionId
(Maybe ByteString -> Either Text ActionId) -> FromCol ActionId
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text ActionId
fromCol :: Maybe ByteString -> Either Text ActionId
PG.FromCol, [ActionId] -> Value
[ActionId] -> Encoding
ActionId -> Value
ActionId -> Encoding
(ActionId -> Value)
-> (ActionId -> Encoding)
-> ([ActionId] -> Value)
-> ([ActionId] -> Encoding)
-> ToJSON ActionId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActionId -> Value
toJSON :: ActionId -> Value
$ctoEncoding :: ActionId -> Encoding
toEncoding :: ActionId -> Encoding
$ctoJSONList :: [ActionId] -> Value
toJSONList :: [ActionId] -> Value
$ctoEncodingList :: [ActionId] -> Encoding
toEncodingList :: [ActionId] -> Encoding
J.ToJSON, Value -> Parser [ActionId]
Value -> Parser ActionId
(Value -> Parser ActionId)
-> (Value -> Parser [ActionId]) -> FromJSON ActionId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActionId
parseJSON :: Value -> Parser ActionId
$cparseJSONList :: Value -> Parser [ActionId]
parseJSONList :: Value -> Parser [ActionId]
J.FromJSON, Eq ActionId
Eq ActionId
-> (Int -> ActionId -> Int)
-> (ActionId -> Int)
-> Hashable ActionId
Int -> ActionId -> Int
ActionId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ActionId -> Int
hashWithSalt :: Int -> ActionId -> Int
$chash :: ActionId -> Int
hash :: ActionId -> Int
Hashable)

actionIdToText :: ActionId -> Text
actionIdToText :: ActionId -> Text
actionIdToText = UUID -> Text
UUID.toText (UUID -> Text) -> (ActionId -> UUID) -> ActionId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionId -> UUID
unActionId

-- Required in the context of event triggers?
-- TODO: document this / get rid of it
instance PG.FromCol ActionName where
  fromCol :: Maybe ByteString -> Either Text ActionName
fromCol Maybe ByteString
bs = do
    Text
text <- Maybe ByteString -> Either Text Text
forall a. FromCol a => Maybe ByteString -> Either Text a
PG.fromCol Maybe ByteString
bs
    Name
name <- Text -> Maybe Name
G.mkName Text
text Maybe Name -> Either Text Name -> Either Text Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> Either Text Name
forall a b. a -> Either a b
Left (Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not valid GraphQL name")
    ActionName -> Either Text ActionName
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionName -> Either Text ActionName)
-> ActionName -> Either Text ActionName
forall a b. (a -> b) -> a -> b
$ Name -> ActionName
ActionName Name
name

-- For legacy catalog format.
instance PG.ToPrepArg ActionName where
  toPrepVal :: ActionName -> PrepArg
toPrepVal = Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
PG.toPrepVal (Text -> PrepArg) -> (ActionName -> Text) -> ActionName -> PrepArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName (Name -> Text) -> (ActionName -> Name) -> ActionName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionName -> Name
unActionName

type ActionDefinitionInput =
  ActionDefinition GraphQLType InputWebhook

--------------------------------------------------------------------------------
-- Definition

data ActionDefinition arg webhook = ActionDefinition
  { forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adArguments :: [ArgumentDefinition arg],
    forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adOutputType :: GraphQLType,
    forall arg webhook. ActionDefinition arg webhook -> ActionType
_adType :: ActionType,
    forall arg webhook. ActionDefinition arg webhook -> [HeaderConf]
_adHeaders :: [HeaderConf],
    forall arg webhook. ActionDefinition arg webhook -> Bool
_adForwardClientHeaders :: Bool,
    -- | If the timeout is not provided by the user, then
    -- the default timeout of 30 seconds will be used
    forall arg webhook. ActionDefinition arg webhook -> Timeout
_adTimeout :: Timeout,
    forall arg webhook. ActionDefinition arg webhook -> webhook
_adHandler :: webhook,
    forall arg webhook.
ActionDefinition arg webhook -> Maybe RequestTransform
_adRequestTransform :: Maybe RequestTransform,
    forall arg webhook.
ActionDefinition arg webhook -> Maybe MetadataResponseTransform
_adResponseTransform :: Maybe MetadataResponseTransform
  }
  deriving (Int -> ActionDefinition arg webhook -> ShowS
[ActionDefinition arg webhook] -> ShowS
ActionDefinition arg webhook -> String
(Int -> ActionDefinition arg webhook -> ShowS)
-> (ActionDefinition arg webhook -> String)
-> ([ActionDefinition arg webhook] -> ShowS)
-> Show (ActionDefinition arg webhook)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall arg webhook.
(Show arg, Show webhook) =>
Int -> ActionDefinition arg webhook -> ShowS
forall arg webhook.
(Show arg, Show webhook) =>
[ActionDefinition arg webhook] -> ShowS
forall arg webhook.
(Show arg, Show webhook) =>
ActionDefinition arg webhook -> String
$cshowsPrec :: forall arg webhook.
(Show arg, Show webhook) =>
Int -> ActionDefinition arg webhook -> ShowS
showsPrec :: Int -> ActionDefinition arg webhook -> ShowS
$cshow :: forall arg webhook.
(Show arg, Show webhook) =>
ActionDefinition arg webhook -> String
show :: ActionDefinition arg webhook -> String
$cshowList :: forall arg webhook.
(Show arg, Show webhook) =>
[ActionDefinition arg webhook] -> ShowS
showList :: [ActionDefinition arg webhook] -> ShowS
Show, ActionDefinition arg webhook
-> ActionDefinition arg webhook -> Bool
(ActionDefinition arg webhook
 -> ActionDefinition arg webhook -> Bool)
-> (ActionDefinition arg webhook
    -> ActionDefinition arg webhook -> Bool)
-> Eq (ActionDefinition arg webhook)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall arg webhook.
(Eq arg, Eq webhook) =>
ActionDefinition arg webhook
-> ActionDefinition arg webhook -> Bool
$c== :: forall arg webhook.
(Eq arg, Eq webhook) =>
ActionDefinition arg webhook
-> ActionDefinition arg webhook -> Bool
== :: ActionDefinition arg webhook
-> ActionDefinition arg webhook -> Bool
$c/= :: forall arg webhook.
(Eq arg, Eq webhook) =>
ActionDefinition arg webhook
-> ActionDefinition arg webhook -> Bool
/= :: ActionDefinition arg webhook
-> ActionDefinition arg webhook -> Bool
Eq, (forall a b.
 (a -> b) -> ActionDefinition arg a -> ActionDefinition arg b)
-> (forall a b.
    a -> ActionDefinition arg b -> ActionDefinition arg a)
-> Functor (ActionDefinition arg)
forall a b. a -> ActionDefinition arg b -> ActionDefinition arg a
forall a b.
(a -> b) -> ActionDefinition arg a -> ActionDefinition arg b
forall arg a b.
a -> ActionDefinition arg b -> ActionDefinition arg a
forall arg a b.
(a -> b) -> ActionDefinition arg a -> ActionDefinition arg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall arg a b.
(a -> b) -> ActionDefinition arg a -> ActionDefinition arg b
fmap :: forall a b.
(a -> b) -> ActionDefinition arg a -> ActionDefinition arg b
$c<$ :: forall arg a b.
a -> ActionDefinition arg b -> ActionDefinition arg a
<$ :: forall a b. a -> ActionDefinition arg b -> ActionDefinition arg a
Functor, (forall m. Monoid m => ActionDefinition arg m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ActionDefinition arg a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ActionDefinition arg a -> m)
-> (forall a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b)
-> (forall a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b)
-> (forall b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b)
-> (forall b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b)
-> (forall a. (a -> a -> a) -> ActionDefinition arg a -> a)
-> (forall a. (a -> a -> a) -> ActionDefinition arg a -> a)
-> (forall a. ActionDefinition arg a -> [a])
-> (forall a. ActionDefinition arg a -> Bool)
-> (forall a. ActionDefinition arg a -> Int)
-> (forall a. Eq a => a -> ActionDefinition arg a -> Bool)
-> (forall a. Ord a => ActionDefinition arg a -> a)
-> (forall a. Ord a => ActionDefinition arg a -> a)
-> (forall a. Num a => ActionDefinition arg a -> a)
-> (forall a. Num a => ActionDefinition arg a -> a)
-> Foldable (ActionDefinition arg)
forall a. Eq a => a -> ActionDefinition arg a -> Bool
forall a. Num a => ActionDefinition arg a -> a
forall a. Ord a => ActionDefinition arg a -> a
forall m. Monoid m => ActionDefinition arg m -> m
forall a. ActionDefinition arg a -> Bool
forall a. ActionDefinition arg a -> Int
forall a. ActionDefinition arg a -> [a]
forall a. (a -> a -> a) -> ActionDefinition arg a -> a
forall arg a. Eq a => a -> ActionDefinition arg a -> Bool
forall arg a. Num a => ActionDefinition arg a -> a
forall arg a. Ord a => ActionDefinition arg a -> a
forall m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
forall arg m. Monoid m => ActionDefinition arg m -> m
forall arg webhook. ActionDefinition arg webhook -> Bool
forall arg a. ActionDefinition arg a -> Int
forall arg a. ActionDefinition arg a -> [a]
forall b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
forall a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
forall arg a. (a -> a -> a) -> ActionDefinition arg a -> a
forall arg m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
forall arg b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
forall arg a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall arg m. Monoid m => ActionDefinition arg m -> m
fold :: forall m. Monoid m => ActionDefinition arg m -> m
$cfoldMap :: forall arg m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
$cfoldMap' :: forall arg m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
$cfoldr :: forall arg a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
$cfoldr' :: forall arg a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
$cfoldl :: forall arg b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
$cfoldl' :: forall arg b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
$cfoldr1 :: forall arg a. (a -> a -> a) -> ActionDefinition arg a -> a
foldr1 :: forall a. (a -> a -> a) -> ActionDefinition arg a -> a
$cfoldl1 :: forall arg a. (a -> a -> a) -> ActionDefinition arg a -> a
foldl1 :: forall a. (a -> a -> a) -> ActionDefinition arg a -> a
$ctoList :: forall arg a. ActionDefinition arg a -> [a]
toList :: forall a. ActionDefinition arg a -> [a]
$cnull :: forall arg webhook. ActionDefinition arg webhook -> Bool
null :: forall a. ActionDefinition arg a -> Bool
$clength :: forall arg a. ActionDefinition arg a -> Int
length :: forall a. ActionDefinition arg a -> Int
$celem :: forall arg a. Eq a => a -> ActionDefinition arg a -> Bool
elem :: forall a. Eq a => a -> ActionDefinition arg a -> Bool
$cmaximum :: forall arg a. Ord a => ActionDefinition arg a -> a
maximum :: forall a. Ord a => ActionDefinition arg a -> a
$cminimum :: forall arg a. Ord a => ActionDefinition arg a -> a
minimum :: forall a. Ord a => ActionDefinition arg a -> a
$csum :: forall arg a. Num a => ActionDefinition arg a -> a
sum :: forall a. Num a => ActionDefinition arg a -> a
$cproduct :: forall arg a. Num a => ActionDefinition arg a -> a
product :: forall a. Num a => ActionDefinition arg a -> a
Foldable, Functor (ActionDefinition arg)
Foldable (ActionDefinition arg)
Functor (ActionDefinition arg)
-> Foldable (ActionDefinition arg)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ActionDefinition arg a -> f (ActionDefinition arg b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ActionDefinition arg (f a) -> f (ActionDefinition arg a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ActionDefinition arg a -> m (ActionDefinition arg b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ActionDefinition arg (m a) -> m (ActionDefinition arg a))
-> Traversable (ActionDefinition arg)
forall arg. Functor (ActionDefinition arg)
forall arg. Foldable (ActionDefinition arg)
forall arg (m :: * -> *) a.
Monad m =>
ActionDefinition arg (m a) -> m (ActionDefinition arg a)
forall arg (f :: * -> *) a.
Applicative f =>
ActionDefinition arg (f a) -> f (ActionDefinition arg a)
forall arg (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ActionDefinition arg a -> m (ActionDefinition arg b)
forall arg (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ActionDefinition arg a -> f (ActionDefinition arg b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ActionDefinition arg (m a) -> m (ActionDefinition arg a)
forall (f :: * -> *) a.
Applicative f =>
ActionDefinition arg (f a) -> f (ActionDefinition arg a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ActionDefinition arg a -> m (ActionDefinition arg b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ActionDefinition arg a -> f (ActionDefinition arg b)
$ctraverse :: forall arg (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ActionDefinition arg a -> f (ActionDefinition arg b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ActionDefinition arg a -> f (ActionDefinition arg b)
$csequenceA :: forall arg (f :: * -> *) a.
Applicative f =>
ActionDefinition arg (f a) -> f (ActionDefinition arg a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ActionDefinition arg (f a) -> f (ActionDefinition arg a)
$cmapM :: forall arg (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ActionDefinition arg a -> m (ActionDefinition arg b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ActionDefinition arg a -> m (ActionDefinition arg b)
$csequence :: forall arg (m :: * -> *) a.
Monad m =>
ActionDefinition arg (m a) -> m (ActionDefinition arg a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ActionDefinition arg (m a) -> m (ActionDefinition arg a)
Traversable, (forall x.
 ActionDefinition arg webhook
 -> Rep (ActionDefinition arg webhook) x)
-> (forall x.
    Rep (ActionDefinition arg webhook) x
    -> ActionDefinition arg webhook)
-> Generic (ActionDefinition arg webhook)
forall x.
Rep (ActionDefinition arg webhook) x
-> ActionDefinition arg webhook
forall x.
ActionDefinition arg webhook
-> Rep (ActionDefinition arg webhook) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall arg webhook x.
Rep (ActionDefinition arg webhook) x
-> ActionDefinition arg webhook
forall arg webhook x.
ActionDefinition arg webhook
-> Rep (ActionDefinition arg webhook) x
$cfrom :: forall arg webhook x.
ActionDefinition arg webhook
-> Rep (ActionDefinition arg webhook) x
from :: forall x.
ActionDefinition arg webhook
-> Rep (ActionDefinition arg webhook) x
$cto :: forall arg webhook x.
Rep (ActionDefinition arg webhook) x
-> ActionDefinition arg webhook
to :: forall x.
Rep (ActionDefinition arg webhook) x
-> ActionDefinition arg webhook
Generic)

instance (NFData a, NFData w) => NFData (ActionDefinition a w)

instance
  (Eq arg, HasCodec (ArgumentDefinition arg), HasCodec webhook, Typeable arg, Typeable webhook) =>
  HasCodec (ActionDefinition arg webhook)
  where
  codec :: JSONCodec (ActionDefinition arg webhook)
codec =
    (Either
   (ActionDefinition arg webhook) (ActionDefinition arg webhook)
 -> ActionDefinition arg webhook)
-> (ActionDefinition arg webhook
    -> Either
         (ActionDefinition arg webhook) (ActionDefinition arg webhook))
-> Codec
     Value
     (Either
        (ActionDefinition arg webhook) (ActionDefinition arg webhook))
     (Either
        (ActionDefinition arg webhook) (ActionDefinition arg webhook))
-> JSONCodec (ActionDefinition arg webhook)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either
  (ActionDefinition arg webhook) (ActionDefinition arg webhook)
-> ActionDefinition arg webhook
forall {a}. Either a a -> a
dec ActionDefinition arg webhook
-> Either
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
forall {arg} {webhook}.
ActionDefinition arg webhook
-> Either
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
enc
      (Codec
   Value
   (Either
      (ActionDefinition arg webhook) (ActionDefinition arg webhook))
   (Either
      (ActionDefinition arg webhook) (ActionDefinition arg webhook))
 -> JSONCodec (ActionDefinition arg webhook))
-> Codec
     Value
     (Either
        (ActionDefinition arg webhook) (ActionDefinition arg webhook))
     (Either
        (ActionDefinition arg webhook) (ActionDefinition arg webhook))
-> JSONCodec (ActionDefinition arg webhook)
forall a b. (a -> b) -> a -> b
$ JSONCodec (ActionDefinition arg webhook)
-> JSONCodec (ActionDefinition arg webhook)
-> Codec
     Value
     (Either
        (ActionDefinition arg webhook) (ActionDefinition arg webhook))
     (Either
        (ActionDefinition arg webhook) (ActionDefinition arg webhook))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec ((ActionMutationKind -> ActionType)
-> JSONCodec (ActionDefinition arg webhook)
actionCodec (ActionType -> ActionMutationKind -> ActionType
forall a b. a -> b -> a
const ActionType
ActionQuery)) ((ActionMutationKind -> ActionType)
-> JSONCodec (ActionDefinition arg webhook)
actionCodec ActionMutationKind -> ActionType
ActionMutation)
    where
      actionCodec :: (ActionMutationKind -> ActionType) -> AC.JSONCodec (ActionDefinition arg webhook)
      actionCodec :: (ActionMutationKind -> ActionType)
-> JSONCodec (ActionDefinition arg webhook)
actionCodec ActionMutationKind -> ActionType
actionTypeConstructor =
        Text
-> ObjectCodec
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
-> JSONCodec (ActionDefinition arg webhook)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object ((ActionMutationKind -> ActionType) -> Text
typeId ActionMutationKind -> ActionType
actionTypeConstructor)
          (ObjectCodec
   (ActionDefinition arg webhook) (ActionDefinition arg webhook)
 -> JSONCodec (ActionDefinition arg webhook))
-> ObjectCodec
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
-> JSONCodec (ActionDefinition arg webhook)
forall a b. (a -> b) -> a -> b
$ [ArgumentDefinition arg]
-> GraphQLType
-> ActionType
-> [HeaderConf]
-> Bool
-> Timeout
-> webhook
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> ActionDefinition arg webhook
forall arg webhook.
[ArgumentDefinition arg]
-> GraphQLType
-> ActionType
-> [HeaderConf]
-> Bool
-> Timeout
-> webhook
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> ActionDefinition arg webhook
ActionDefinition
          ([ArgumentDefinition arg]
 -> GraphQLType
 -> ActionType
 -> [HeaderConf]
 -> Bool
 -> Timeout
 -> webhook
 -> Maybe RequestTransform
 -> Maybe MetadataResponseTransform
 -> ActionDefinition arg webhook)
-> Codec
     Object (ActionDefinition arg webhook) [ArgumentDefinition arg]
-> Codec
     Object
     (ActionDefinition arg webhook)
     (GraphQLType
      -> ActionType
      -> [HeaderConf]
      -> Bool
      -> Timeout
      -> webhook
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> ActionDefinition arg webhook)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> [ArgumentDefinition arg]
-> ObjectCodec [ArgumentDefinition arg] [ArgumentDefinition arg]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"arguments" []
          ObjectCodec [ArgumentDefinition arg] [ArgumentDefinition arg]
-> (ActionDefinition arg webhook -> [ArgumentDefinition arg])
-> Codec
     Object (ActionDefinition arg webhook) [ArgumentDefinition arg]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> [ArgumentDefinition arg]
forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adArguments
            Codec
  Object
  (ActionDefinition arg webhook)
  (GraphQLType
   -> ActionType
   -> [HeaderConf]
   -> Bool
   -> Timeout
   -> webhook
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> ActionDefinition arg webhook)
-> Codec Object (ActionDefinition arg webhook) GraphQLType
-> Codec
     Object
     (ActionDefinition arg webhook)
     (ActionType
      -> [HeaderConf]
      -> Bool
      -> Timeout
      -> webhook
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec GraphQLType GraphQLType
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"output_type"
          ObjectCodec GraphQLType GraphQLType
-> (ActionDefinition arg webhook -> GraphQLType)
-> Codec Object (ActionDefinition arg webhook) GraphQLType
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> GraphQLType
forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adOutputType
            Codec
  Object
  (ActionDefinition arg webhook)
  (ActionType
   -> [HeaderConf]
   -> Bool
   -> Timeout
   -> webhook
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> ActionDefinition arg webhook)
-> Codec Object (ActionDefinition arg webhook) ActionType
-> Codec
     Object
     (ActionDefinition arg webhook)
     ([HeaderConf]
      -> Bool
      -> Timeout
      -> webhook
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ActionMutationKind -> ActionType)
-> ObjectCodec ActionType ActionType
typeAndKind ActionMutationKind -> ActionType
actionTypeConstructor
          ObjectCodec ActionType ActionType
-> (ActionDefinition arg webhook -> ActionType)
-> Codec Object (ActionDefinition arg webhook) ActionType
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> ActionType
forall arg webhook. ActionDefinition arg webhook -> ActionType
_adType
            Codec
  Object
  (ActionDefinition arg webhook)
  ([HeaderConf]
   -> Bool
   -> Timeout
   -> webhook
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> ActionDefinition arg webhook)
-> Codec Object (ActionDefinition arg webhook) [HeaderConf]
-> Codec
     Object
     (ActionDefinition arg webhook)
     (Bool
      -> Timeout
      -> webhook
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> [HeaderConf] -> ObjectCodec [HeaderConf] [HeaderConf]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"headers" []
          ObjectCodec [HeaderConf] [HeaderConf]
-> (ActionDefinition arg webhook -> [HeaderConf])
-> Codec Object (ActionDefinition arg webhook) [HeaderConf]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> [HeaderConf]
forall arg webhook. ActionDefinition arg webhook -> [HeaderConf]
_adHeaders
            Codec
  Object
  (ActionDefinition arg webhook)
  (Bool
   -> Timeout
   -> webhook
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> ActionDefinition arg webhook)
-> Codec Object (ActionDefinition arg webhook) Bool
-> Codec
     Object
     (ActionDefinition arg webhook)
     (Timeout
      -> webhook
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Bool -> ObjectCodec Bool Bool
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"forward_client_headers" Bool
False
          ObjectCodec Bool Bool
-> (ActionDefinition arg webhook -> Bool)
-> Codec Object (ActionDefinition arg webhook) Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> Bool
forall arg webhook. ActionDefinition arg webhook -> Bool
_adForwardClientHeaders
            Codec
  Object
  (ActionDefinition arg webhook)
  (Timeout
   -> webhook
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> ActionDefinition arg webhook)
-> Codec Object (ActionDefinition arg webhook) Timeout
-> Codec
     Object
     (ActionDefinition arg webhook)
     (webhook
      -> Maybe RequestTransform
      -> Maybe MetadataResponseTransform
      -> ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Timeout -> ObjectCodec Timeout Timeout
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"timeout" Timeout
defaultActionTimeoutSecs
          ObjectCodec Timeout Timeout
-> (ActionDefinition arg webhook -> Timeout)
-> Codec Object (ActionDefinition arg webhook) Timeout
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> Timeout
forall arg webhook. ActionDefinition arg webhook -> Timeout
_adTimeout
            Codec
  Object
  (ActionDefinition arg webhook)
  (webhook
   -> Maybe RequestTransform
   -> Maybe MetadataResponseTransform
   -> ActionDefinition arg webhook)
-> Codec Object (ActionDefinition arg webhook) webhook
-> Codec
     Object
     (ActionDefinition arg webhook)
     (Maybe RequestTransform
      -> Maybe MetadataResponseTransform -> ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec webhook webhook
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"handler"
          ObjectCodec webhook webhook
-> (ActionDefinition arg webhook -> webhook)
-> Codec Object (ActionDefinition arg webhook) webhook
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> webhook
forall arg webhook. ActionDefinition arg webhook -> webhook
_adHandler
            Codec
  Object
  (ActionDefinition arg webhook)
  (Maybe RequestTransform
   -> Maybe MetadataResponseTransform -> ActionDefinition arg webhook)
-> Codec
     Object (ActionDefinition arg webhook) (Maybe RequestTransform)
-> Codec
     Object
     (ActionDefinition arg webhook)
     (Maybe MetadataResponseTransform -> ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec (Maybe RequestTransform) (Maybe RequestTransform)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"request_transform"
          ObjectCodec (Maybe RequestTransform) (Maybe RequestTransform)
-> (ActionDefinition arg webhook -> Maybe RequestTransform)
-> Codec
     Object (ActionDefinition arg webhook) (Maybe RequestTransform)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> Maybe RequestTransform
forall arg webhook.
ActionDefinition arg webhook -> Maybe RequestTransform
_adRequestTransform
            Codec
  Object
  (ActionDefinition arg webhook)
  (Maybe MetadataResponseTransform -> ActionDefinition arg webhook)
-> Codec
     Object
     (ActionDefinition arg webhook)
     (Maybe MetadataResponseTransform)
-> ObjectCodec
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
forall a b.
Codec Object (ActionDefinition arg webhook) (a -> b)
-> Codec Object (ActionDefinition arg webhook) a
-> Codec Object (ActionDefinition arg webhook) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe MetadataResponseTransform) (Maybe MetadataResponseTransform)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"response_transform"
          ObjectCodec
  (Maybe MetadataResponseTransform) (Maybe MetadataResponseTransform)
-> (ActionDefinition arg webhook
    -> Maybe MetadataResponseTransform)
-> Codec
     Object
     (ActionDefinition arg webhook)
     (Maybe MetadataResponseTransform)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ActionDefinition arg webhook -> Maybe MetadataResponseTransform
forall arg webhook.
ActionDefinition arg webhook -> Maybe MetadataResponseTransform
_adResponseTransform

      typeAndKind :: (ActionMutationKind -> ActionType) -> AC.ObjectCodec ActionType ActionType
      typeAndKind :: (ActionMutationKind -> ActionType)
-> ObjectCodec ActionType ActionType
typeAndKind ActionMutationKind -> ActionType
actionTypeConstructor = case (ActionMutationKind -> ActionType
actionTypeConstructor ActionMutationKind
ActionSynchronous) of
        (ActionMutation ActionMutationKind
_) ->
          ActionMutationKind -> ActionType
ActionMutation
            (ActionMutationKind -> ActionType)
-> Codec Object ActionType ()
-> Codec Object ActionType (ActionMutationKind -> ActionType)
forall a b.
a -> Codec Object ActionType b -> Codec Object ActionType a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Text -> Codec Object ActionType ()
forall a. Text -> Text -> ObjectCodec a ()
discriminatorField Text
"type" Text
"mutation"
            Codec Object ActionType (ActionMutationKind -> ActionType)
-> Codec Object ActionType ActionMutationKind
-> ObjectCodec ActionType ActionType
forall a b.
Codec Object ActionType (a -> b)
-> Codec Object ActionType a -> Codec Object ActionType b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ActionMutationKind
-> ObjectCodec ActionMutationKind ActionMutationKind
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"kind" ActionMutationKind
ActionSynchronous
            ObjectCodec ActionMutationKind ActionMutationKind
-> (ActionType -> ActionMutationKind)
-> Codec Object ActionType ActionMutationKind
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= \case
              (ActionMutation ActionMutationKind
kind) -> ActionMutationKind
kind
              ActionType
ActionQuery -> ActionMutationKind
ActionSynchronous
        ActionType
ActionQuery -> ActionType
ActionQuery ActionType
-> Codec Object ActionType () -> ObjectCodec ActionType ActionType
forall a b.
a -> Codec Object ActionType b -> Codec Object ActionType a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Text -> Codec Object ActionType ()
forall a. Text -> Text -> ObjectCodec a ()
discriminatorField Text
"type" Text
"query"

      dec :: Either a a -> a
dec (Left a
a) = a
a
      dec (Right a
a) = a
a
      enc :: ActionDefinition arg webhook
-> Either
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
enc ActionDefinition arg webhook
a
        | ActionDefinition arg webhook -> ActionType
forall arg webhook. ActionDefinition arg webhook -> ActionType
_adType ActionDefinition arg webhook
a ActionType -> ActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ActionType
ActionQuery = ActionDefinition arg webhook
-> Either
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
forall a b. a -> Either a b
Left ActionDefinition arg webhook
a
        | Bool
otherwise = ActionDefinition arg webhook
-> Either
     (ActionDefinition arg webhook) (ActionDefinition arg webhook)
forall a b. b -> Either a b
Right ActionDefinition arg webhook
a

      typeId :: (ActionMutationKind -> ActionType) -> Text
typeId ActionMutationKind -> ActionType
actionTypeConstructor =
        let typeLabel :: Text
typeLabel = case (ActionMutationKind -> ActionType
actionTypeConstructor ActionMutationKind
ActionSynchronous) of
              (ActionMutation ActionMutationKind
_) -> Text
"Mutation"
              ActionType
ActionQuery -> Text
"Query"
         in Text
"ActionDefinition_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @arg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @webhook

data ActionType
  = ActionQuery
  | ActionMutation ActionMutationKind
  deriving (Int -> ActionType -> ShowS
[ActionType] -> ShowS
ActionType -> String
(Int -> ActionType -> ShowS)
-> (ActionType -> String)
-> ([ActionType] -> ShowS)
-> Show ActionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionType -> ShowS
showsPrec :: Int -> ActionType -> ShowS
$cshow :: ActionType -> String
show :: ActionType -> String
$cshowList :: [ActionType] -> ShowS
showList :: [ActionType] -> ShowS
Show, ActionType -> ActionType -> Bool
(ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool) -> Eq ActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionType -> ActionType -> Bool
== :: ActionType -> ActionType -> Bool
$c/= :: ActionType -> ActionType -> Bool
/= :: ActionType -> ActionType -> Bool
Eq, (forall x. ActionType -> Rep ActionType x)
-> (forall x. Rep ActionType x -> ActionType) -> Generic ActionType
forall x. Rep ActionType x -> ActionType
forall x. ActionType -> Rep ActionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionType -> Rep ActionType x
from :: forall x. ActionType -> Rep ActionType x
$cto :: forall x. Rep ActionType x -> ActionType
to :: forall x. Rep ActionType x -> ActionType
Generic)

instance NFData ActionType

data ActionMutationKind
  = ActionSynchronous
  | ActionAsynchronous
  deriving (Int -> ActionMutationKind -> ShowS
[ActionMutationKind] -> ShowS
ActionMutationKind -> String
(Int -> ActionMutationKind -> ShowS)
-> (ActionMutationKind -> String)
-> ([ActionMutationKind] -> ShowS)
-> Show ActionMutationKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionMutationKind -> ShowS
showsPrec :: Int -> ActionMutationKind -> ShowS
$cshow :: ActionMutationKind -> String
show :: ActionMutationKind -> String
$cshowList :: [ActionMutationKind] -> ShowS
showList :: [ActionMutationKind] -> ShowS
Show, ActionMutationKind
ActionMutationKind
-> ActionMutationKind -> Bounded ActionMutationKind
forall a. a -> a -> Bounded a
$cminBound :: ActionMutationKind
minBound :: ActionMutationKind
$cmaxBound :: ActionMutationKind
maxBound :: ActionMutationKind
Bounded, Int -> ActionMutationKind
ActionMutationKind -> Int
ActionMutationKind -> [ActionMutationKind]
ActionMutationKind -> ActionMutationKind
ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
ActionMutationKind
-> ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
(ActionMutationKind -> ActionMutationKind)
-> (ActionMutationKind -> ActionMutationKind)
-> (Int -> ActionMutationKind)
-> (ActionMutationKind -> Int)
-> (ActionMutationKind -> [ActionMutationKind])
-> (ActionMutationKind
    -> ActionMutationKind -> [ActionMutationKind])
-> (ActionMutationKind
    -> ActionMutationKind -> [ActionMutationKind])
-> (ActionMutationKind
    -> ActionMutationKind
    -> ActionMutationKind
    -> [ActionMutationKind])
-> Enum ActionMutationKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ActionMutationKind -> ActionMutationKind
succ :: ActionMutationKind -> ActionMutationKind
$cpred :: ActionMutationKind -> ActionMutationKind
pred :: ActionMutationKind -> ActionMutationKind
$ctoEnum :: Int -> ActionMutationKind
toEnum :: Int -> ActionMutationKind
$cfromEnum :: ActionMutationKind -> Int
fromEnum :: ActionMutationKind -> Int
$cenumFrom :: ActionMutationKind -> [ActionMutationKind]
enumFrom :: ActionMutationKind -> [ActionMutationKind]
$cenumFromThen :: ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
enumFromThen :: ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
$cenumFromTo :: ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
enumFromTo :: ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
$cenumFromThenTo :: ActionMutationKind
-> ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
enumFromThenTo :: ActionMutationKind
-> ActionMutationKind -> ActionMutationKind -> [ActionMutationKind]
Enum, ActionMutationKind -> ActionMutationKind -> Bool
(ActionMutationKind -> ActionMutationKind -> Bool)
-> (ActionMutationKind -> ActionMutationKind -> Bool)
-> Eq ActionMutationKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionMutationKind -> ActionMutationKind -> Bool
== :: ActionMutationKind -> ActionMutationKind -> Bool
$c/= :: ActionMutationKind -> ActionMutationKind -> Bool
/= :: ActionMutationKind -> ActionMutationKind -> Bool
Eq, (forall x. ActionMutationKind -> Rep ActionMutationKind x)
-> (forall x. Rep ActionMutationKind x -> ActionMutationKind)
-> Generic ActionMutationKind
forall x. Rep ActionMutationKind x -> ActionMutationKind
forall x. ActionMutationKind -> Rep ActionMutationKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionMutationKind -> Rep ActionMutationKind x
from :: forall x. ActionMutationKind -> Rep ActionMutationKind x
$cto :: forall x. Rep ActionMutationKind x -> ActionMutationKind
to :: forall x. Rep ActionMutationKind x -> ActionMutationKind
Generic)

instance NFData ActionMutationKind

instance HasCodec ActionMutationKind where
  codec :: JSONCodec ActionMutationKind
codec = (ActionMutationKind -> String) -> JSONCodec ActionMutationKind
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> String) -> JSONCodec enum
boundedEnumCodec ActionMutationKind -> String
jsonStringConst

-- | Defines representation of 'ActionMutationKind' when serializing to JSON.
jsonStringConst :: ActionMutationKind -> String
jsonStringConst :: ActionMutationKind -> String
jsonStringConst = \case
  ActionMutationKind
ActionSynchronous -> String
"synchronous"
  ActionMutationKind
ActionAsynchronous -> String
"asynchronous"

--------------------------------------------------------------------------------
-- Arguments

data ArgumentDefinition a = ArgumentDefinition
  { forall a. ArgumentDefinition a -> ArgumentName
_argName :: ArgumentName,
    forall a. ArgumentDefinition a -> a
_argType :: a,
    forall a. ArgumentDefinition a -> Maybe Description
_argDescription :: Maybe G.Description
  }
  deriving (Int -> ArgumentDefinition a -> ShowS
[ArgumentDefinition a] -> ShowS
ArgumentDefinition a -> String
(Int -> ArgumentDefinition a -> ShowS)
-> (ArgumentDefinition a -> String)
-> ([ArgumentDefinition a] -> ShowS)
-> Show (ArgumentDefinition a)
forall a. Show a => Int -> ArgumentDefinition a -> ShowS
forall a. Show a => [ArgumentDefinition a] -> ShowS
forall a. Show a => ArgumentDefinition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ArgumentDefinition a -> ShowS
showsPrec :: Int -> ArgumentDefinition a -> ShowS
$cshow :: forall a. Show a => ArgumentDefinition a -> String
show :: ArgumentDefinition a -> String
$cshowList :: forall a. Show a => [ArgumentDefinition a] -> ShowS
showList :: [ArgumentDefinition a] -> ShowS
Show, ArgumentDefinition a -> ArgumentDefinition a -> Bool
(ArgumentDefinition a -> ArgumentDefinition a -> Bool)
-> (ArgumentDefinition a -> ArgumentDefinition a -> Bool)
-> Eq (ArgumentDefinition a)
forall a.
Eq a =>
ArgumentDefinition a -> ArgumentDefinition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
ArgumentDefinition a -> ArgumentDefinition a -> Bool
== :: ArgumentDefinition a -> ArgumentDefinition a -> Bool
$c/= :: forall a.
Eq a =>
ArgumentDefinition a -> ArgumentDefinition a -> Bool
/= :: ArgumentDefinition a -> ArgumentDefinition a -> Bool
Eq, (forall a b.
 (a -> b) -> ArgumentDefinition a -> ArgumentDefinition b)
-> (forall a b. a -> ArgumentDefinition b -> ArgumentDefinition a)
-> Functor ArgumentDefinition
forall a b. a -> ArgumentDefinition b -> ArgumentDefinition a
forall a b.
(a -> b) -> ArgumentDefinition a -> ArgumentDefinition b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ArgumentDefinition a -> ArgumentDefinition b
fmap :: forall a b.
(a -> b) -> ArgumentDefinition a -> ArgumentDefinition b
$c<$ :: forall a b. a -> ArgumentDefinition b -> ArgumentDefinition a
<$ :: forall a b. a -> ArgumentDefinition b -> ArgumentDefinition a
Functor, (forall m. Monoid m => ArgumentDefinition m -> m)
-> (forall m a. Monoid m => (a -> m) -> ArgumentDefinition a -> m)
-> (forall m a. Monoid m => (a -> m) -> ArgumentDefinition a -> m)
-> (forall a b. (a -> b -> b) -> b -> ArgumentDefinition a -> b)
-> (forall a b. (a -> b -> b) -> b -> ArgumentDefinition a -> b)
-> (forall b a. (b -> a -> b) -> b -> ArgumentDefinition a -> b)
-> (forall b a. (b -> a -> b) -> b -> ArgumentDefinition a -> b)
-> (forall a. (a -> a -> a) -> ArgumentDefinition a -> a)
-> (forall a. (a -> a -> a) -> ArgumentDefinition a -> a)
-> (forall a. ArgumentDefinition a -> [a])
-> (forall a. ArgumentDefinition a -> Bool)
-> (forall a. ArgumentDefinition a -> Int)
-> (forall a. Eq a => a -> ArgumentDefinition a -> Bool)
-> (forall a. Ord a => ArgumentDefinition a -> a)
-> (forall a. Ord a => ArgumentDefinition a -> a)
-> (forall a. Num a => ArgumentDefinition a -> a)
-> (forall a. Num a => ArgumentDefinition a -> a)
-> Foldable ArgumentDefinition
forall a. Eq a => a -> ArgumentDefinition a -> Bool
forall a. Num a => ArgumentDefinition a -> a
forall a. Ord a => ArgumentDefinition a -> a
forall m. Monoid m => ArgumentDefinition m -> m
forall a. ArgumentDefinition a -> Bool
forall a. ArgumentDefinition a -> Int
forall a. ArgumentDefinition a -> [a]
forall a. (a -> a -> a) -> ArgumentDefinition a -> a
forall m a. Monoid m => (a -> m) -> ArgumentDefinition a -> m
forall b a. (b -> a -> b) -> b -> ArgumentDefinition a -> b
forall a b. (a -> b -> b) -> b -> ArgumentDefinition a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ArgumentDefinition m -> m
fold :: forall m. Monoid m => ArgumentDefinition m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ArgumentDefinition a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ArgumentDefinition a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ArgumentDefinition a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ArgumentDefinition a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ArgumentDefinition a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ArgumentDefinition a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ArgumentDefinition a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ArgumentDefinition a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ArgumentDefinition a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ArgumentDefinition a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ArgumentDefinition a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ArgumentDefinition a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ArgumentDefinition a -> a
foldr1 :: forall a. (a -> a -> a) -> ArgumentDefinition a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ArgumentDefinition a -> a
foldl1 :: forall a. (a -> a -> a) -> ArgumentDefinition a -> a
$ctoList :: forall a. ArgumentDefinition a -> [a]
toList :: forall a. ArgumentDefinition a -> [a]
$cnull :: forall a. ArgumentDefinition a -> Bool
null :: forall a. ArgumentDefinition a -> Bool
$clength :: forall a. ArgumentDefinition a -> Int
length :: forall a. ArgumentDefinition a -> Int
$celem :: forall a. Eq a => a -> ArgumentDefinition a -> Bool
elem :: forall a. Eq a => a -> ArgumentDefinition a -> Bool
$cmaximum :: forall a. Ord a => ArgumentDefinition a -> a
maximum :: forall a. Ord a => ArgumentDefinition a -> a
$cminimum :: forall a. Ord a => ArgumentDefinition a -> a
minimum :: forall a. Ord a => ArgumentDefinition a -> a
$csum :: forall a. Num a => ArgumentDefinition a -> a
sum :: forall a. Num a => ArgumentDefinition a -> a
$cproduct :: forall a. Num a => ArgumentDefinition a -> a
product :: forall a. Num a => ArgumentDefinition a -> a
Foldable, Functor ArgumentDefinition
Foldable ArgumentDefinition
Functor ArgumentDefinition
-> Foldable ArgumentDefinition
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ArgumentDefinition a -> f (ArgumentDefinition b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ArgumentDefinition (f a) -> f (ArgumentDefinition a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ArgumentDefinition a -> m (ArgumentDefinition b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ArgumentDefinition (m a) -> m (ArgumentDefinition a))
-> Traversable ArgumentDefinition
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ArgumentDefinition (m a) -> m (ArgumentDefinition a)
forall (f :: * -> *) a.
Applicative f =>
ArgumentDefinition (f a) -> f (ArgumentDefinition a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ArgumentDefinition a -> m (ArgumentDefinition b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ArgumentDefinition a -> f (ArgumentDefinition b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ArgumentDefinition a -> f (ArgumentDefinition b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ArgumentDefinition a -> f (ArgumentDefinition b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ArgumentDefinition (f a) -> f (ArgumentDefinition a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ArgumentDefinition (f a) -> f (ArgumentDefinition a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ArgumentDefinition a -> m (ArgumentDefinition b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ArgumentDefinition a -> m (ArgumentDefinition b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ArgumentDefinition (m a) -> m (ArgumentDefinition a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ArgumentDefinition (m a) -> m (ArgumentDefinition a)
Traversable, (forall x. ArgumentDefinition a -> Rep (ArgumentDefinition a) x)
-> (forall x. Rep (ArgumentDefinition a) x -> ArgumentDefinition a)
-> Generic (ArgumentDefinition a)
forall x. Rep (ArgumentDefinition a) x -> ArgumentDefinition a
forall x. ArgumentDefinition a -> Rep (ArgumentDefinition a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ArgumentDefinition a) x -> ArgumentDefinition a
forall a x. ArgumentDefinition a -> Rep (ArgumentDefinition a) x
$cfrom :: forall a x. ArgumentDefinition a -> Rep (ArgumentDefinition a) x
from :: forall x. ArgumentDefinition a -> Rep (ArgumentDefinition a) x
$cto :: forall a x. Rep (ArgumentDefinition a) x -> ArgumentDefinition a
to :: forall x. Rep (ArgumentDefinition a) x -> ArgumentDefinition a
Generic)

instance (NFData a) => NFData (ArgumentDefinition a)

instance (HasCodec a, Typeable a) => HasCodec (ArgumentDefinition a) where
  codec :: JSONCodec (ArgumentDefinition a)
codec =
    Text
-> ObjectCodec (ArgumentDefinition a) (ArgumentDefinition a)
-> JSONCodec (ArgumentDefinition a)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"ArgumentDefinition_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @a)
      (ObjectCodec (ArgumentDefinition a) (ArgumentDefinition a)
 -> JSONCodec (ArgumentDefinition a))
-> ObjectCodec (ArgumentDefinition a) (ArgumentDefinition a)
-> JSONCodec (ArgumentDefinition a)
forall a b. (a -> b) -> a -> b
$ ArgumentName -> a -> Maybe Description -> ArgumentDefinition a
forall a.
ArgumentName -> a -> Maybe Description -> ArgumentDefinition a
ArgumentDefinition
      (ArgumentName -> a -> Maybe Description -> ArgumentDefinition a)
-> Codec Object (ArgumentDefinition a) ArgumentName
-> Codec
     Object
     (ArgumentDefinition a)
     (a -> Maybe Description -> ArgumentDefinition a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec ArgumentName ArgumentName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec ArgumentName ArgumentName
-> (ArgumentDefinition a -> ArgumentName)
-> Codec Object (ArgumentDefinition a) ArgumentName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ArgumentDefinition a -> ArgumentName
forall a. ArgumentDefinition a -> ArgumentName
_argName
        Codec
  Object
  (ArgumentDefinition a)
  (a -> Maybe Description -> ArgumentDefinition a)
-> Codec Object (ArgumentDefinition a) a
-> Codec
     Object
     (ArgumentDefinition a)
     (Maybe Description -> ArgumentDefinition a)
forall a b.
Codec Object (ArgumentDefinition a) (a -> b)
-> Codec Object (ArgumentDefinition a) a
-> Codec Object (ArgumentDefinition a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec a a
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type"
      ObjectCodec a a
-> (ArgumentDefinition a -> a)
-> Codec Object (ArgumentDefinition a) a
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ArgumentDefinition a -> a
forall a. ArgumentDefinition a -> a
_argType
        Codec
  Object
  (ArgumentDefinition a)
  (Maybe Description -> ArgumentDefinition a)
-> Codec Object (ArgumentDefinition a) (Maybe Description)
-> ObjectCodec (ArgumentDefinition a) (ArgumentDefinition a)
forall a b.
Codec Object (ArgumentDefinition a) (a -> b)
-> Codec Object (ArgumentDefinition a) a
-> Codec Object (ArgumentDefinition a) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (ArgumentDefinition a -> Maybe Description)
-> Codec Object (ArgumentDefinition a) (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ArgumentDefinition a -> Maybe Description
forall a. ArgumentDefinition a -> Maybe Description
_argDescription

newtype ArgumentName = ArgumentName {ArgumentName -> Name
unArgumentName :: G.Name}
  deriving (Int -> ArgumentName -> ShowS
[ArgumentName] -> ShowS
ArgumentName -> String
(Int -> ArgumentName -> ShowS)
-> (ArgumentName -> String)
-> ([ArgumentName] -> ShowS)
-> Show ArgumentName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArgumentName -> ShowS
showsPrec :: Int -> ArgumentName -> ShowS
$cshow :: ArgumentName -> String
show :: ArgumentName -> String
$cshowList :: [ArgumentName] -> ShowS
showList :: [ArgumentName] -> ShowS
Show, ArgumentName -> ArgumentName -> Bool
(ArgumentName -> ArgumentName -> Bool)
-> (ArgumentName -> ArgumentName -> Bool) -> Eq ArgumentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArgumentName -> ArgumentName -> Bool
== :: ArgumentName -> ArgumentName -> Bool
$c/= :: ArgumentName -> ArgumentName -> Bool
/= :: ArgumentName -> ArgumentName -> Bool
Eq, Value -> Parser [ArgumentName]
Value -> Parser ArgumentName
(Value -> Parser ArgumentName)
-> (Value -> Parser [ArgumentName]) -> FromJSON ArgumentName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ArgumentName
parseJSON :: Value -> Parser ArgumentName
$cparseJSONList :: Value -> Parser [ArgumentName]
parseJSONList :: Value -> Parser [ArgumentName]
J.FromJSON, [ArgumentName] -> Value
[ArgumentName] -> Encoding
ArgumentName -> Value
ArgumentName -> Encoding
(ArgumentName -> Value)
-> (ArgumentName -> Encoding)
-> ([ArgumentName] -> Value)
-> ([ArgumentName] -> Encoding)
-> ToJSON ArgumentName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ArgumentName -> Value
toJSON :: ArgumentName -> Value
$ctoEncoding :: ArgumentName -> Encoding
toEncoding :: ArgumentName -> Encoding
$ctoJSONList :: [ArgumentName] -> Value
toJSONList :: [ArgumentName] -> Value
$ctoEncodingList :: [ArgumentName] -> Encoding
toEncodingList :: [ArgumentName] -> Encoding
J.ToJSON, FromJSONKeyFunction [ArgumentName]
FromJSONKeyFunction ArgumentName
FromJSONKeyFunction ArgumentName
-> FromJSONKeyFunction [ArgumentName] -> FromJSONKey ArgumentName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction ArgumentName
fromJSONKey :: FromJSONKeyFunction ArgumentName
$cfromJSONKeyList :: FromJSONKeyFunction [ArgumentName]
fromJSONKeyList :: FromJSONKeyFunction [ArgumentName]
J.FromJSONKey, ToJSONKeyFunction [ArgumentName]
ToJSONKeyFunction ArgumentName
ToJSONKeyFunction ArgumentName
-> ToJSONKeyFunction [ArgumentName] -> ToJSONKey ArgumentName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ArgumentName
toJSONKey :: ToJSONKeyFunction ArgumentName
$ctoJSONKeyList :: ToJSONKeyFunction [ArgumentName]
toJSONKeyList :: ToJSONKeyFunction [ArgumentName]
J.ToJSONKey, ArgumentName -> Text
(ArgumentName -> Text) -> ToTxt ArgumentName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ArgumentName -> Text
toTxt :: ArgumentName -> Text
ToTxt, (forall x. ArgumentName -> Rep ArgumentName x)
-> (forall x. Rep ArgumentName x -> ArgumentName)
-> Generic ArgumentName
forall x. Rep ArgumentName x -> ArgumentName
forall x. ArgumentName -> Rep ArgumentName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArgumentName -> Rep ArgumentName x
from :: forall x. ArgumentName -> Rep ArgumentName x
$cto :: forall x. Rep ArgumentName x -> ArgumentName
to :: forall x. Rep ArgumentName x -> ArgumentName
Generic, ArgumentName -> ()
(ArgumentName -> ()) -> NFData ArgumentName
forall a. (a -> ()) -> NFData a
$crnf :: ArgumentName -> ()
rnf :: ArgumentName -> ()
NFData)

instance HasCodec ArgumentName where
  codec :: JSONCodec ArgumentName
codec = (Name -> ArgumentName)
-> (ArgumentName -> Name)
-> Codec Value Name Name
-> JSONCodec ArgumentName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> ArgumentName
ArgumentName ArgumentName -> Name
unArgumentName Codec Value Name Name
graphQLFieldNameCodec

--------------------------------------------------------------------------------
-- Schema cache

data ActionInfo = ActionInfo
  { ActionInfo -> ActionName
_aiName :: ActionName,
    ActionInfo -> (GType, AnnotatedOutputType)
_aiOutputType :: (G.GType, AnnotatedOutputType),
    ActionInfo -> ResolvedActionDefinition
_aiDefinition :: ResolvedActionDefinition,
    ActionInfo -> HashMap RoleName ActionPermissionInfo
_aiPermissions :: HashMap RoleName ActionPermissionInfo,
    ActionInfo -> Bool
_aiForwardedClientHeaders :: Bool,
    ActionInfo -> Maybe Text
_aiComment :: Maybe Text
  }
  deriving ((forall x. ActionInfo -> Rep ActionInfo x)
-> (forall x. Rep ActionInfo x -> ActionInfo) -> Generic ActionInfo
forall x. Rep ActionInfo x -> ActionInfo
forall x. ActionInfo -> Rep ActionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionInfo -> Rep ActionInfo x
from :: forall x. ActionInfo -> Rep ActionInfo x
$cto :: forall x. Rep ActionInfo x -> ActionInfo
to :: forall x. Rep ActionInfo x -> ActionInfo
Generic)

type ResolvedActionDefinition =
  ActionDefinition (G.GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)

newtype ActionPermissionInfo = ActionPermissionInfo
  { ActionPermissionInfo -> RoleName
_apiRole :: RoleName
  }
  deriving newtype (Int -> ActionPermissionInfo -> ShowS
[ActionPermissionInfo] -> ShowS
ActionPermissionInfo -> String
(Int -> ActionPermissionInfo -> ShowS)
-> (ActionPermissionInfo -> String)
-> ([ActionPermissionInfo] -> ShowS)
-> Show ActionPermissionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionPermissionInfo -> ShowS
showsPrec :: Int -> ActionPermissionInfo -> ShowS
$cshow :: ActionPermissionInfo -> String
show :: ActionPermissionInfo -> String
$cshowList :: [ActionPermissionInfo] -> ShowS
showList :: [ActionPermissionInfo] -> ShowS
Show, ActionPermissionInfo -> ActionPermissionInfo -> Bool
(ActionPermissionInfo -> ActionPermissionInfo -> Bool)
-> (ActionPermissionInfo -> ActionPermissionInfo -> Bool)
-> Eq ActionPermissionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionPermissionInfo -> ActionPermissionInfo -> Bool
== :: ActionPermissionInfo -> ActionPermissionInfo -> Bool
$c/= :: ActionPermissionInfo -> ActionPermissionInfo -> Bool
/= :: ActionPermissionInfo -> ActionPermissionInfo -> Bool
Eq, Value -> Parser [ActionPermissionInfo]
Value -> Parser ActionPermissionInfo
(Value -> Parser ActionPermissionInfo)
-> (Value -> Parser [ActionPermissionInfo])
-> FromJSON ActionPermissionInfo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActionPermissionInfo
parseJSON :: Value -> Parser ActionPermissionInfo
$cparseJSONList :: Value -> Parser [ActionPermissionInfo]
parseJSONList :: Value -> Parser [ActionPermissionInfo]
FromJSON, [ActionPermissionInfo] -> Value
[ActionPermissionInfo] -> Encoding
ActionPermissionInfo -> Value
ActionPermissionInfo -> Encoding
(ActionPermissionInfo -> Value)
-> (ActionPermissionInfo -> Encoding)
-> ([ActionPermissionInfo] -> Value)
-> ([ActionPermissionInfo] -> Encoding)
-> ToJSON ActionPermissionInfo
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActionPermissionInfo -> Value
toJSON :: ActionPermissionInfo -> Value
$ctoEncoding :: ActionPermissionInfo -> Encoding
toEncoding :: ActionPermissionInfo -> Encoding
$ctoJSONList :: [ActionPermissionInfo] -> Value
toJSONList :: [ActionPermissionInfo] -> Value
$ctoEncodingList :: [ActionPermissionInfo] -> Encoding
toEncodingList :: [ActionPermissionInfo] -> Encoding
ToJSON)

--------------------------------------------------------------------------------
-- Execution types

-- TODO: those types are not used outside of the execution side of things, and
-- should be moved out of RQL.Types to become implementation details of
-- GraphQL.Execute.

data ActionExecContext = ActionExecContext
  { ActionExecContext -> RequestHeaders
_aecHeaders :: HTTP.RequestHeaders,
    ActionExecContext -> SessionVariables
_aecSessionVariables :: SessionVariables
  }

data ActionLogItem = ActionLogItem
  { ActionLogItem -> ActionId
_aliId :: ActionId,
    ActionLogItem -> ActionName
_aliActionName :: ActionName,
    ActionLogItem -> RequestHeaders
_aliRequestHeaders :: [HTTP.Header],
    ActionLogItem -> SessionVariables
_aliSessionVariables :: SessionVariables,
    ActionLogItem -> Value
_aliInputPayload :: J.Value
  }
  deriving (Int -> ActionLogItem -> ShowS
[ActionLogItem] -> ShowS
ActionLogItem -> String
(Int -> ActionLogItem -> ShowS)
-> (ActionLogItem -> String)
-> ([ActionLogItem] -> ShowS)
-> Show ActionLogItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionLogItem -> ShowS
showsPrec :: Int -> ActionLogItem -> ShowS
$cshow :: ActionLogItem -> String
show :: ActionLogItem -> String
$cshowList :: [ActionLogItem] -> ShowS
showList :: [ActionLogItem] -> ShowS
Show, ActionLogItem -> ActionLogItem -> Bool
(ActionLogItem -> ActionLogItem -> Bool)
-> (ActionLogItem -> ActionLogItem -> Bool) -> Eq ActionLogItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionLogItem -> ActionLogItem -> Bool
== :: ActionLogItem -> ActionLogItem -> Bool
$c/= :: ActionLogItem -> ActionLogItem -> Bool
/= :: ActionLogItem -> ActionLogItem -> Bool
Eq)

data ActionLogResponse = ActionLogResponse
  { ActionLogResponse -> ActionId
_alrId :: ActionId,
    ActionLogResponse -> UTCTime
_alrCreatedAt :: UTC.UTCTime,
    ActionLogResponse -> Maybe Value
_alrResponsePayload :: Maybe J.Value,
    ActionLogResponse -> Maybe Value
_alrErrors :: Maybe J.Value,
    ActionLogResponse -> SessionVariables
_alrSessionVariables :: SessionVariables
  }
  deriving stock (Int -> ActionLogResponse -> ShowS
[ActionLogResponse] -> ShowS
ActionLogResponse -> String
(Int -> ActionLogResponse -> ShowS)
-> (ActionLogResponse -> String)
-> ([ActionLogResponse] -> ShowS)
-> Show ActionLogResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionLogResponse -> ShowS
showsPrec :: Int -> ActionLogResponse -> ShowS
$cshow :: ActionLogResponse -> String
show :: ActionLogResponse -> String
$cshowList :: [ActionLogResponse] -> ShowS
showList :: [ActionLogResponse] -> ShowS
Show, ActionLogResponse -> ActionLogResponse -> Bool
(ActionLogResponse -> ActionLogResponse -> Bool)
-> (ActionLogResponse -> ActionLogResponse -> Bool)
-> Eq ActionLogResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionLogResponse -> ActionLogResponse -> Bool
== :: ActionLogResponse -> ActionLogResponse -> Bool
$c/= :: ActionLogResponse -> ActionLogResponse -> Bool
/= :: ActionLogResponse -> ActionLogResponse -> Bool
Eq, (forall x. ActionLogResponse -> Rep ActionLogResponse x)
-> (forall x. Rep ActionLogResponse x -> ActionLogResponse)
-> Generic ActionLogResponse
forall x. Rep ActionLogResponse x -> ActionLogResponse
forall x. ActionLogResponse -> Rep ActionLogResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionLogResponse -> Rep ActionLogResponse x
from :: forall x. ActionLogResponse -> Rep ActionLogResponse x
$cto :: forall x. Rep ActionLogResponse x -> ActionLogResponse
to :: forall x. Rep ActionLogResponse x -> ActionLogResponse
Generic)

type ActionLogResponseMap = HashMap ActionId ActionLogResponse

data AsyncActionStatus
  = AASCompleted J.Value
  | AASError QErr

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

type LockedActionEventId = EventId

-- This type exists only to use the Postgres array encoding.
-- TODO: document this; what does that mean? Why is it defined here? What's the
-- common point with EventTriggers?
newtype LockedActionIdArray = LockedActionIdArray {LockedActionIdArray -> [LockedActionEventId]
unCohortIdArray :: [LockedActionEventId]}
  deriving (Int -> LockedActionIdArray -> ShowS
[LockedActionIdArray] -> ShowS
LockedActionIdArray -> String
(Int -> LockedActionIdArray -> ShowS)
-> (LockedActionIdArray -> String)
-> ([LockedActionIdArray] -> ShowS)
-> Show LockedActionIdArray
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LockedActionIdArray -> ShowS
showsPrec :: Int -> LockedActionIdArray -> ShowS
$cshow :: LockedActionIdArray -> String
show :: LockedActionIdArray -> String
$cshowList :: [LockedActionIdArray] -> ShowS
showList :: [LockedActionIdArray] -> ShowS
Show, LockedActionIdArray -> LockedActionIdArray -> Bool
(LockedActionIdArray -> LockedActionIdArray -> Bool)
-> (LockedActionIdArray -> LockedActionIdArray -> Bool)
-> Eq LockedActionIdArray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LockedActionIdArray -> LockedActionIdArray -> Bool
== :: LockedActionIdArray -> LockedActionIdArray -> Bool
$c/= :: LockedActionIdArray -> LockedActionIdArray -> Bool
/= :: LockedActionIdArray -> LockedActionIdArray -> Bool
Eq)

instance PG.ToPrepArg LockedActionIdArray where
  toPrepVal :: LockedActionIdArray -> PrepArg
toPrepVal (LockedActionIdArray [LockedActionEventId]
l) =
    Oid -> ([UUID] -> Encoding) -> [UUID] -> PrepArg
forall a. Oid -> (a -> Encoding) -> a -> PrepArg
PG.toPrepValHelper Oid
PTI.unknown [UUID] -> Encoding
encoder ([UUID] -> PrepArg) -> [UUID] -> PrepArg
forall a b. (a -> b) -> a -> b
$ (LockedActionEventId -> Maybe UUID)
-> [LockedActionEventId] -> [UUID]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Text -> Maybe UUID
UUID.fromText (Text -> Maybe UUID)
-> (LockedActionEventId -> Text)
-> LockedActionEventId
-> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LockedActionEventId -> Text
unEventId) [LockedActionEventId]
l
    where
      encoder :: [UUID] -> Encoding
encoder = Word32 -> Array -> Encoding
PE.array Word32
2950 (Array -> Encoding) -> ([UUID] -> Array) -> [UUID] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b. (b -> UUID -> b) -> b -> [UUID] -> b)
-> (UUID -> Array) -> [UUID] -> Array
forall a c.
(forall b. (b -> a -> b) -> b -> c -> b)
-> (a -> Array) -> c -> Array
PE.dimensionArray (b -> UUID -> b) -> b -> [UUID] -> b
forall b. (b -> UUID -> b) -> b -> [UUID] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Encoding -> Array
PE.encodingArray (Encoding -> Array) -> (UUID -> Encoding) -> UUID -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Encoding
PE.uuid)

-------------------------------------------------------------------------------
-- Template haskell derivation
-- ...and other instances that need to live here in a particular order, due to
-- GHC 9.0 TH changes...

instance FromJSON ActionPermissionMetadata where
  parseJSON :: Value -> Parser ActionPermissionMetadata
parseJSON = Options -> Value -> Parser ActionPermissionMetadata
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
J.omitNothingFields = Bool
True}

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

instance (FromJSON arg) => FromJSON (ArgumentDefinition arg) where
  parseJSON :: Value -> Parser (ArgumentDefinition arg)
parseJSON = Options -> Value -> Parser (ArgumentDefinition arg)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

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

instance FromJSON ActionMutationKind where
  parseJSON :: Value -> Parser ActionMutationKind
parseJSON = Options -> Value -> Parser ActionMutationKind
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {constructorTagModifier :: ShowS
J.constructorTagModifier = ShowS
J.snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
6}

instance ToJSON ActionMutationKind where
  toJSON :: ActionMutationKind -> Value
toJSON = Options -> ActionMutationKind -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {constructorTagModifier :: ShowS
J.constructorTagModifier = ShowS
J.snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
6}
  toEncoding :: ActionMutationKind -> Encoding
toEncoding = Options -> ActionMutationKind -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {constructorTagModifier :: ShowS
J.constructorTagModifier = ShowS
J.snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
6}

instance (J.FromJSON a, J.FromJSON b) => J.FromJSON (ActionDefinition a b) where
  parseJSON :: Value -> Parser (ActionDefinition a b)
parseJSON = String
-> (Object -> Parser (ActionDefinition a b))
-> Value
-> Parser (ActionDefinition a b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"ActionDefinition" ((Object -> Parser (ActionDefinition a b))
 -> Value -> Parser (ActionDefinition a b))
-> (Object -> Parser (ActionDefinition a b))
-> Value
-> Parser (ActionDefinition a b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [ArgumentDefinition a]
_adArguments <- Object
o Object -> Key -> Parser (Maybe [ArgumentDefinition a])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"arguments" Parser (Maybe [ArgumentDefinition a])
-> [ArgumentDefinition a] -> Parser [ArgumentDefinition a]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    GraphQLType
_adOutputType <- Object
o Object -> Key -> Parser GraphQLType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"output_type"
    [HeaderConf]
_adHeaders <- Object
o Object -> Key -> Parser (Maybe [HeaderConf])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" Parser (Maybe [HeaderConf]) -> [HeaderConf] -> Parser [HeaderConf]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Bool
_adForwardClientHeaders <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"forward_client_headers" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    b
_adHandler <- Object
o Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"handler"
    Timeout
_adTimeout <- Object
o Object -> Key -> Parser (Maybe Timeout)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timeout" Parser (Maybe Timeout) -> Timeout -> Parser Timeout
forall a. Parser (Maybe a) -> a -> Parser a
.!= Timeout
defaultActionTimeoutSecs
    String
actionType <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
"mutation"
    ActionType
_adType <- case String
actionType of
      String
"mutation" -> ActionMutationKind -> ActionType
ActionMutation (ActionMutationKind -> ActionType)
-> Parser ActionMutationKind -> Parser ActionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ActionMutationKind)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"kind" Parser (Maybe ActionMutationKind)
-> ActionMutationKind -> Parser ActionMutationKind
forall a. Parser (Maybe a) -> a -> Parser a
.!= ActionMutationKind
ActionSynchronous
      String
"query" -> ActionType -> Parser ActionType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionType
ActionQuery
      String
t -> String -> Parser ActionType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ActionType) -> String -> Parser ActionType
forall a b. (a -> b) -> a -> b
$ String
"expected mutation or query, but found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
    Maybe RequestTransform
_adRequestTransform <- Object
o Object -> Key -> Parser (Maybe RequestTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"request_transform"
    Maybe MetadataResponseTransform
_adResponseTransform <- Object
o Object -> Key -> Parser (Maybe MetadataResponseTransform)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response_transform"
    ActionDefinition a b -> Parser (ActionDefinition a b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActionDefinition {b
Bool
[HeaderConf]
[ArgumentDefinition a]
Maybe RequestTransform
Maybe MetadataResponseTransform
Timeout
GraphQLType
ActionType
_adArguments :: [ArgumentDefinition a]
_adOutputType :: GraphQLType
_adType :: ActionType
_adHeaders :: [HeaderConf]
_adForwardClientHeaders :: Bool
_adTimeout :: Timeout
_adHandler :: b
_adRequestTransform :: Maybe RequestTransform
_adResponseTransform :: Maybe MetadataResponseTransform
_adArguments :: [ArgumentDefinition a]
_adOutputType :: GraphQLType
_adHeaders :: [HeaderConf]
_adForwardClientHeaders :: Bool
_adHandler :: b
_adTimeout :: Timeout
_adType :: ActionType
_adRequestTransform :: Maybe RequestTransform
_adResponseTransform :: Maybe MetadataResponseTransform
..}

instance J.FromJSON ActionMetadata where
  parseJSON :: Value -> Parser ActionMetadata
parseJSON = String
-> (Object -> Parser ActionMetadata)
-> Value
-> Parser ActionMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"ActionMetadata" ((Object -> Parser ActionMetadata)
 -> Value -> Parser ActionMetadata)
-> (Object -> Parser ActionMetadata)
-> Value
-> Parser ActionMetadata
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ActionName
-> Maybe Text
-> ActionDefinitionInput
-> [ActionPermissionMetadata]
-> ActionMetadata
ActionMetadata
      (ActionName
 -> Maybe Text
 -> ActionDefinitionInput
 -> [ActionPermissionMetadata]
 -> ActionMetadata)
-> Parser ActionName
-> Parser
     (Maybe Text
      -> ActionDefinitionInput
      -> [ActionPermissionMetadata]
      -> ActionMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser ActionName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (Maybe Text
   -> ActionDefinitionInput
   -> [ActionPermissionMetadata]
   -> ActionMetadata)
-> Parser (Maybe Text)
-> Parser
     (ActionDefinitionInput
      -> [ActionPermissionMetadata] -> ActionMetadata)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"
      Parser
  (ActionDefinitionInput
   -> [ActionPermissionMetadata] -> ActionMetadata)
-> Parser ActionDefinitionInput
-> Parser ([ActionPermissionMetadata] -> ActionMetadata)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser ActionDefinitionInput
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"definition"
      Parser ([ActionPermissionMetadata] -> ActionMetadata)
-> Parser [ActionPermissionMetadata] -> Parser ActionMetadata
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe [ActionPermissionMetadata])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions"
      Parser (Maybe [ActionPermissionMetadata])
-> [ActionPermissionMetadata] -> Parser [ActionPermissionMetadata]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

instance (J.ToJSON a, J.ToJSON b) => J.ToJSON (ActionDefinition a b) where
  toJSON :: ActionDefinition a b -> Value
toJSON (ActionDefinition {b
Bool
[HeaderConf]
[ArgumentDefinition a]
Maybe RequestTransform
Maybe MetadataResponseTransform
Timeout
GraphQLType
ActionType
_adArguments :: forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adOutputType :: forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adType :: forall arg webhook. ActionDefinition arg webhook -> ActionType
_adHeaders :: forall arg webhook. ActionDefinition arg webhook -> [HeaderConf]
_adForwardClientHeaders :: forall arg webhook. ActionDefinition arg webhook -> Bool
_adTimeout :: forall arg webhook. ActionDefinition arg webhook -> Timeout
_adHandler :: forall arg webhook. ActionDefinition arg webhook -> webhook
_adRequestTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe RequestTransform
_adResponseTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe MetadataResponseTransform
_adArguments :: [ArgumentDefinition a]
_adOutputType :: GraphQLType
_adType :: ActionType
_adHeaders :: [HeaderConf]
_adForwardClientHeaders :: Bool
_adTimeout :: Timeout
_adHandler :: b
_adRequestTransform :: Maybe RequestTransform
_adResponseTransform :: Maybe MetadataResponseTransform
..}) =
    let typeAndKind :: [Pair]
typeAndKind = case ActionType
_adType of
          ActionType
ActionQuery -> [Key
"type" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"query" :: String)]
          ActionMutation ActionMutationKind
kind ->
            [ Key
"type" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"mutation" :: String),
              Key
"kind" Key -> ActionMutationKind -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ActionMutationKind
kind
            ]
     in [Pair] -> Value
J.object
          ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"arguments" Key -> [ArgumentDefinition a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [ArgumentDefinition a]
_adArguments,
              Key
"output_type" Key -> GraphQLType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= GraphQLType
_adOutputType,
              Key
"headers" Key -> [HeaderConf] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [HeaderConf]
_adHeaders,
              Key
"forward_client_headers" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_adForwardClientHeaders,
              Key
"handler" Key -> b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= b
_adHandler,
              Key
"timeout" Key -> Timeout -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Timeout
_adTimeout
            ]
          [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
            [ (Key
"request_transform" Key -> RequestTransform -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (RequestTransform -> Pair) -> Maybe RequestTransform -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RequestTransform
_adRequestTransform,
              (Key
"response_transform" Key -> MetadataResponseTransform -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (MetadataResponseTransform -> Pair)
-> Maybe MetadataResponseTransform -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MetadataResponseTransform
_adResponseTransform
            ]
          [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
typeAndKind

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

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

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

$(makeLenses ''ActionMetadata)
$(makeLenses ''ActionDefinition)
$(makeLenses ''ActionInfo)