{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE UndecidableInstances #-}

-- | types and helpers for user-defined-functions after they have been resolved
-- in the schema cache
module Hasura.Function.Cache
  ( DBFunctionsMetadata,
    FunctionOverloads (..),
    FunctionArgName (..),
    FunctionCache,
    FunctionConfig (..),
    FunctionCustomRootFields (..),
    FunctionExposedAs (..),
    FunctionInfo (..),
    FunctionInputArgument,
    FunctionPermissionInfo (..),
    FunctionPermissionsMap,
    FunctionVolatility (..),
    InputArgument (..),
    FunctionArgsExpG (..),
    FunctionArgsExp,
    TrackableFunctionInfo (..),
    TrackableTableInfo (..),
    TrackableInfo (..),
    emptyFunctionConfig,
    emptyFunctionCustomRootFields,
    funcTypToTxt,
    emptyFunctionArgsExp,
  )
where

import Autodocodec (HasCodec (codec))
import Autodocodec qualified as AC
import Autodocodec.Extended (graphQLFieldNameCodec)
import Control.Lens
import Data.Aeson
import Data.Aeson.Casing
import Data.Char (toLower)
import Data.HashMap.Strict qualified as HashMap
import Data.List.Extended as LE
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Roles (RoleName)
import Language.GraphQL.Draft.Syntax qualified as G
import Language.Haskell.TH.Syntax

-- | https://www.postgresql.org/docs/current/xfunc-volatility.html
data FunctionVolatility
  = FTVOLATILE
  | FTIMMUTABLE
  | FTSTABLE
  deriving (FunctionVolatility -> FunctionVolatility -> Bool
(FunctionVolatility -> FunctionVolatility -> Bool)
-> (FunctionVolatility -> FunctionVolatility -> Bool)
-> Eq FunctionVolatility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionVolatility -> FunctionVolatility -> Bool
== :: FunctionVolatility -> FunctionVolatility -> Bool
$c/= :: FunctionVolatility -> FunctionVolatility -> Bool
/= :: FunctionVolatility -> FunctionVolatility -> Bool
Eq, (forall x. FunctionVolatility -> Rep FunctionVolatility x)
-> (forall x. Rep FunctionVolatility x -> FunctionVolatility)
-> Generic FunctionVolatility
forall x. Rep FunctionVolatility x -> FunctionVolatility
forall x. FunctionVolatility -> Rep FunctionVolatility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionVolatility -> Rep FunctionVolatility x
from :: forall x. FunctionVolatility -> Rep FunctionVolatility x
$cto :: forall x. Rep FunctionVolatility x -> FunctionVolatility
to :: forall x. Rep FunctionVolatility x -> FunctionVolatility
Generic)

instance NFData FunctionVolatility

instance FromJSON FunctionVolatility where
  parseJSON :: Value -> Parser FunctionVolatility
parseJSON = Options -> Value -> Parser FunctionVolatility
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {constructorTagModifier :: String -> String
constructorTagModifier = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2}

instance ToJSON FunctionVolatility where
  toJSON :: FunctionVolatility -> Value
toJSON = Options -> FunctionVolatility -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier :: String -> String
constructorTagModifier = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2}
  toEncoding :: FunctionVolatility -> Encoding
toEncoding = Options -> FunctionVolatility -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier :: String -> String
constructorTagModifier = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2}

funcTypToTxt :: FunctionVolatility -> Text
funcTypToTxt :: FunctionVolatility -> Text
funcTypToTxt FunctionVolatility
FTVOLATILE = Text
"VOLATILE"
funcTypToTxt FunctionVolatility
FTIMMUTABLE = Text
"IMMUTABLE"
funcTypToTxt FunctionVolatility
FTSTABLE = Text
"STABLE"

instance Show FunctionVolatility where
  show :: FunctionVolatility -> String
show = Text -> String
T.unpack (Text -> String)
-> (FunctionVolatility -> Text) -> FunctionVolatility -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionVolatility -> Text
funcTypToTxt

