{-# 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 Control.Lens (makeLenses)
import Data.Aeson qualified as J
import Data.Aeson.Casing qualified as J
import Data.Aeson.Extended
import Data.Aeson.TH qualified as J
import Data.Text.Extended
import Data.Time.Clock qualified as UTC
import Data.UUID qualified as UUID
import Database.PG.Query qualified as Q
import Database.PG.Query.PTI qualified as PTI
import Hasura.Base.Error
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.DDL.Headers
import Hasura.RQL.DDL.Webhook.Transform (MetadataResponseTransform, RequestTransform)
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Eventing (EventId (..))
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Client qualified as HTTP
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
showList :: [ActionMetadata] -> ShowS
$cshowList :: [ActionMetadata] -> ShowS
show :: ActionMetadata -> String
$cshow :: ActionMetadata -> String
showsPrec :: Int -> ActionMetadata -> ShowS
$cshowsPrec :: Int -> ActionMetadata -> ShowS
Show, ActionMetadata -> ActionMetadata -> Bool
(ActionMetadata -> ActionMetadata -> Bool)
-> (ActionMetadata -> ActionMetadata -> Bool) -> Eq ActionMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionMetadata -> ActionMetadata -> Bool
$c/= :: ActionMetadata -> ActionMetadata -> Bool
== :: ActionMetadata -> ActionMetadata -> Bool
$c== :: 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
$cto :: forall x. Rep ActionMetadata x -> ActionMetadata
$cfrom :: forall x. ActionMetadata -> Rep ActionMetadata x
Generic)

instance NFData ActionMetadata

instance Cacheable ActionMetadata

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
showList :: [ActionPermissionMetadata] -> ShowS
$cshowList :: [ActionPermissionMetadata] -> ShowS
show :: ActionPermissionMetadata -> String
$cshow :: ActionPermissionMetadata -> String
showsPrec :: Int -> ActionPermissionMetadata -> ShowS
$cshowsPrec :: Int -> ActionPermissionMetadata -> ShowS
Show, ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
(ActionPermissionMetadata -> ActionPermissionMetadata -> Bool)
-> (ActionPermissionMetadata -> ActionPermissionMetadata -> Bool)
-> Eq ActionPermissionMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
$c/= :: ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
== :: ActionPermissionMetadata -> ActionPermissionMetadata -> Bool
$c== :: 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
$cto :: forall x.
Rep ActionPermissionMetadata x -> ActionPermissionMetadata
$cfrom :: forall x.
ActionPermissionMetadata -> Rep ActionPermissionMetadata x
Generic)

instance NFData ActionPermissionMetadata

instance Cacheable ActionPermissionMetadata

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
showList :: [ActionName] -> ShowS
$cshowList :: [ActionName] -> ShowS
show :: ActionName -> String
$cshow :: ActionName -> String
showsPrec :: Int -> ActionName -> ShowS
$cshowsPrec :: Int -> ActionName -> ShowS
Show, ActionName -> ActionName -> Bool
(ActionName -> ActionName -> Bool)
-> (ActionName -> ActionName -> Bool) -> Eq ActionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionName -> ActionName -> Bool
$c/= :: ActionName -> ActionName -> Bool
== :: ActionName -> ActionName -> Bool
$c== :: 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
min :: ActionName -> ActionName -> ActionName
$cmin :: ActionName -> ActionName -> ActionName
max :: ActionName -> ActionName -> ActionName
$cmax :: ActionName -> ActionName -> ActionName
>= :: ActionName -> ActionName -> Bool
$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
compare :: ActionName -> ActionName -> Ordering
$ccompare :: ActionName -> ActionName -> Ordering
$cp1Ord :: Eq 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
parseJSONList :: Value -> Parser [ActionName]
$cparseJSONList :: Value -> Parser [ActionName]
parseJSON :: Value -> Parser ActionName
$cparseJSON :: 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
toEncodingList :: [ActionName] -> Encoding
$ctoEncodingList :: [ActionName] -> Encoding
toJSONList :: [ActionName] -> Value
$ctoJSONList :: [ActionName] -> Value
toEncoding :: ActionName -> Encoding
$ctoEncoding :: ActionName -> Encoding
toJSON :: ActionName -> Value
$ctoJSON :: ActionName -> Value
J.ToJSON, FromJSONKeyFunction [ActionName]
FromJSONKeyFunction ActionName
FromJSONKeyFunction ActionName
-> FromJSONKeyFunction [ActionName] -> FromJSONKey ActionName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ActionName]
$cfromJSONKeyList :: FromJSONKeyFunction [ActionName]
fromJSONKey :: FromJSONKeyFunction ActionName
$cfromJSONKey :: FromJSONKeyFunction ActionName
J.FromJSONKey, ToJSONKeyFunction [ActionName]
ToJSONKeyFunction ActionName
ToJSONKeyFunction ActionName
-> ToJSONKeyFunction [ActionName] -> ToJSONKey ActionName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ActionName]
$ctoJSONKeyList :: ToJSONKeyFunction [ActionName]
toJSONKey :: ToJSONKeyFunction ActionName
$ctoJSONKey :: ToJSONKeyFunction ActionName
J.ToJSONKey, ActionName -> Text
(ActionName -> Text) -> ToTxt ActionName
forall a. (a -> Text) -> ToTxt a
toTxt :: ActionName -> Text
$ctoTxt :: 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
$cto :: forall x. Rep ActionName x -> ActionName
$cfrom :: forall x. ActionName -> Rep ActionName x
Generic, ActionName -> ()
(ActionName -> ()) -> NFData ActionName
forall a. (a -> ()) -> NFData a
rnf :: ActionName -> ()
$crnf :: ActionName -> ()
NFData, Eq ActionName
Eq ActionName
-> (Accesses -> ActionName -> ActionName -> Bool)
-> Cacheable ActionName
Accesses -> ActionName -> ActionName -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> ActionName -> ActionName -> Bool
$cunchanged :: Accesses -> ActionName -> ActionName -> Bool
$cp1Cacheable :: Eq ActionName
Cacheable, Int -> ActionName -> Int
ActionName -> Int
(Int -> ActionName -> Int)
-> (ActionName -> Int) -> Hashable ActionName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ActionName -> Int
$chash :: ActionName -> Int
hashWithSalt :: Int -> ActionName -> Int
$chashWithSalt :: Int -> ActionName -> Int
Hashable)

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
showList :: [ActionId] -> ShowS
$cshowList :: [ActionId] -> ShowS
show :: ActionId -> String
$cshow :: ActionId -> String
showsPrec :: Int -> ActionId -> ShowS
$cshowsPrec :: Int -> ActionId -> ShowS
Show, ActionId -> ActionId -> Bool
(ActionId -> ActionId -> Bool)
-> (ActionId -> ActionId -> Bool) -> Eq ActionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionId -> ActionId -> Bool
$c/= :: ActionId -> ActionId -> Bool
== :: ActionId -> ActionId -> Bool
$c== :: ActionId -> ActionId -> Bool
Eq, ActionId -> PrepArg
(ActionId -> PrepArg) -> ToPrepArg ActionId
forall a. (a -> PrepArg) -> ToPrepArg a
toPrepVal :: ActionId -> PrepArg
$ctoPrepVal :: ActionId -> PrepArg
Q.ToPrepArg, Maybe ByteString -> Either Text ActionId
(Maybe ByteString -> Either Text ActionId) -> FromCol ActionId
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
fromCol :: Maybe ByteString -> Either Text ActionId
$cfromCol :: Maybe ByteString -> Either Text ActionId
Q.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
toEncodingList :: [ActionId] -> Encoding
$ctoEncodingList :: [ActionId] -> Encoding
toJSONList :: [ActionId] -> Value
$ctoJSONList :: [ActionId] -> Value
toEncoding :: ActionId -> Encoding
$ctoEncoding :: ActionId -> Encoding
toJSON :: ActionId -> Value
$ctoJSON :: ActionId -> Value
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
parseJSONList :: Value -> Parser [ActionId]
$cparseJSONList :: Value -> Parser [ActionId]
parseJSON :: Value -> Parser ActionId
$cparseJSON :: Value -> Parser ActionId
J.FromJSON, Int -> ActionId -> Int
ActionId -> Int
(Int -> ActionId -> Int) -> (ActionId -> Int) -> Hashable ActionId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ActionId -> Int
$chash :: ActionId -> Int
hashWithSalt :: Int -> ActionId -> Int
$chashWithSalt :: Int -> 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 Q.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
Q.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 (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 Q.ToPrepArg ActionName where
  toPrepVal :: ActionName -> PrepArg
toPrepVal = Text -> PrepArg
forall a. ToPrepArg a => a -> PrepArg
Q.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
  { ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adArguments :: [ArgumentDefinition arg],
    ActionDefinition arg webhook -> GraphQLType
_adOutputType :: GraphQLType,
    ActionDefinition arg webhook -> ActionType
_adType :: ActionType,
    ActionDefinition arg webhook -> [HeaderConf]
_adHeaders :: [HeaderConf],
    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
    ActionDefinition arg webhook -> Timeout
_adTimeout :: Timeout,
    ActionDefinition arg webhook -> webhook
_adHandler :: webhook,
    ActionDefinition arg webhook -> Maybe RequestTransform
_adRequestTransform :: Maybe RequestTransform,
    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
showList :: [ActionDefinition arg webhook] -> ShowS
$cshowList :: forall arg webhook.
(Show arg, Show webhook) =>
[ActionDefinition arg webhook] -> ShowS
show :: ActionDefinition arg webhook -> String
$cshow :: forall arg webhook.
(Show arg, Show webhook) =>
ActionDefinition arg webhook -> String
showsPrec :: Int -> ActionDefinition arg webhook -> ShowS
$cshowsPrec :: forall arg webhook.
(Show arg, Show webhook) =>
Int -> 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
/= :: 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
Eq, a -> ActionDefinition arg b -> ActionDefinition arg a
(a -> b) -> ActionDefinition arg a -> ActionDefinition arg b
(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
<$ :: a -> ActionDefinition arg b -> ActionDefinition arg a
$c<$ :: forall arg a b.
a -> ActionDefinition arg b -> ActionDefinition arg a
fmap :: (a -> b) -> ActionDefinition arg a -> ActionDefinition arg b
$cfmap :: forall arg a b.
(a -> b) -> ActionDefinition arg a -> ActionDefinition arg b
Functor, ActionDefinition arg a -> Bool
(a -> m) -> ActionDefinition arg a -> m
(a -> b -> b) -> b -> ActionDefinition arg a -> b
(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 a. ActionDefinition arg a -> 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
product :: ActionDefinition arg a -> a
$cproduct :: forall arg a. Num a => ActionDefinition arg a -> a
sum :: ActionDefinition arg a -> a
$csum :: forall arg a. Num a => ActionDefinition arg a -> a
minimum :: ActionDefinition arg a -> a
$cminimum :: forall arg a. Ord a => ActionDefinition arg a -> a
maximum :: ActionDefinition arg a -> a
$cmaximum :: forall arg a. Ord a => ActionDefinition arg a -> a
elem :: a -> ActionDefinition arg a -> Bool
$celem :: forall arg a. Eq a => a -> ActionDefinition arg a -> Bool
length :: ActionDefinition arg a -> Int
$clength :: forall arg a. ActionDefinition arg a -> Int
null :: ActionDefinition arg a -> Bool
$cnull :: forall arg a. ActionDefinition arg a -> Bool
toList :: ActionDefinition arg a -> [a]
$ctoList :: forall arg a. ActionDefinition arg a -> [a]
foldl1 :: (a -> a -> a) -> ActionDefinition arg a -> a
$cfoldl1 :: forall arg a. (a -> a -> a) -> ActionDefinition arg a -> a
foldr1 :: (a -> a -> a) -> ActionDefinition arg a -> a
$cfoldr1 :: forall arg a. (a -> a -> a) -> ActionDefinition arg a -> a
foldl' :: (b -> a -> b) -> b -> ActionDefinition arg a -> b
$cfoldl' :: forall arg b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
foldl :: (b -> a -> b) -> b -> ActionDefinition arg a -> b
$cfoldl :: forall arg b a. (b -> a -> b) -> b -> ActionDefinition arg a -> b
foldr' :: (a -> b -> b) -> b -> ActionDefinition arg a -> b
$cfoldr' :: forall arg a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
foldr :: (a -> b -> b) -> b -> ActionDefinition arg a -> b
$cfoldr :: forall arg a b. (a -> b -> b) -> b -> ActionDefinition arg a -> b
foldMap' :: (a -> m) -> ActionDefinition arg a -> m
$cfoldMap' :: forall arg m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
foldMap :: (a -> m) -> ActionDefinition arg a -> m
$cfoldMap :: forall arg m a. Monoid m => (a -> m) -> ActionDefinition arg a -> m
fold :: ActionDefinition arg m -> m
$cfold :: forall arg m. Monoid m => ActionDefinition arg m -> m
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)
(a -> f b) -> ActionDefinition arg a -> f (ActionDefinition arg b)
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)
sequence :: ActionDefinition arg (m a) -> m (ActionDefinition arg a)
$csequence :: forall arg (m :: * -> *) a.
Monad m =>
ActionDefinition arg (m a) -> m (ActionDefinition arg a)
mapM :: (a -> m b) -> ActionDefinition arg a -> m (ActionDefinition arg b)
$cmapM :: forall arg (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ActionDefinition arg a -> m (ActionDefinition arg b)
sequenceA :: ActionDefinition arg (f a) -> f (ActionDefinition arg a)
$csequenceA :: forall arg (f :: * -> *) a.
Applicative f =>
ActionDefinition arg (f a) -> f (ActionDefinition arg a)
traverse :: (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)
$cp2Traversable :: forall arg. Foldable (ActionDefinition arg)
$cp1Traversable :: forall arg. Functor (ActionDefinition arg)
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
$cto :: forall arg webhook x.
Rep (ActionDefinition arg webhook) x
-> ActionDefinition arg webhook
$cfrom :: forall arg webhook x.
ActionDefinition arg webhook
-> Rep (ActionDefinition arg webhook) x
Generic)

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

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

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
showList :: [ActionType] -> ShowS
$cshowList :: [ActionType] -> ShowS
show :: ActionType -> String
$cshow :: ActionType -> String
showsPrec :: Int -> ActionType -> ShowS
$cshowsPrec :: Int -> ActionType -> ShowS
Show, ActionType -> ActionType -> Bool
(ActionType -> ActionType -> Bool)
-> (ActionType -> ActionType -> Bool) -> Eq ActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionType -> ActionType -> Bool
$c/= :: ActionType -> ActionType -> Bool
== :: ActionType -> ActionType -> Bool
$c== :: 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
$cto :: forall x. Rep ActionType x -> ActionType
$cfrom :: forall x. ActionType -> Rep ActionType x
Generic)

instance NFData ActionType

instance Cacheable 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
showList :: [ActionMutationKind] -> ShowS
$cshowList :: [ActionMutationKind] -> ShowS
show :: ActionMutationKind -> String
$cshow :: ActionMutationKind -> String
showsPrec :: Int -> ActionMutationKind -> ShowS
$cshowsPrec :: Int -> ActionMutationKind -> ShowS
Show, ActionMutationKind -> ActionMutationKind -> Bool
(ActionMutationKind -> ActionMutationKind -> Bool)
-> (ActionMutationKind -> ActionMutationKind -> Bool)
-> Eq ActionMutationKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionMutationKind -> ActionMutationKind -> Bool
$c/= :: ActionMutationKind -> ActionMutationKind -> Bool
== :: ActionMutationKind -> ActionMutationKind -> Bool
$c== :: 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
$cto :: forall x. Rep ActionMutationKind x -> ActionMutationKind
$cfrom :: forall x. ActionMutationKind -> Rep ActionMutationKind x
Generic)