newtype FunctionArgName = FunctionArgName {FunctionArgName -> Text
getFuncArgNameTxt :: Text}
  deriving (Int -> FunctionArgName -> String -> String
[FunctionArgName] -> String -> String
FunctionArgName -> String
(Int -> FunctionArgName -> String -> String)
-> (FunctionArgName -> String)
-> ([FunctionArgName] -> String -> String)
-> Show FunctionArgName
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FunctionArgName -> String -> String
showsPrec :: Int -> FunctionArgName -> String -> String
$cshow :: FunctionArgName -> String
show :: FunctionArgName -> String
$cshowList :: [FunctionArgName] -> String -> String
showList :: [FunctionArgName] -> String -> String
Show, FunctionArgName -> FunctionArgName -> Bool
(FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> Eq FunctionArgName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionArgName -> FunctionArgName -> Bool
== :: FunctionArgName -> FunctionArgName -> Bool
$c/= :: FunctionArgName -> FunctionArgName -> Bool
/= :: FunctionArgName -> FunctionArgName -> Bool
Eq, Eq FunctionArgName
Eq FunctionArgName
-> (FunctionArgName -> FunctionArgName -> Ordering)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> Bool)
-> (FunctionArgName -> FunctionArgName -> FunctionArgName)
-> (FunctionArgName -> FunctionArgName -> FunctionArgName)
-> Ord FunctionArgName
FunctionArgName -> FunctionArgName -> Bool
FunctionArgName -> FunctionArgName -> Ordering
FunctionArgName -> FunctionArgName -> FunctionArgName
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 :: FunctionArgName -> FunctionArgName -> Ordering
compare :: FunctionArgName -> FunctionArgName -> Ordering
$c< :: FunctionArgName -> FunctionArgName -> Bool
< :: FunctionArgName -> FunctionArgName -> Bool
$c<= :: FunctionArgName -> FunctionArgName -> Bool
<= :: FunctionArgName -> FunctionArgName -> Bool
$c> :: FunctionArgName -> FunctionArgName -> Bool
> :: FunctionArgName -> FunctionArgName -> Bool
$c>= :: FunctionArgName -> FunctionArgName -> Bool
>= :: FunctionArgName -> FunctionArgName -> Bool
$cmax :: FunctionArgName -> FunctionArgName -> FunctionArgName
max :: FunctionArgName -> FunctionArgName -> FunctionArgName
$cmin :: FunctionArgName -> FunctionArgName -> FunctionArgName
min :: FunctionArgName -> FunctionArgName -> FunctionArgName
Ord, FunctionArgName -> ()
(FunctionArgName -> ()) -> NFData FunctionArgName
forall a. (a -> ()) -> NFData a
$crnf :: FunctionArgName -> ()
rnf :: FunctionArgName -> ()
NFData, [FunctionArgName] -> Value
[FunctionArgName] -> Encoding
FunctionArgName -> Value
FunctionArgName -> Encoding
(FunctionArgName -> Value)
-> (FunctionArgName -> Encoding)
-> ([FunctionArgName] -> Value)
-> ([FunctionArgName] -> Encoding)
-> ToJSON FunctionArgName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FunctionArgName -> Value
toJSON :: FunctionArgName -> Value
$ctoEncoding :: FunctionArgName -> Encoding
toEncoding :: FunctionArgName -> Encoding
$ctoJSONList :: [FunctionArgName] -> Value
toJSONList :: [FunctionArgName] -> Value
$ctoEncodingList :: [FunctionArgName] -> Encoding
toEncodingList :: [FunctionArgName] -> Encoding
ToJSON, ToJSONKeyFunction [FunctionArgName]
ToJSONKeyFunction FunctionArgName
ToJSONKeyFunction FunctionArgName
-> ToJSONKeyFunction [FunctionArgName] -> ToJSONKey FunctionArgName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction FunctionArgName
toJSONKey :: ToJSONKeyFunction FunctionArgName
$ctoJSONKeyList :: ToJSONKeyFunction [FunctionArgName]
toJSONKeyList :: ToJSONKeyFunction [FunctionArgName]
ToJSONKey, Value -> Parser [FunctionArgName]
Value -> Parser FunctionArgName
(Value -> Parser FunctionArgName)
-> (Value -> Parser [FunctionArgName]) -> FromJSON FunctionArgName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FunctionArgName
parseJSON :: Value -> Parser FunctionArgName
$cparseJSONList :: Value -> Parser [FunctionArgName]
parseJSONList :: Value -> Parser [FunctionArgName]
FromJSON, FromJSONKeyFunction [FunctionArgName]
FromJSONKeyFunction FunctionArgName
FromJSONKeyFunction FunctionArgName
-> FromJSONKeyFunction [FunctionArgName]
-> FromJSONKey FunctionArgName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction FunctionArgName
fromJSONKey :: FromJSONKeyFunction FunctionArgName
$cfromJSONKeyList :: FromJSONKeyFunction [FunctionArgName]
fromJSONKeyList :: FromJSONKeyFunction [FunctionArgName]
FromJSONKey, FunctionArgName -> Text
(FunctionArgName -> Text) -> ToTxt FunctionArgName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: FunctionArgName -> Text
toTxt :: FunctionArgName -> Text
ToTxt, String -> FunctionArgName
(String -> FunctionArgName) -> IsString FunctionArgName
forall a. (String -> a) -> IsString a
$cfromString :: String -> FunctionArgName
fromString :: String -> FunctionArgName
IsString, (forall x. FunctionArgName -> Rep FunctionArgName x)
-> (forall x. Rep FunctionArgName x -> FunctionArgName)
-> Generic FunctionArgName
forall x. Rep FunctionArgName x -> FunctionArgName
forall x. FunctionArgName -> Rep FunctionArgName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionArgName -> Rep FunctionArgName x
from :: forall x. FunctionArgName -> Rep FunctionArgName x
$cto :: forall x. Rep FunctionArgName x -> FunctionArgName
to :: forall x. Rep FunctionArgName x -> FunctionArgName
Generic, Eq FunctionArgName
Eq FunctionArgName
-> (Int -> FunctionArgName -> Int)
-> (FunctionArgName -> Int)
-> Hashable FunctionArgName
Int -> FunctionArgName -> Int
FunctionArgName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> FunctionArgName -> Int
hashWithSalt :: Int -> FunctionArgName -> Int
$chash :: FunctionArgName -> Int
hash :: FunctionArgName -> Int
Hashable, (forall (m :: * -> *). Quote m => FunctionArgName -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    FunctionArgName -> Code m FunctionArgName)
-> Lift FunctionArgName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FunctionArgName -> m Exp
forall (m :: * -> *).
Quote m =>
FunctionArgName -> Code m FunctionArgName
$clift :: forall (m :: * -> *). Quote m => FunctionArgName -> m Exp
lift :: forall (m :: * -> *). Quote m => FunctionArgName -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
FunctionArgName -> Code m FunctionArgName
liftTyped :: forall (m :: * -> *).
Quote m =>
FunctionArgName -> Code m FunctionArgName
Lift, Typeable FunctionArgName
Typeable FunctionArgName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionArgName)
-> (FunctionArgName -> Constr)
-> (FunctionArgName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionArgName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionArgName))
-> ((forall b. Data b => b -> b)
    -> FunctionArgName -> FunctionArgName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FunctionArgName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FunctionArgName -> m FunctionArgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionArgName -> m FunctionArgName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FunctionArgName -> m FunctionArgName)
-> Data FunctionArgName
FunctionArgName -> Constr
FunctionArgName -> DataType
(forall b. Data b => b -> b) -> FunctionArgName -> FunctionArgName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u
forall u. (forall d. Data d => d -> u) -> FunctionArgName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArgName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionArgName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArgName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionArgName -> c FunctionArgName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArgName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionArgName
$ctoConstr :: FunctionArgName -> Constr
toConstr :: FunctionArgName -> Constr
$cdataTypeOf :: FunctionArgName -> DataType
dataTypeOf :: FunctionArgName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionArgName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionArgName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArgName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionArgName)
$cgmapT :: (forall b. Data b => b -> b) -> FunctionArgName -> FunctionArgName
gmapT :: (forall b. Data b => b -> b) -> FunctionArgName -> FunctionArgName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionArgName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionArgName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionArgName -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionArgName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionArgName -> m FunctionArgName
Data)

instance AC.HasCodec FunctionArgName where
  codec :: JSONCodec FunctionArgName
codec = (Text -> FunctionArgName)
-> (FunctionArgName -> Text)
-> Codec Value Text Text
-> JSONCodec FunctionArgName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
AC.dimapCodec Text -> FunctionArgName
FunctionArgName FunctionArgName -> Text
getFuncArgNameTxt Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec

data InputArgument a
  = IAUserProvided a
  | IASessionVariables FunctionArgName
  deriving (Int -> InputArgument a -> String -> String
[InputArgument a] -> String -> String
InputArgument a -> String
(Int -> InputArgument a -> String -> String)
-> (InputArgument a -> String)
-> ([InputArgument a] -> String -> String)
-> Show (InputArgument a)
forall a. Show a => Int -> InputArgument a -> String -> String
forall a. Show a => [InputArgument a] -> String -> String
forall a. Show a => InputArgument a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> InputArgument a -> String -> String
showsPrec :: Int -> InputArgument a -> String -> String
$cshow :: forall a. Show a => InputArgument a -> String
show :: InputArgument a -> String
$cshowList :: forall a. Show a => [InputArgument a] -> String -> String
showList :: [InputArgument a] -> String -> String
Show, InputArgument a -> InputArgument a -> Bool
(InputArgument a -> InputArgument a -> Bool)
-> (InputArgument a -> InputArgument a -> Bool)
-> Eq (InputArgument a)
forall a. Eq a => InputArgument a -> InputArgument a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => InputArgument a -> InputArgument a -> Bool
== :: InputArgument a -> InputArgument a -> Bool
$c/= :: forall a. Eq a => InputArgument a -> InputArgument a -> Bool
/= :: InputArgument a -> InputArgument a -> Bool
Eq, (forall a b. (a -> b) -> InputArgument a -> InputArgument b)
-> (forall a b. a -> InputArgument b -> InputArgument a)
-> Functor InputArgument
forall a b. a -> InputArgument b -> InputArgument a
forall a b. (a -> b) -> InputArgument a -> InputArgument 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) -> InputArgument a -> InputArgument b
fmap :: forall a b. (a -> b) -> InputArgument a -> InputArgument b
$c<$ :: forall a b. a -> InputArgument b -> InputArgument a
<$ :: forall a b. a -> InputArgument b -> InputArgument a
Functor, (forall x. InputArgument a -> Rep (InputArgument a) x)
-> (forall x. Rep (InputArgument a) x -> InputArgument a)
-> Generic (InputArgument a)
forall x. Rep (InputArgument a) x -> InputArgument a
forall x. InputArgument a -> Rep (InputArgument a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (InputArgument a) x -> InputArgument a
forall a x. InputArgument a -> Rep (InputArgument a) x
$cfrom :: forall a x. InputArgument a -> Rep (InputArgument a) x
from :: forall x. InputArgument a -> Rep (InputArgument a) x
$cto :: forall a x. Rep (InputArgument a) x -> InputArgument a
to :: forall x. Rep (InputArgument a) x -> InputArgument a
Generic)

instance (ToJSON a) => ToJSON (InputArgument a) where
  toJSON :: InputArgument a -> Value
toJSON = Options -> InputArgument a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier :: String -> String
constructorTagModifier = String -> String
snakeCase (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2, sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject String
"type" String
"argument"}
  toEncoding :: InputArgument a -> Encoding
toEncoding = Options -> InputArgument a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier :: String -> String
constructorTagModifier = String -> String
snakeCase (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2, sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject String
"type" String
"argument"}

type FunctionInputArgument b = InputArgument (FunctionArgument b)

-- | Indicates whether the user requested the corresponding function to be
-- tracked as a mutation or a query/subscription, in @track_function@.
data FunctionExposedAs = FEAQuery | FEAMutation
  deriving (Int -> FunctionExposedAs -> String -> String
[FunctionExposedAs] -> String -> String
FunctionExposedAs -> String
(Int -> FunctionExposedAs -> String -> String)
-> (FunctionExposedAs -> String)
-> ([FunctionExposedAs] -> String -> String)
-> Show FunctionExposedAs
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FunctionExposedAs -> String -> String
showsPrec :: Int -> FunctionExposedAs -> String -> String
$cshow :: FunctionExposedAs -> String
show :: FunctionExposedAs -> String
$cshowList :: [FunctionExposedAs] -> String -> String
showList :: [FunctionExposedAs] -> String -> String
Show, FunctionExposedAs -> FunctionExposedAs -> Bool
(FunctionExposedAs -> FunctionExposedAs -> Bool)
-> (FunctionExposedAs -> FunctionExposedAs -> Bool)
-> Eq FunctionExposedAs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionExposedAs -> FunctionExposedAs -> Bool
== :: FunctionExposedAs -> FunctionExposedAs -> Bool
$c/= :: FunctionExposedAs -> FunctionExposedAs -> Bool
/= :: FunctionExposedAs -> FunctionExposedAs -> Bool
Eq, (forall x. FunctionExposedAs -> Rep FunctionExposedAs x)
-> (forall x. Rep FunctionExposedAs x -> FunctionExposedAs)
-> Generic FunctionExposedAs
forall x. Rep FunctionExposedAs x -> FunctionExposedAs
forall x. FunctionExposedAs -> Rep FunctionExposedAs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionExposedAs -> Rep FunctionExposedAs x
from :: forall x. FunctionExposedAs -> Rep FunctionExposedAs x
$cto :: forall x. Rep FunctionExposedAs x -> FunctionExposedAs
to :: forall x. Rep FunctionExposedAs x -> FunctionExposedAs
Generic)

instance NFData FunctionExposedAs

instance HasCodec FunctionExposedAs where
  codec :: JSONCodec FunctionExposedAs