instance NFData ActionMutationKind

instance Cacheable ActionMutationKind

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

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

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

instance (Cacheable a) => Cacheable (ArgumentDefinition a)

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
showList :: [ArgumentName] -> ShowS
$cshowList :: [ArgumentName] -> ShowS
show :: ArgumentName -> String
$cshow :: ArgumentName -> String
showsPrec :: Int -> ArgumentName -> ShowS
$cshowsPrec :: Int -> ArgumentName -> ShowS
Show, ArgumentName -> ArgumentName -> Bool
(ArgumentName -> ArgumentName -> Bool)
-> (ArgumentName -> ArgumentName -> Bool) -> Eq ArgumentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgumentName -> ArgumentName -> Bool
$c/= :: ArgumentName -> ArgumentName -> Bool
== :: ArgumentName -> ArgumentName -> Bool
$c== :: 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
parseJSONList :: Value -> Parser [ArgumentName]
$cparseJSONList :: Value -> Parser [ArgumentName]
parseJSON :: Value -> Parser ArgumentName
$cparseJSON :: 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
toEncodingList :: [ArgumentName] -> Encoding
$ctoEncodingList :: [ArgumentName] -> Encoding
toJSONList :: [ArgumentName] -> Value
$ctoJSONList :: [ArgumentName] -> Value
toEncoding :: ArgumentName -> Encoding
$ctoEncoding :: ArgumentName -> Encoding
toJSON :: ArgumentName -> Value
$ctoJSON :: ArgumentName -> Value
J.ToJSON, FromJSONKeyFunction [ArgumentName]
FromJSONKeyFunction ArgumentName
FromJSONKeyFunction ArgumentName
-> FromJSONKeyFunction [ArgumentName] -> FromJSONKey ArgumentName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ArgumentName]
$cfromJSONKeyList :: FromJSONKeyFunction [ArgumentName]
fromJSONKey :: FromJSONKeyFunction ArgumentName
$cfromJSONKey :: FromJSONKeyFunction ArgumentName
J.FromJSONKey, ToJSONKeyFunction [ArgumentName]
ToJSONKeyFunction ArgumentName
ToJSONKeyFunction ArgumentName
-> ToJSONKeyFunction [ArgumentName] -> ToJSONKey ArgumentName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ArgumentName]
$ctoJSONKeyList :: ToJSONKeyFunction [ArgumentName]
toJSONKey :: ToJSONKeyFunction ArgumentName
$ctoJSONKey :: ToJSONKeyFunction ArgumentName
J.ToJSONKey, ArgumentName -> Text
(ArgumentName -> Text) -> ToTxt ArgumentName
forall a. (a -> Text) -> ToTxt a
toTxt :: ArgumentName -> Text
$ctoTxt :: 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
$cto :: forall x. Rep ArgumentName x -> ArgumentName
$cfrom :: forall x. ArgumentName -> Rep ArgumentName x
Generic, ArgumentName -> ()
(ArgumentName -> ()) -> NFData ArgumentName
forall a. (a -> ()) -> NFData a
rnf :: ArgumentName -> ()
$crnf :: ArgumentName -> ()
NFData, Eq ArgumentName
Eq ArgumentName
-> (Accesses -> ArgumentName -> ArgumentName -> Bool)
-> Cacheable ArgumentName
Accesses -> ArgumentName -> ArgumentName -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> ArgumentName -> ArgumentName -> Bool
$cunchanged :: Accesses -> ArgumentName -> ArgumentName -> Bool
$cp1Cacheable :: Eq ArgumentName
Cacheable)