codec = NonEmpty (FunctionExposedAs, Text) -> JSONCodec FunctionExposedAs
forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
AC.stringConstCodec [(FunctionExposedAs
FEAQuery, Text
"query"), (FunctionExposedAs
FEAMutation, Text
"mutation")]

instance FromJSON FunctionExposedAs where
  parseJSON :: Value -> Parser FunctionExposedAs
parseJSON = Options -> Value -> Parser FunctionExposedAs
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue, constructorTagModifier :: String -> String
constructorTagModifier = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3}

instance ToJSON FunctionExposedAs where
  toJSON :: FunctionExposedAs -> Value
toJSON = Options -> FunctionExposedAs -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue, constructorTagModifier :: String -> String
constructorTagModifier = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3}
  toEncoding :: FunctionExposedAs -> Encoding
toEncoding = Options -> FunctionExposedAs -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue, constructorTagModifier :: String -> String
constructorTagModifier = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3}

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

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

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

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

type FunctionPermissionsMap = HashMap RoleName FunctionPermissionInfo

-- | Custom root fields for functions. When set, will be the names exposed
--   to the user in the schema.
--
--   See rfcs/function-root-field-customisation.md for more information.
data FunctionCustomRootFields = FunctionCustomRootFields
  { FunctionCustomRootFields -> Maybe Name
_fcrfFunction :: Maybe G.Name,
    FunctionCustomRootFields -> Maybe Name
_fcrfFunctionAggregate :: Maybe G.Name
  }
  deriving (Int -> FunctionCustomRootFields -> String -> String
[FunctionCustomRootFields] -> String -> String
FunctionCustomRootFields -> String
(Int -> FunctionCustomRootFields -> String -> String)
-> (FunctionCustomRootFields -> String)
-> ([FunctionCustomRootFields] -> String -> String)
-> Show FunctionCustomRootFields
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FunctionCustomRootFields -> String -> String
showsPrec :: Int -> FunctionCustomRootFields -> String -> String
$cshow :: FunctionCustomRootFields -> String
show :: FunctionCustomRootFields -> String
$cshowList :: [FunctionCustomRootFields] -> String -> String
showList :: [FunctionCustomRootFields] -> String -> String
Show, FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
(FunctionCustomRootFields -> FunctionCustomRootFields -> Bool)
-> (FunctionCustomRootFields -> FunctionCustomRootFields -> Bool)
-> Eq FunctionCustomRootFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
== :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
$c/= :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
/= :: FunctionCustomRootFields -> FunctionCustomRootFields -> Bool
Eq, (forall x.
 FunctionCustomRootFields -> Rep FunctionCustomRootFields x)
-> (forall x.
    Rep FunctionCustomRootFields x -> FunctionCustomRootFields)
-> Generic FunctionCustomRootFields
forall x.
Rep FunctionCustomRootFields x -> FunctionCustomRootFields
forall x.
FunctionCustomRootFields -> Rep FunctionCustomRootFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
FunctionCustomRootFields -> Rep FunctionCustomRootFields x
from :: forall x.
FunctionCustomRootFields -> Rep FunctionCustomRootFields x
$cto :: forall x.
Rep FunctionCustomRootFields x -> FunctionCustomRootFields
to :: forall x.
Rep FunctionCustomRootFields x -> FunctionCustomRootFields
Generic)

instance NFData FunctionCustomRootFields

instance HasCodec FunctionCustomRootFields where
  codec :: JSONCodec FunctionCustomRootFields
codec =
    (FunctionCustomRootFields
 -> Either String FunctionCustomRootFields)
-> (FunctionCustomRootFields -> FunctionCustomRootFields)
-> JSONCodec FunctionCustomRootFields
-> JSONCodec FunctionCustomRootFields
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
AC.bimapCodec FunctionCustomRootFields -> Either String FunctionCustomRootFields
checkForDup FunctionCustomRootFields -> FunctionCustomRootFields
forall a. a -> a
id
      (JSONCodec FunctionCustomRootFields
 -> JSONCodec FunctionCustomRootFields)
-> JSONCodec FunctionCustomRootFields
-> JSONCodec FunctionCustomRootFields
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec FunctionCustomRootFields FunctionCustomRootFields
-> JSONCodec FunctionCustomRootFields
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"FunctionCustomRootFields"
      (ObjectCodec FunctionCustomRootFields FunctionCustomRootFields
 -> JSONCodec FunctionCustomRootFields)
-> ObjectCodec FunctionCustomRootFields FunctionCustomRootFields
-> JSONCodec FunctionCustomRootFields
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Maybe Name -> FunctionCustomRootFields
FunctionCustomRootFields
      (Maybe Name -> Maybe Name -> FunctionCustomRootFields)
-> Codec Object FunctionCustomRootFields (Maybe Name)
-> Codec
     Object
     FunctionCustomRootFields
     (Maybe Name -> FunctionCustomRootFields)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueCodec Name Name -> ObjectCodec (Maybe Name) (Maybe Name)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
AC.optionalFieldWith' Text
"function" ValueCodec Name Name
graphQLFieldNameCodec
      ObjectCodec (Maybe Name) (Maybe Name)
-> (FunctionCustomRootFields -> Maybe Name)
-> Codec Object FunctionCustomRootFields (Maybe Name)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionCustomRootFields -> Maybe Name
_fcrfFunction
        Codec
  Object
  FunctionCustomRootFields
  (Maybe Name -> FunctionCustomRootFields)
-> Codec Object FunctionCustomRootFields (Maybe Name)
-> ObjectCodec FunctionCustomRootFields FunctionCustomRootFields
forall a b.
Codec Object FunctionCustomRootFields (a -> b)
-> Codec Object FunctionCustomRootFields a
-> Codec Object FunctionCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Name Name -> ObjectCodec (Maybe Name) (Maybe Name)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
AC.optionalFieldWith' Text
"function_aggregate" ValueCodec Name Name
graphQLFieldNameCodec
      ObjectCodec (Maybe Name) (Maybe Name)
-> (FunctionCustomRootFields -> Maybe Name)
-> Codec Object FunctionCustomRootFields (Maybe Name)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionCustomRootFields -> Maybe Name
_fcrfFunctionAggregate
    where
      checkForDup :: FunctionCustomRootFields -> Either String FunctionCustomRootFields