--------------------------------------------------------------------------------
-- 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
$cto :: forall x. Rep ActionInfo x -> ActionInfo
$cfrom :: forall x. ActionInfo -> Rep ActionInfo x
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
showList :: [ActionPermissionInfo] -> ShowS
$cshowList :: [ActionPermissionInfo] -> ShowS
show :: ActionPermissionInfo -> String
$cshow :: ActionPermissionInfo -> String
showsPrec :: Int -> ActionPermissionInfo -> ShowS
$cshowsPrec :: Int -> ActionPermissionInfo -> ShowS
Show, ActionPermissionInfo -> ActionPermissionInfo -> Bool
(ActionPermissionInfo -> ActionPermissionInfo -> Bool)
-> (ActionPermissionInfo -> ActionPermissionInfo -> Bool)
-> Eq ActionPermissionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionPermissionInfo -> ActionPermissionInfo -> Bool
$c/= :: ActionPermissionInfo -> ActionPermissionInfo -> Bool
== :: ActionPermissionInfo -> ActionPermissionInfo -> Bool
$c== :: 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
parseJSONList :: Value -> Parser [ActionPermissionInfo]
$cparseJSONList :: Value -> Parser [ActionPermissionInfo]
parseJSON :: Value -> Parser ActionPermissionInfo
$cparseJSON :: 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
toEncodingList :: [ActionPermissionInfo] -> Encoding
$ctoEncodingList :: [ActionPermissionInfo] -> Encoding
toJSONList :: [ActionPermissionInfo] -> Value
$ctoJSONList :: [ActionPermissionInfo] -> Value
toEncoding :: ActionPermissionInfo -> Encoding
$ctoEncoding :: ActionPermissionInfo -> Encoding
toJSON :: ActionPermissionInfo -> Value
$ctoJSON :: ActionPermissionInfo -> Value
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 -> Manager
_aecManager :: HTTP.Manager,
    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
showList :: [ActionLogItem] -> ShowS
$cshowList :: [ActionLogItem] -> ShowS
show :: ActionLogItem -> String
$cshow :: ActionLogItem -> String
showsPrec :: Int -> ActionLogItem -> ShowS
$cshowsPrec :: Int -> ActionLogItem -> ShowS
Show, ActionLogItem -> ActionLogItem -> Bool
(ActionLogItem -> ActionLogItem -> Bool)
-> (ActionLogItem -> ActionLogItem -> Bool) -> Eq ActionLogItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionLogItem -> ActionLogItem -> Bool
$c/= :: ActionLogItem -> ActionLogItem -> Bool
== :: ActionLogItem -> ActionLogItem -> Bool
$c== :: 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 (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
showList :: [ActionLogResponse] -> ShowS
$cshowList :: [ActionLogResponse] -> ShowS
show :: ActionLogResponse -> String
$cshow :: ActionLogResponse -> String
showsPrec :: Int -> ActionLogResponse -> ShowS
$cshowsPrec :: Int -> ActionLogResponse -> ShowS
Show, ActionLogResponse -> ActionLogResponse -> Bool
(ActionLogResponse -> ActionLogResponse -> Bool)
-> (ActionLogResponse -> ActionLogResponse -> Bool)
-> Eq ActionLogResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionLogResponse -> ActionLogResponse -> Bool
$c/= :: ActionLogResponse -> ActionLogResponse -> Bool
== :: ActionLogResponse -> ActionLogResponse -> Bool
$c== :: ActionLogResponse -> ActionLogResponse -> Bool
Eq)

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
showList :: [ActionsInfo] -> ShowS
$cshowList :: [ActionsInfo] -> ShowS
show :: ActionsInfo -> String
$cshow :: ActionsInfo -> String
showsPrec :: Int -> ActionsInfo -> ShowS
$cshowsPrec :: Int -> ActionsInfo -> ShowS
Show, ActionsInfo -> ActionsInfo -> Bool
(ActionsInfo -> ActionsInfo -> Bool)
-> (ActionsInfo -> ActionsInfo -> Bool) -> Eq ActionsInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionsInfo -> ActionsInfo -> Bool
$c/= :: ActionsInfo -> ActionsInfo -> Bool
== :: ActionsInfo -> ActionsInfo -> Bool
$c== :: 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
$cto :: forall x. Rep ActionsInfo x -> ActionsInfo
$cfrom :: forall x. ActionsInfo -> Rep ActionsInfo x
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
showList :: [LockedActionIdArray] -> ShowS
$cshowList :: [LockedActionIdArray] -> ShowS
show :: LockedActionIdArray -> String
$cshow :: LockedActionIdArray -> String
showsPrec :: Int -> LockedActionIdArray -> ShowS
$cshowsPrec :: Int -> LockedActionIdArray -> ShowS
Show, LockedActionIdArray -> LockedActionIdArray -> Bool
(LockedActionIdArray -> LockedActionIdArray -> Bool)
-> (LockedActionIdArray -> LockedActionIdArray -> Bool)
-> Eq LockedActionIdArray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockedActionIdArray -> LockedActionIdArray -> Bool
$c/= :: LockedActionIdArray -> LockedActionIdArray -> Bool
== :: LockedActionIdArray -> LockedActionIdArray -> Bool
$c== :: LockedActionIdArray -> LockedActionIdArray -> Bool
Eq)