checkForDup (FunctionCustomRootFields (Just Name
f) (Just Name
fa))
        | Name
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
fa =
            String -> Either String FunctionCustomRootFields
forall a b. a -> Either a b
Left
              (String -> Either String FunctionCustomRootFields)
-> String -> Either String FunctionCustomRootFields
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack
              (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"the following custom root field names are duplicated: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall a. ToTxt a => a -> Text
toTxt Name
f
              Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" and "
              Text -> Text -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name -> Text
forall a. ToTxt a => a -> Text
toTxt Name
fa
      checkForDup FunctionCustomRootFields
fields = FunctionCustomRootFields -> Either String FunctionCustomRootFields
forall a b. b -> Either a b
Right FunctionCustomRootFields
fields

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

instance FromJSON FunctionCustomRootFields where
  parseJSON :: Value -> Parser FunctionCustomRootFields
parseJSON = String
-> (Object -> Parser FunctionCustomRootFields)
-> Value
-> Parser FunctionCustomRootFields
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser FunctionCustomRootFields)
 -> Value -> Parser FunctionCustomRootFields)
-> (Object -> Parser FunctionCustomRootFields)
-> Value
-> Parser FunctionCustomRootFields
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Maybe Name
function <- Object
obj Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"function"
    Maybe Name
functionAggregate <- Object
obj Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"function_aggregate"

    case (Maybe Name
function, Maybe Name
functionAggregate) of
      (Just Name
f, Just Name
fa)
        | Name
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
fa ->
            String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
              (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack
              (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"the following custom root field names are duplicated: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall a. ToTxt a => a -> Text
toTxt Name
f
              Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" and "
              Text -> Text -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name -> Text
forall a. ToTxt a => a -> Text
toTxt Name
fa
      (Maybe Name, Maybe Name)
_ ->
        () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    FunctionCustomRootFields -> Parser FunctionCustomRootFields
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionCustomRootFields -> Parser FunctionCustomRootFields)
-> FunctionCustomRootFields -> Parser FunctionCustomRootFields
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Maybe Name -> FunctionCustomRootFields
FunctionCustomRootFields Maybe Name
function Maybe Name
functionAggregate

-- | A function custom root fields without custom names set. This is the default.
emptyFunctionCustomRootFields :: FunctionCustomRootFields
emptyFunctionCustomRootFields :: FunctionCustomRootFields
emptyFunctionCustomRootFields =
  FunctionCustomRootFields
    { _fcrfFunction :: Maybe Name
_fcrfFunction = Maybe Name
forall a. Maybe a
Nothing,
      _fcrfFunctionAggregate :: Maybe Name
_fcrfFunctionAggregate = Maybe Name
forall a. Maybe a
Nothing
    }

-- | Tracked SQL function metadata. See 'buildFunctionInfo'.
data FunctionInfo (b :: BackendType) = FunctionInfo
  { forall (b :: BackendType). FunctionInfo b -> FunctionName b
_fiSQLName :: FunctionName b,
    forall (b :: BackendType). FunctionInfo b -> Name
_fiGQLName :: G.Name,
    forall (b :: BackendType). FunctionInfo b -> Name
_fiGQLArgsName :: G.Name,
    forall (b :: BackendType). FunctionInfo b -> Name
_fiGQLAggregateName :: G.Name,
    forall (b :: BackendType). FunctionInfo b -> SystemDefined
_fiSystemDefined :: SystemDefined,
    forall (b :: BackendType). FunctionInfo b -> FunctionVolatility
_fiVolatility :: FunctionVolatility,
    -- | In which part of the schema should this function be exposed?
    --
    -- See 'mkFunctionInfo' and '_fcExposedAs'.
    forall (b :: BackendType). FunctionInfo b -> FunctionExposedAs
_fiExposedAs :: FunctionExposedAs,
    forall (b :: BackendType).
FunctionInfo b -> Seq (FunctionInputArgument b)
_fiInputArgs :: Seq.Seq (FunctionInputArgument b),
    -- | NOTE: when a table is created, a new composite type of the same name is
    -- automatically created; so strictly speaking this field means "the function
    -- returns the composite type corresponding to this table".
    forall (b :: BackendType). FunctionInfo b -> TableName b
_fiReturnType :: TableName b, -- NOTE: We will extend this in future, but for now always resolves to a (TableName b)

    -- | this field represents the description of the function as present on the database
    forall (b :: BackendType). FunctionInfo b -> Maybe Text
_fiDescription :: Maybe Text,
    -- | Roles to which the function is accessible
    forall (b :: BackendType). FunctionInfo b -> FunctionPermissionsMap
_fiPermissions :: FunctionPermissionsMap,
    forall (b :: BackendType). FunctionInfo b -> JsonAggSelect
_fiJsonAggSelect :: JsonAggSelect,
    forall (b :: BackendType). FunctionInfo b -> Maybe Text
_fiComment :: Maybe Text
  }
  deriving ((forall x. FunctionInfo b -> Rep (FunctionInfo b) x)
-> (forall x. Rep (FunctionInfo b) x -> FunctionInfo b)
-> Generic (FunctionInfo b)
forall x. Rep (FunctionInfo b) x -> FunctionInfo b
forall x. FunctionInfo b -> Rep (FunctionInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (FunctionInfo b) x -> FunctionInfo b
forall (b :: BackendType) x.
FunctionInfo b -> Rep (FunctionInfo b) x
$cfrom :: forall (b :: BackendType) x.
FunctionInfo b -> Rep (FunctionInfo b) x
from :: forall x. FunctionInfo b -> Rep (FunctionInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (FunctionInfo b) x -> FunctionInfo b
to :: forall x. Rep (FunctionInfo b) x -> FunctionInfo b
Generic)

deriving instance (Backend b) => Show (FunctionInfo b)

deriving instance (Backend b) => Eq (FunctionInfo b)

instance (Backend b) => ToJSON (FunctionInfo b) where
  toJSON :: FunctionInfo b -> Value
toJSON = Options -> FunctionInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

type FunctionCache b = HashMap (FunctionName b) (FunctionInfo b) -- info of all functions

data TrackableFunctionInfo b = TrackableFunctionInfo
  { forall (b :: BackendType).
TrackableFunctionInfo b -> FunctionName b
tfiFunctionName :: FunctionName b,
    forall (b :: BackendType).
TrackableFunctionInfo b -> FunctionVolatility
tfiFunctionVolitility :: FunctionVolatility
  }
  deriving ((forall x.
 TrackableFunctionInfo b -> Rep (TrackableFunctionInfo b) x)
-> (forall x.
    Rep (TrackableFunctionInfo b) x -> TrackableFunctionInfo b)
-> Generic (TrackableFunctionInfo b)
forall x.
Rep (TrackableFunctionInfo b) x -> TrackableFunctionInfo b
forall x.
TrackableFunctionInfo b -> Rep (TrackableFunctionInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (TrackableFunctionInfo b) x -> TrackableFunctionInfo b
forall (b :: BackendType) x.
TrackableFunctionInfo b -> Rep (TrackableFunctionInfo b) x
$cfrom :: forall (b :: BackendType) x.
TrackableFunctionInfo b -> Rep (TrackableFunctionInfo b) x
from :: forall x.
TrackableFunctionInfo b -> Rep (TrackableFunctionInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (TrackableFunctionInfo b) x -> TrackableFunctionInfo b
to :: forall x.
Rep (TrackableFunctionInfo b) x -> TrackableFunctionInfo b
Generic)

deriving instance (Backend b) => Show (TrackableFunctionInfo b)

deriving instance (Backend b) => Eq (TrackableFunctionInfo b)

instance (Backend b) => ToJSON (TrackableFunctionInfo b) where
  toJSON :: TrackableFunctionInfo b -> Value
toJSON (TrackableFunctionInfo FunctionName b
name FunctionVolatility
volitility) =
    [Pair] -> Value
object
      [ Key
"name" Key -> FunctionName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson..= FunctionName b
name,
        Key
"volitility" Key -> FunctionVolatility -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson..= FunctionVolatility
volitility
      ]

newtype TrackableTableInfo b = TrackableTableInfo
  {forall (b :: BackendType). TrackableTableInfo b -> TableName b
tfTableiName :: TableName b}
  deriving ((forall x. TrackableTableInfo b -> Rep (TrackableTableInfo b) x)
-> (forall x. Rep (TrackableTableInfo b) x -> TrackableTableInfo b)
-> Generic (TrackableTableInfo b)
forall x. Rep (TrackableTableInfo b) x -> TrackableTableInfo b
forall x. TrackableTableInfo b -> Rep (TrackableTableInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (TrackableTableInfo b) x -> TrackableTableInfo b
forall (b :: BackendType) x.
TrackableTableInfo b -> Rep (TrackableTableInfo b) x
$cfrom :: forall (b :: BackendType) x.
TrackableTableInfo b -> Rep (TrackableTableInfo b) x
from :: forall x. TrackableTableInfo b -> Rep (TrackableTableInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (TrackableTableInfo b) x -> TrackableTableInfo b
to :: forall x. Rep (TrackableTableInfo b) x -> TrackableTableInfo b
Generic)

deriving instance (Backend b) => Show (TrackableTableInfo b)

deriving instance (Backend b) => Eq (TrackableTableInfo b)

instance (Backend b) => ToJSON (TrackableTableInfo b) where
  toJSON :: TrackableTableInfo b -> Value
toJSON (TrackableTableInfo TableName b
ti) = [Pair] -> Value
object [Key
"name" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson..= TableName b
ti]

data TrackableInfo b = TrackableInfo
  { forall (b :: BackendType).
TrackableInfo b -> [TrackableFunctionInfo b]
trackableFunctions :: [TrackableFunctionInfo b],
    forall (b :: BackendType).
TrackableInfo b -> [TrackableTableInfo b]
trackableTables :: [TrackableTableInfo b]
  }
  deriving ((forall x. TrackableInfo b -> Rep (TrackableInfo b) x)
-> (forall x. Rep (TrackableInfo b) x -> TrackableInfo b)
-> Generic (TrackableInfo b)
forall x. Rep (TrackableInfo b) x -> TrackableInfo b
forall x. TrackableInfo b -> Rep (TrackableInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (TrackableInfo b) x -> TrackableInfo b
forall (b :: BackendType) x.
TrackableInfo b -> Rep (TrackableInfo b) x
$cfrom :: forall (b :: BackendType) x.
TrackableInfo b -> Rep (TrackableInfo b) x
from :: forall x. TrackableInfo b -> Rep (TrackableInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (TrackableInfo b) x -> TrackableInfo b
to :: forall x. Rep (TrackableInfo b) x -> TrackableInfo b
Generic)

deriving instance (Backend b) => Show (TrackableInfo b)

deriving instance (Backend b) => Eq (TrackableInfo b)

instance (Backend b) => ToJSON (TrackableInfo b) where
  toJSON :: TrackableInfo b -> Value
toJSON (TrackableInfo [TrackableFunctionInfo b]
functions [TrackableTableInfo b]
tables) =
    [Pair] -> Value
object
      [ Key
"tables" Key -> [TrackableTableInfo b] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson..= [TrackableTableInfo b]
tables,
        Key
"functions" Key -> [TrackableFunctionInfo b] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Data.Aeson..= [TrackableFunctionInfo b]
functions
      ]

-- Metadata requests related types

-- | Tracked function configuration, and payload of the 'pg_track_function' and
-- 'pg_set_function_customization' API calls.
data FunctionConfig b = FunctionConfig
  { forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionArgName
_fcSessionArgument :: Maybe FunctionArgName,
    -- | In which top-level field should we expose this function?
    --
    -- The user might omit this, in which case we'll infer the location from the
    -- SQL functions volatility. See 'mkFunctionInfo' or the @track_function@ API
    -- docs for details of validation, etc.
    forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionExposedAs
_fcExposedAs :: Maybe FunctionExposedAs,
    forall (b :: BackendType).
FunctionConfig b -> FunctionCustomRootFields
_fcCustomRootFields :: FunctionCustomRootFields,
    forall (b :: BackendType). FunctionConfig b -> Maybe Name
_fcCustomName :: Maybe G.Name,
    forall (b :: BackendType).
FunctionConfig b -> Maybe (FunctionReturnType b)
_fcResponse :: Maybe (FunctionReturnType b)
  }
  deriving ((forall x. FunctionConfig b -> Rep (FunctionConfig b) x)
-> (forall x. Rep (FunctionConfig b) x -> FunctionConfig b)
-> Generic (FunctionConfig b)
forall x. Rep (FunctionConfig b) x -> FunctionConfig b
forall x. FunctionConfig b -> Rep (FunctionConfig b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (FunctionConfig b) x -> FunctionConfig b
forall (b :: BackendType) x.
FunctionConfig b -> Rep (FunctionConfig b) x
$cfrom :: forall (b :: BackendType) x.
FunctionConfig b -> Rep (FunctionConfig b) x
from :: forall x. FunctionConfig b -> Rep (FunctionConfig b) x
$cto :: forall (b :: BackendType) x.
Rep (FunctionConfig b) x -> FunctionConfig b
to :: forall x. Rep (FunctionConfig b) x -> FunctionConfig b
Generic)

deriving stock instance (Backend b) => Show (FunctionConfig b)

deriving stock instance (Backend b) => Eq (FunctionConfig b)

instance (Backend b) => NFData (FunctionConfig b)

instance (Backend b) => HasCodec (FunctionConfig b) where
  codec :: JSONCodec (FunctionConfig b)
codec =
    Text
-> ObjectCodec (FunctionConfig b) (FunctionConfig b)
-> JSONCodec (FunctionConfig b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"FunctionConfig"
      (ObjectCodec (FunctionConfig b) (FunctionConfig b)
 -> JSONCodec (FunctionConfig b))
-> ObjectCodec (FunctionConfig b) (FunctionConfig b)
-> JSONCodec (FunctionConfig b)
forall a b. (a -> b) -> a -> b
$ Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> Maybe (FunctionReturnType b)
-> FunctionConfig b
forall (b :: BackendType).
Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> Maybe (FunctionReturnType b)
-> FunctionConfig b
FunctionConfig
      (Maybe FunctionArgName
 -> Maybe FunctionExposedAs
 -> FunctionCustomRootFields
 -> Maybe Name
 -> Maybe (FunctionReturnType b)
 -> FunctionConfig b)
-> Codec Object (FunctionConfig b) (Maybe FunctionArgName)
-> Codec
     Object
     (FunctionConfig b)
     (Maybe FunctionExposedAs
      -> FunctionCustomRootFields
      -> Maybe Name
      -> Maybe (FunctionReturnType b)
      -> FunctionConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (Maybe FunctionArgName) (Maybe FunctionArgName)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
AC.optionalField' Text
"session_argument"
      ObjectCodec (Maybe FunctionArgName) (Maybe FunctionArgName)
-> (FunctionConfig b -> Maybe FunctionArgName)
-> Codec Object (FunctionConfig b) (Maybe FunctionArgName)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionConfig b -> Maybe FunctionArgName
forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionArgName
_fcSessionArgument
        Codec
  Object
  (FunctionConfig b)
  (Maybe FunctionExposedAs
   -> FunctionCustomRootFields
   -> Maybe Name
   -> Maybe (FunctionReturnType b)
   -> FunctionConfig b)
-> Codec Object (FunctionConfig b) (Maybe FunctionExposedAs)
-> Codec
     Object
     (FunctionConfig b)
     (FunctionCustomRootFields
      -> Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
forall a b.
Codec Object (FunctionConfig b) (a -> b)
-> Codec Object (FunctionConfig b) a
-> Codec Object (FunctionConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec (Maybe FunctionExposedAs) (Maybe FunctionExposedAs)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
AC.optionalField' Text
"exposed_as"
      ObjectCodec (Maybe FunctionExposedAs) (Maybe FunctionExposedAs)
-> (FunctionConfig b -> Maybe FunctionExposedAs)
-> Codec Object (FunctionConfig b) (Maybe FunctionExposedAs)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionConfig b -> Maybe FunctionExposedAs
forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionExposedAs
_fcExposedAs
        Codec
  Object
  (FunctionConfig b)
  (FunctionCustomRootFields
   -> Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
-> Codec Object (FunctionConfig b) FunctionCustomRootFields
-> Codec
     Object
     (FunctionConfig b)
     (Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
forall a b.
Codec Object (FunctionConfig b) (a -> b)
-> Codec Object (FunctionConfig b) a
-> Codec Object (FunctionConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> FunctionCustomRootFields
-> ObjectCodec FunctionCustomRootFields FunctionCustomRootFields
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
AC.optionalFieldWithDefault' Text
"custom_root_fields" FunctionCustomRootFields
emptyFunctionCustomRootFields
      ObjectCodec FunctionCustomRootFields FunctionCustomRootFields
-> (FunctionConfig b -> FunctionCustomRootFields)
-> Codec Object (FunctionConfig b) FunctionCustomRootFields
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionConfig b -> FunctionCustomRootFields
forall (b :: BackendType).
FunctionConfig b -> FunctionCustomRootFields
_fcCustomRootFields
        Codec
  Object
  (FunctionConfig b)
  (Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
-> Codec Object (FunctionConfig b) (Maybe Name)
-> Codec
     Object
     (FunctionConfig b)
     (Maybe (FunctionReturnType b) -> FunctionConfig b)
forall a b.
Codec Object (FunctionConfig b) (a -> b)
-> Codec Object (FunctionConfig b) a
-> Codec Object (FunctionConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Name Name -> ObjectCodec (Maybe Name) (Maybe Name)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
AC.optionalFieldWith' Text
"custom_name" ValueCodec Name Name
graphQLFieldNameCodec
      ObjectCodec (Maybe Name) (Maybe Name)
-> (FunctionConfig b -> Maybe Name)
-> Codec Object (FunctionConfig b) (Maybe Name)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionConfig b -> Maybe Name
forall (b :: BackendType). FunctionConfig b -> Maybe Name
_fcCustomName
        Codec
  Object
  (FunctionConfig b)
  (Maybe (FunctionReturnType b) -> FunctionConfig b)
-> Codec Object (FunctionConfig b) (Maybe (FunctionReturnType b))
-> ObjectCodec (FunctionConfig b) (FunctionConfig b)
forall a b.
Codec Object (FunctionConfig b) (a -> b)
-> Codec Object (FunctionConfig b) a
-> Codec Object (FunctionConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec (FunctionReturnType b) (FunctionReturnType b)
-> ObjectCodec
     (Maybe (FunctionReturnType b)) (Maybe (FunctionReturnType b))
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
AC.optionalFieldWith' Text
"response" ValueCodec (FunctionReturnType b) (FunctionReturnType b)
forall value. HasCodec value => JSONCodec value
codec
      ObjectCodec
  (Maybe (FunctionReturnType b)) (Maybe (FunctionReturnType b))
-> (FunctionConfig b -> Maybe (FunctionReturnType b))
-> Codec Object (FunctionConfig b) (Maybe (FunctionReturnType b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= FunctionConfig b -> Maybe (FunctionReturnType b)
forall (b :: BackendType).
FunctionConfig b -> Maybe (FunctionReturnType b)
_fcResponse

instance (Backend b) => FromJSON (FunctionConfig b) where
  parseJSON :: Value -> Parser (FunctionConfig b)
parseJSON = String
-> (Object -> Parser (FunctionConfig b))
-> Value
-> Parser (FunctionConfig b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FunctionConfig" ((Object -> Parser (FunctionConfig b))
 -> Value -> Parser (FunctionConfig b))
-> (Object -> Parser (FunctionConfig b))
-> Value
-> Parser (FunctionConfig b)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> Maybe (FunctionReturnType b)
-> FunctionConfig b
forall (b :: BackendType).
Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> Maybe (FunctionReturnType b)
-> FunctionConfig b
FunctionConfig
      (Maybe FunctionArgName
 -> Maybe FunctionExposedAs
 -> FunctionCustomRootFields
 -> Maybe Name
 -> Maybe (FunctionReturnType b)
 -> FunctionConfig b)
-> Parser (Maybe FunctionArgName)
-> Parser
     (Maybe FunctionExposedAs
      -> FunctionCustomRootFields
      -> Maybe Name
      -> Maybe (FunctionReturnType b)
      -> FunctionConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj
      Object -> Key -> Parser (Maybe FunctionArgName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"session_argument"
      Parser
  (Maybe FunctionExposedAs
   -> FunctionCustomRootFields
   -> Maybe Name
   -> Maybe (FunctionReturnType b)
   -> FunctionConfig b)
-> Parser (Maybe FunctionExposedAs)
-> Parser
     (FunctionCustomRootFields
      -> Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
      Object -> Key -> Parser (Maybe FunctionExposedAs)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exposed_as"
      Parser
  (FunctionCustomRootFields
   -> Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
-> Parser FunctionCustomRootFields
-> Parser
     (Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
      Object -> Key -> Parser (Maybe FunctionCustomRootFields)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_root_fields"
      Parser (Maybe FunctionCustomRootFields)
-> FunctionCustomRootFields -> Parser FunctionCustomRootFields
forall a. Parser (Maybe a) -> a -> Parser a
.!= FunctionCustomRootFields
emptyFunctionCustomRootFields
      Parser
  (Maybe Name -> Maybe (FunctionReturnType b) -> FunctionConfig b)
-> Parser (Maybe Name)
-> Parser (Maybe (FunctionReturnType b) -> FunctionConfig b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
      Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_name"
      Parser (Maybe (FunctionReturnType b) -> FunctionConfig b)
-> Parser (Maybe (FunctionReturnType b))
-> Parser (FunctionConfig b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
      Object -> Key -> Parser (Maybe (FunctionReturnType b))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"response"

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

-- | The default function config; v1 of the API implies this.
emptyFunctionConfig :: FunctionConfig b
emptyFunctionConfig :: forall (b :: BackendType). FunctionConfig b
emptyFunctionConfig = Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> Maybe (FunctionReturnType b)
-> FunctionConfig b
forall (b :: BackendType).
Maybe FunctionArgName
-> Maybe FunctionExposedAs
-> FunctionCustomRootFields
-> Maybe Name
-> Maybe (FunctionReturnType b)
-> FunctionConfig b
FunctionConfig Maybe FunctionArgName
forall a. Maybe a
Nothing Maybe FunctionExposedAs
forall a. Maybe a
Nothing FunctionCustomRootFields
emptyFunctionCustomRootFields Maybe Name
forall a. Maybe a
Nothing Maybe (FunctionReturnType b)
forall a. Maybe a
Nothing

type DBFunctionsMetadata b = HashMap (FunctionName b) (FunctionOverloads b)

newtype FunctionOverloads b = FunctionOverloads {forall (b :: BackendType).
FunctionOverloads b -> NonEmpty (RawFunctionInfo b)
getFunctionOverloads :: NonEmpty (RawFunctionInfo b)}

deriving newtype instance (Backend b) => Eq (FunctionOverloads b)

deriving newtype instance (Backend b) => Show (FunctionOverloads b)

deriving newtype instance (FromJSON (RawFunctionInfo b)) => FromJSON (FunctionOverloads b)

deriving newtype instance (ToJSON (RawFunctionInfo b)) => ToJSON (FunctionOverloads b)

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

instance (Hashable a) => Hashable (FunctionArgsExpG a)

instance (NFData a) => NFData (FunctionArgsExpG a)

type FunctionArgsExp b v = FunctionArgsExpG (FunctionArgumentExp b v)

emptyFunctionArgsExp :: FunctionArgsExpG a
emptyFunctionArgsExp :: forall a. FunctionArgsExpG a
emptyFunctionArgsExp = [a] -> HashMap Text a -> FunctionArgsExpG a
forall a. [a] -> HashMap Text a -> FunctionArgsExpG a
FunctionArgsExp [] HashMap Text a
forall k v. HashMap k v
HashMap.empty