instance Q.ToPrepArg LockedActionIdArray where
  toPrepVal :: LockedActionIdArray -> PrepArg
toPrepVal (LockedActionIdArray [LockedActionEventId]
l) =
    Oid -> ([UUID] -> Encoding) -> [UUID] -> PrepArg
forall a. Oid -> (a -> Encoding) -> a -> PrepArg
Q.toPrepValHelper Oid
PTI.unknown [UUID] -> Encoding
encoder ([UUID] -> PrepArg) -> [UUID] -> PrepArg
forall a b. (a -> b) -> a -> b
$ (LockedActionEventId -> Maybe UUID)
-> [LockedActionEventId] -> [UUID]
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 forall b. (b -> UUID -> b) -> b -> [UUID] -> 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...

$(J.deriveJSON hasuraJSON {J.omitNothingFields = True} ''ActionPermissionMetadata)

$(J.deriveJSON hasuraJSON ''ArgumentDefinition)
$(J.deriveJSON J.defaultOptions {J.constructorTagModifier = J.snakeCase . drop 6} ''ActionMutationKind)

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 (f :: * -> *) a. Applicative f => a -> f a
pure ActionType
ActionQuery
      String
t -> String -> Parser ActionType
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 (f :: * -> *) a. Applicative f => a -> f a
pure ActionDefinition :: forall arg webhook.
[ArgumentDefinition arg]
-> GraphQLType
-> ActionType
-> [HeaderConf]
-> Bool
-> Timeout
-> webhook
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> ActionDefinition arg webhook
ActionDefinition {b
Bool
[HeaderConf]
[ArgumentDefinition a]
Maybe MetadataResponseTransform
Maybe RequestTransform
Timeout
GraphQLType
ActionType
_adResponseTransform :: Maybe MetadataResponseTransform
_adRequestTransform :: Maybe RequestTransform
_adType :: ActionType
_adTimeout :: Timeout
_adHandler :: b
_adForwardClientHeaders :: Bool
_adHeaders :: [HeaderConf]
_adOutputType :: GraphQLType
_adArguments :: [ArgumentDefinition a]
_adResponseTransform :: Maybe MetadataResponseTransform
_adRequestTransform :: Maybe RequestTransform
_adHandler :: b
_adTimeout :: Timeout
_adForwardClientHeaders :: Bool
_adHeaders :: [HeaderConf]
_adType :: ActionType
_adOutputType :: GraphQLType
_adArguments :: [ArgumentDefinition a]
..}

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 (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 (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 (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 MetadataResponseTransform
Maybe RequestTransform
Timeout
GraphQLType
ActionType
_adResponseTransform :: Maybe MetadataResponseTransform
_adRequestTransform :: Maybe RequestTransform
_adHandler :: b
_adTimeout :: Timeout
_adForwardClientHeaders :: Bool
_adHeaders :: [HeaderConf]
_adType :: ActionType
_adOutputType :: GraphQLType
_adArguments :: [ArgumentDefinition a]
_adResponseTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe MetadataResponseTransform
_adRequestTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe RequestTransform
_adHandler :: forall arg webhook. ActionDefinition arg webhook -> webhook
_adTimeout :: forall arg webhook. ActionDefinition arg webhook -> Timeout
_adForwardClientHeaders :: forall arg a. ActionDefinition arg a -> Bool
_adHeaders :: forall arg webhook. ActionDefinition arg webhook -> [HeaderConf]
_adType :: forall arg webhook. ActionDefinition arg webhook -> ActionType
_adOutputType :: forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adArguments :: forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
..}) =
    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
.= (String
"query" :: String)]
          ActionMutation ActionMutationKind
kind ->
            [ Key
"type" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
"mutation" :: String),
              Key
"kind" Key -> ActionMutationKind -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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
.= [ArgumentDefinition a]
_adArguments,
            Key
"output_type" Key -> GraphQLType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GraphQLType
_adOutputType,
            Key
"headers" Key -> [HeaderConf] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [HeaderConf]
_adHeaders,
            Key
"forward_client_headers" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
_adForwardClientHeaders,
            Key
"handler" Key -> b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= b
_adHandler,
            Key
"timeout" Key -> Timeout -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Timeout
_adTimeout
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
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
.=) (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
.=) (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

$(J.deriveToJSON hasuraJSON ''ActionLogResponse)
$(J.deriveToJSON hasuraJSON ''ActionMetadata)
$(J.deriveToJSON hasuraJSON ''ActionInfo)

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