-- | Postgres DDL Function
--
-- This module describes building information about Postgres functions by
-- validating the passed raw information.
--
-- See 'Hasura.RQL.Types.Metadata.Backend'.
module Hasura.Backends.Postgres.DDL.Function
  ( buildFunctionInfo,
    mkFunctionArgs,
  )
where

import Control.Lens hiding (from, index, op, (.=))
import Control.Monad.Validate qualified as MV
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types hiding (FunctionName)
import Hasura.Backends.Postgres.Types.Function
import Hasura.Base.Error
import Hasura.Function.Cache
import Hasura.Function.Common (getFunctionAggregateGQLName, getFunctionArgsGQLName, getFunctionGQLName)
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.NamingCase
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.SourceCustomization (applyFieldNameCaseCust)
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Utils
import Language.GraphQL.Draft.Syntax qualified as G

mkFunctionArgs :: Int -> [QualifiedPGType] -> [FunctionArgName] -> [FunctionArg]
mkFunctionArgs :: Int -> [QualifiedPGType] -> [FunctionArgName] -> [FunctionArg]
mkFunctionArgs Int
defArgsNo [QualifiedPGType]
tys [FunctionArgName]
argNames =
  [FunctionArg] -> [FunctionArg] -> Bool -> [FunctionArg]
forall a. a -> a -> Bool -> a
bool [FunctionArg]
withNames [FunctionArg]
withNoNames (Bool -> [FunctionArg]) -> Bool -> [FunctionArg]
forall a b. (a -> b) -> a -> b
$ [FunctionArgName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunctionArgName]
argNames
  where
    hasDefaultBoolSeq :: [HasDefault]
hasDefaultBoolSeq =
      Int -> HasDefault -> [HasDefault]
forall a. Int -> a -> [a]
replicate ([QualifiedPGType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [QualifiedPGType]
tys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
defArgsNo) (Bool -> HasDefault
HasDefault Bool
False)
        -- only last arguments can have default expression
        [HasDefault] -> [HasDefault] -> [HasDefault]
forall a. Semigroup a => a -> a -> a
<> Int -> HasDefault -> [HasDefault]
forall a. Int -> a -> [a]
replicate Int
defArgsNo (Bool -> HasDefault
HasDefault Bool
True)

    tysWithHasDefault :: [(QualifiedPGType, HasDefault)]
tysWithHasDefault = [QualifiedPGType]
-> [HasDefault] -> [(QualifiedPGType, HasDefault)]
forall a b. [a] -> [b] -> [(a, b)]
zip [QualifiedPGType]
tys [HasDefault]
hasDefaultBoolSeq

    withNoNames :: [FunctionArg]
withNoNames = (((QualifiedPGType, HasDefault) -> FunctionArg)
 -> [(QualifiedPGType, HasDefault)] -> [FunctionArg])
-> [(QualifiedPGType, HasDefault)]
-> ((QualifiedPGType, HasDefault) -> FunctionArg)
-> [FunctionArg]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((QualifiedPGType, HasDefault) -> FunctionArg)
-> [(QualifiedPGType, HasDefault)] -> [FunctionArg]
forall a b. (a -> b) -> [a] -> [b]
map [(QualifiedPGType, HasDefault)]
tysWithHasDefault (((QualifiedPGType, HasDefault) -> FunctionArg) -> [FunctionArg])
-> ((QualifiedPGType, HasDefault) -> FunctionArg) -> [FunctionArg]
forall a b. (a -> b) -> a -> b
$ (QualifiedPGType -> HasDefault -> FunctionArg)
-> (QualifiedPGType, HasDefault) -> FunctionArg
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((QualifiedPGType -> HasDefault -> FunctionArg)
 -> (QualifiedPGType, HasDefault) -> FunctionArg)
-> (QualifiedPGType -> HasDefault -> FunctionArg)
-> (QualifiedPGType, HasDefault)
-> FunctionArg
forall a b. (a -> b) -> a -> b
$ Maybe FunctionArgName
-> QualifiedPGType -> HasDefault -> FunctionArg
FunctionArg Maybe FunctionArgName
forall a. Maybe a
Nothing
    withNames :: [FunctionArg]
withNames = (FunctionArgName -> (QualifiedPGType, HasDefault) -> FunctionArg)
-> [FunctionArgName]
-> [(QualifiedPGType, HasDefault)]
-> [FunctionArg]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FunctionArgName -> (QualifiedPGType, HasDefault) -> FunctionArg
mkArg [FunctionArgName]
argNames [(QualifiedPGType, HasDefault)]
tysWithHasDefault

    mkArg :: FunctionArgName -> (QualifiedPGType, HasDefault) -> FunctionArg
mkArg FunctionArgName
"" (QualifiedPGType
ty, HasDefault
hasDef) = Maybe FunctionArgName
-> QualifiedPGType -> HasDefault -> FunctionArg
FunctionArg Maybe FunctionArgName
forall a. Maybe a
Nothing QualifiedPGType
ty HasDefault
hasDef
    mkArg FunctionArgName
n (QualifiedPGType
ty, HasDefault
hasDef) = Maybe FunctionArgName
-> QualifiedPGType -> HasDefault -> FunctionArg
FunctionArg (FunctionArgName -> Maybe FunctionArgName
forall a. a -> Maybe a
Just FunctionArgName
n) QualifiedPGType
ty HasDefault
hasDef

data FunctionIntegrityError
  = FunctionNameNotGQLCompliant
  | FunctionVariadic
  | FunctionReturnNotCompositeType
  | FunctionReturnNotTable
  | NonVolatileFunctionAsMutation
  | FunctionSessionArgumentNotJSON FunctionArgName
  | FunctionInvalidSessionArgument FunctionArgName
  | FunctionInvalidArgumentNames [FunctionArgName]
  deriving (Int -> FunctionIntegrityError -> ShowS
[FunctionIntegrityError] -> ShowS
FunctionIntegrityError -> String
(Int -> FunctionIntegrityError -> ShowS)
-> (FunctionIntegrityError -> String)
-> ([FunctionIntegrityError] -> ShowS)
-> Show FunctionIntegrityError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionIntegrityError -> ShowS
showsPrec :: Int -> FunctionIntegrityError -> ShowS
$cshow :: FunctionIntegrityError -> String
show :: FunctionIntegrityError -> String
$cshowList :: [FunctionIntegrityError] -> ShowS
showList :: [FunctionIntegrityError] -> ShowS
Show, FunctionIntegrityError -> FunctionIntegrityError -> Bool
(FunctionIntegrityError -> FunctionIntegrityError -> Bool)
-> (FunctionIntegrityError -> FunctionIntegrityError -> Bool)
-> Eq FunctionIntegrityError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunctionIntegrityError -> FunctionIntegrityError -> Bool
== :: FunctionIntegrityError -> FunctionIntegrityError -> Bool
$c/= :: FunctionIntegrityError -> FunctionIntegrityError -> Bool
/= :: FunctionIntegrityError -> FunctionIntegrityError -> Bool
Eq)

buildFunctionInfo ::
  forall pgKind m.
  (Backend ('Postgres pgKind), QErrM m) =>
  SourceName ->
  QualifiedFunction ->
  SystemDefined ->
  FunctionConfig ('Postgres pgKind) ->
  FunctionPermissionsMap ->
  RawFunctionInfo ('Postgres pgKind) ->
  Maybe Text ->
  NamingCase ->
  m (FunctionInfo ('Postgres pgKind), SchemaDependency)
buildFunctionInfo :: forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), QErrM m) =>
SourceName
-> QualifiedFunction
-> SystemDefined
-> FunctionConfig ('Postgres pgKind)
-> FunctionPermissionsMap
-> RawFunctionInfo ('Postgres pgKind)
-> Maybe Text
-> NamingCase
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
buildFunctionInfo SourceName
source QualifiedFunction
qf SystemDefined
systemDefined fc :: FunctionConfig ('Postgres pgKind)
fc@FunctionConfig {Maybe Name
Maybe (FunctionReturnType ('Postgres pgKind))
Maybe FunctionExposedAs
Maybe FunctionArgName
FunctionCustomRootFields
_fcSessionArgument :: Maybe FunctionArgName
_fcExposedAs :: Maybe FunctionExposedAs
_fcCustomRootFields :: FunctionCustomRootFields
_fcCustomName :: Maybe Name
_fcResponse :: Maybe (FunctionReturnType ('Postgres pgKind))
_fcSessionArgument :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionArgName
_fcExposedAs :: forall (b :: BackendType).
FunctionConfig b -> Maybe FunctionExposedAs
_fcCustomRootFields :: forall (b :: BackendType).
FunctionConfig b -> FunctionCustomRootFields
_fcCustomName :: forall (b :: BackendType). FunctionConfig b -> Maybe Name
_fcResponse :: forall (b :: BackendType).
FunctionConfig b -> Maybe (FunctionReturnType b)
..} FunctionPermissionsMap
permissions RawFunctionInfo ('Postgres pgKind)
rawFuncInfo Maybe Text
comment NamingCase
tCase =
  ([FunctionIntegrityError]
 -> m (FunctionInfo ('Postgres pgKind), SchemaDependency))
-> ((FunctionInfo ('Postgres pgKind), SchemaDependency)
    -> m (FunctionInfo ('Postgres pgKind), SchemaDependency))
-> Either
     [FunctionIntegrityError]
     (FunctionInfo ('Postgres pgKind), SchemaDependency)
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Code
-> Text -> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m (FunctionInfo ('Postgres pgKind), SchemaDependency))
-> ([FunctionIntegrityError] -> Text)
-> [FunctionIntegrityError]
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FunctionIntegrityError] -> Text
showErrors) (FunctionInfo ('Postgres pgKind), SchemaDependency)
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either
   [FunctionIntegrityError]
   (FunctionInfo ('Postgres pgKind), SchemaDependency)
 -> m (FunctionInfo ('Postgres pgKind), SchemaDependency))
-> m (Either
        [FunctionIntegrityError]
        (FunctionInfo ('Postgres pgKind), SchemaDependency))
-> m (FunctionInfo ('Postgres pgKind), SchemaDependency)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ValidateT
  [FunctionIntegrityError]
  m
  (FunctionInfo ('Postgres pgKind), SchemaDependency)
-> m (Either
        [FunctionIntegrityError]
        (FunctionInfo ('Postgres pgKind), SchemaDependency))
forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
MV.runValidateT ValidateT
  [FunctionIntegrityError]
  m
  (FunctionInfo ('Postgres pgKind), SchemaDependency)
validateFunction
  where
    functionArgs :: [FunctionArg]
functionArgs = Int -> [QualifiedPGType] -> [FunctionArgName] -> [FunctionArg]
mkFunctionArgs Int
defArgsNo [QualifiedPGType]
inpArgTyps [FunctionArgName]
inpArgNames
    PGRawFunctionInfo
      OID
_
      Bool
hasVariadic
      FunctionVolatility
funVol
      SchemaName
retSn
      PGScalarType
retN
      PGTypeKind
retTyTyp
      Bool
retSet
      [QualifiedPGType]
inpArgTyps
      [FunctionArgName]
inpArgNames
      Int
defArgsNo
      Bool
returnsTab
      Maybe PGDescription
descM =
        RawFunctionInfo ('Postgres pgKind)
rawFuncInfo
    returnType :: QualifiedPGType
returnType = SchemaName -> PGScalarType -> PGTypeKind -> QualifiedPGType
QualifiedPGType SchemaName
retSn PGScalarType
retN PGTypeKind
retTyTyp

    throwValidateError :: FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError = [FunctionIntegrityError] -> ValidateT [FunctionIntegrityError] m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute ([FunctionIntegrityError]
 -> ValidateT [FunctionIntegrityError] m ())
-> (FunctionIntegrityError -> [FunctionIntegrityError])
-> FunctionIntegrityError
-> ValidateT [FunctionIntegrityError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionIntegrityError -> [FunctionIntegrityError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    validateFunction :: ValidateT
  [FunctionIntegrityError]
  m
  (FunctionInfo ('Postgres pgKind), SchemaDependency)
validateFunction = do
      Bool
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Getting Any (Either QErr Name) Name -> Either QErr Name -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any (Either QErr Name) Name
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right (Either QErr Name -> Bool) -> Either QErr Name -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedFunction -> Either QErr Name
forall a (m :: * -> *).
(ToTxt a, MonadError QErr m) =>
QualifiedObject a -> m Name
qualifiedObjectToName QualifiedFunction
qf)
        (ValidateT [FunctionIntegrityError] m ()
 -> ValidateT [FunctionIntegrityError] m ())
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError FunctionIntegrityError
FunctionNameNotGQLCompliant
      Bool
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasVariadic (ValidateT [FunctionIntegrityError] m ()
 -> ValidateT [FunctionIntegrityError] m ())
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError FunctionIntegrityError
FunctionVariadic
      Bool
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PGTypeKind
retTyTyp PGTypeKind -> PGTypeKind -> Bool
forall a. Eq a => a -> a -> Bool
/= PGTypeKind
PGKindComposite) (ValidateT [FunctionIntegrityError] m ()
 -> ValidateT [FunctionIntegrityError] m ())
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError FunctionIntegrityError
FunctionReturnNotCompositeType
      Bool
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
returnsTab (ValidateT [FunctionIntegrityError] m ()
 -> ValidateT [FunctionIntegrityError] m ())
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError FunctionIntegrityError
FunctionReturnNotTable
      -- We mostly take the user at their word here and will, e.g. expose a
      -- function as a query if it is marked VOLATILE (since perhaps the user
      -- is using the function to do some logging, say). But this is also a
      -- footgun we'll need to try to document (since `VOLATILE` is default
      -- when volatility is omitted). See the original approach here:
      -- https://github.com/hasura/graphql-engine/pull/5858
      --
      -- This is the one exception where we do some validation. We're not
      -- commited to this check, and it would be backwards compatible to remove
      -- it, but this seemed like an obvious case:
      Bool
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunctionVolatility
funVol FunctionVolatility -> FunctionVolatility -> Bool
forall a. Eq a => a -> a -> Bool
/= FunctionVolatility
FTVOLATILE Bool -> Bool -> Bool
&& Maybe FunctionExposedAs
_fcExposedAs Maybe FunctionExposedAs -> Maybe FunctionExposedAs -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionExposedAs -> Maybe FunctionExposedAs
forall a. a -> Maybe a
Just FunctionExposedAs
FEAMutation)
        (ValidateT [FunctionIntegrityError] m ()
 -> ValidateT [FunctionIntegrityError] m ())
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError FunctionIntegrityError
NonVolatileFunctionAsMutation
      -- If 'exposed_as' is omitted we'll infer it from the volatility:
      let exposeAs :: FunctionExposedAs
exposeAs = (FunctionExposedAs -> Maybe FunctionExposedAs -> FunctionExposedAs)
-> Maybe FunctionExposedAs
-> FunctionExposedAs
-> FunctionExposedAs
forall a b c. (a -> b -> c) -> b -> a -> c
flip FunctionExposedAs -> Maybe FunctionExposedAs -> FunctionExposedAs
forall a. a -> Maybe a -> a
fromMaybe Maybe FunctionExposedAs
_fcExposedAs (FunctionExposedAs -> FunctionExposedAs)
-> FunctionExposedAs -> FunctionExposedAs
forall a b. (a -> b) -> a -> b
$ case FunctionVolatility
funVol of
            FunctionVolatility
FTVOLATILE -> FunctionExposedAs
FEAMutation
            FunctionVolatility
_ -> FunctionExposedAs
FEAQuery

      -- validate function argument names
      ValidateT [FunctionIntegrityError] m ()
validateFunctionArgNames

      Seq (InputArgument FunctionArg)
inputArguments <- ValidateT
  [FunctionIntegrityError] m (Seq (InputArgument FunctionArg))
makeInputArguments

      Name
funcGivenName <- forall (b :: BackendType).
Backend b =>
FunctionName b -> Either QErr Name
functionGraphQLName @('Postgres pgKind) FunctionName ('Postgres pgKind)
QualifiedFunction
qf Either QErr Name
-> (QErr -> ValidateT [FunctionIntegrityError] m Name)
-> ValidateT [FunctionIntegrityError] m Name
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` QErr -> ValidateT [FunctionIntegrityError] m Name
forall a. QErr -> ValidateT [FunctionIntegrityError] m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

      let retTable :: QualifiedTable
retTable = QualifiedPGType -> QualifiedTable
typeToTable QualifiedPGType
returnType
          retJsonAggSelect :: JsonAggSelect
retJsonAggSelect = JsonAggSelect -> JsonAggSelect -> Bool -> JsonAggSelect
forall a. a -> a -> Bool -> a
bool JsonAggSelect
JASSingleObject JsonAggSelect
JASMultipleRows Bool
retSet
          setNamingCase :: Name -> Name
setNamingCase = NamingCase -> Name -> Name
applyFieldNameCaseCust NamingCase
tCase

          functionInfo :: FunctionInfo ('Postgres pgKind)
functionInfo =
            FunctionName ('Postgres pgKind)
-> Name
-> Name
-> Name
-> SystemDefined
-> FunctionVolatility
-> FunctionExposedAs
-> Seq (FunctionInputArgument ('Postgres pgKind))
-> TableName ('Postgres pgKind)
-> Maybe Text
-> FunctionPermissionsMap
-> JsonAggSelect
-> Maybe Text
-> FunctionInfo ('Postgres pgKind)
forall (b :: BackendType).
FunctionName b
-> Name
-> Name
-> Name
-> SystemDefined
-> FunctionVolatility
-> FunctionExposedAs
-> Seq (FunctionInputArgument b)
-> TableName b
-> Maybe Text
-> FunctionPermissionsMap
-> JsonAggSelect
-> Maybe Text
-> FunctionInfo b
FunctionInfo
              FunctionName ('Postgres pgKind)
QualifiedFunction
qf
              (Name -> FunctionConfig ('Postgres pgKind) -> (Name -> Name) -> Name
forall (b :: BackendType).
Name -> FunctionConfig b -> (Name -> Name) -> Name
getFunctionGQLName Name
funcGivenName FunctionConfig ('Postgres pgKind)
fc Name -> Name
setNamingCase)
              (Name -> FunctionConfig ('Postgres pgKind) -> (Name -> Name) -> Name
forall (b :: BackendType).
Name -> FunctionConfig b -> (Name -> Name) -> Name
getFunctionArgsGQLName Name
funcGivenName FunctionConfig ('Postgres pgKind)
fc Name -> Name
setNamingCase)
              (Name -> FunctionConfig ('Postgres pgKind) -> (Name -> Name) -> Name
forall (b :: BackendType).
Name -> FunctionConfig b -> (Name -> Name) -> Name
getFunctionAggregateGQLName Name
funcGivenName FunctionConfig ('Postgres pgKind)
fc Name -> Name
setNamingCase)
              SystemDefined
systemDefined
              FunctionVolatility
funVol
              FunctionExposedAs
exposeAs
              Seq (FunctionInputArgument ('Postgres pgKind))
Seq (InputArgument FunctionArg)
inputArguments
              TableName ('Postgres pgKind)
QualifiedTable
retTable
              (PGDescription -> Text
getPGDescription (PGDescription -> Text) -> Maybe PGDescription -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PGDescription
descM)
              FunctionPermissionsMap
permissions
              JsonAggSelect
retJsonAggSelect
              Maybe Text
comment

      (FunctionInfo ('Postgres pgKind), SchemaDependency)
-> ValidateT
     [FunctionIntegrityError]
     m
     (FunctionInfo ('Postgres pgKind), SchemaDependency)
forall a. a -> ValidateT [FunctionIntegrityError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( FunctionInfo ('Postgres pgKind)
functionInfo,
          SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
            ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId ('Postgres pgKind) -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                (SourceObjId ('Postgres pgKind) -> AnyBackend SourceObjId)
-> SourceObjId ('Postgres pgKind) -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @('Postgres pgKind) TableName ('Postgres pgKind)
QualifiedTable
retTable
            )
            DependencyReason
DRTable
        )

    validateFunctionArgNames :: ValidateT [FunctionIntegrityError] m ()
validateFunctionArgNames = do
      let argNames :: [FunctionArgName]
argNames = (FunctionArg -> Maybe FunctionArgName)
-> [FunctionArg] -> [FunctionArgName]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe FunctionArg -> Maybe FunctionArgName
faName [FunctionArg]
functionArgs
          invalidArgs :: [FunctionArgName]
invalidArgs = (FunctionArgName -> Bool) -> [FunctionArgName] -> [FunctionArgName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Name -> Bool)
-> (FunctionArgName -> Maybe Name) -> FunctionArgName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Name
G.mkName (Text -> Maybe Name)
-> (FunctionArgName -> Text) -> FunctionArgName -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionArgName -> Text
getFuncArgNameTxt) [FunctionArgName]
argNames
      Bool
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FunctionArgName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunctionArgName]
invalidArgs)
        (ValidateT [FunctionIntegrityError] m ()
 -> ValidateT [FunctionIntegrityError] m ())
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError
        (FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ())
-> FunctionIntegrityError
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ [FunctionArgName] -> FunctionIntegrityError
FunctionInvalidArgumentNames [FunctionArgName]
invalidArgs

    makeInputArguments :: ValidateT
  [FunctionIntegrityError] m (Seq (InputArgument FunctionArg))
makeInputArguments =
      case Maybe FunctionArgName
_fcSessionArgument of
        Maybe FunctionArgName
Nothing -> Seq (InputArgument FunctionArg)
-> ValidateT
     [FunctionIntegrityError] m (Seq (InputArgument FunctionArg))
forall a. a -> ValidateT [FunctionIntegrityError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (InputArgument FunctionArg)
 -> ValidateT
      [FunctionIntegrityError] m (Seq (InputArgument FunctionArg)))
-> Seq (InputArgument FunctionArg)
-> ValidateT
     [FunctionIntegrityError] m (Seq (InputArgument FunctionArg))
forall a b. (a -> b) -> a -> b
$ [InputArgument FunctionArg] -> Seq (InputArgument FunctionArg)
forall a. [a] -> Seq a
Seq.fromList ([InputArgument FunctionArg] -> Seq (InputArgument FunctionArg))
-> [InputArgument FunctionArg] -> Seq (InputArgument FunctionArg)
forall a b. (a -> b) -> a -> b
$ (FunctionArg -> InputArgument FunctionArg)
-> [FunctionArg] -> [InputArgument FunctionArg]
forall a b. (a -> b) -> [a] -> [b]
map FunctionArg -> InputArgument FunctionArg
forall a. a -> InputArgument a
IAUserProvided [FunctionArg]
functionArgs
        Just FunctionArgName
sessionArgName -> do
          Bool
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((FunctionArg -> Bool) -> [FunctionArg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\FunctionArg
arg -> FunctionArgName -> Maybe FunctionArgName
forall a. a -> Maybe a
Just FunctionArgName
sessionArgName Maybe FunctionArgName -> Maybe FunctionArgName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionArg -> Maybe FunctionArgName
faName FunctionArg
arg) [FunctionArg]
functionArgs)
            (ValidateT [FunctionIntegrityError] m ()
 -> ValidateT [FunctionIntegrityError] m ())
-> ValidateT [FunctionIntegrityError] m ()
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ()
throwValidateError
            (FunctionIntegrityError -> ValidateT [FunctionIntegrityError] m ())
-> FunctionIntegrityError
-> ValidateT [FunctionIntegrityError] m ()
forall a b. (a -> b) -> a -> b
$ FunctionArgName -> FunctionIntegrityError
FunctionInvalidSessionArgument FunctionArgName
sessionArgName
          ([InputArgument FunctionArg] -> Seq (InputArgument FunctionArg))
-> ValidateT [FunctionIntegrityError] m [InputArgument FunctionArg]
-> ValidateT
     [FunctionIntegrityError] m (Seq (InputArgument FunctionArg))
forall a b.
(a -> b)
-> ValidateT [FunctionIntegrityError] m a
-> ValidateT [FunctionIntegrityError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [InputArgument FunctionArg] -> Seq (InputArgument FunctionArg)
forall a. [a] -> Seq a
Seq.fromList
            (ValidateT [FunctionIntegrityError] m [InputArgument FunctionArg]
 -> ValidateT
      [FunctionIntegrityError] m (Seq (InputArgument FunctionArg)))
-> ValidateT [FunctionIntegrityError] m [InputArgument FunctionArg]
-> ValidateT
     [FunctionIntegrityError] m (Seq (InputArgument FunctionArg))
forall a b. (a -> b) -> a -> b
$ [FunctionArg]
-> (FunctionArg
    -> ValidateT
         [FunctionIntegrityError] m (InputArgument FunctionArg))
-> ValidateT [FunctionIntegrityError] m [InputArgument FunctionArg]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FunctionArg]
functionArgs
            ((FunctionArg
  -> ValidateT
       [FunctionIntegrityError] m (InputArgument FunctionArg))
 -> ValidateT
      [FunctionIntegrityError] m [InputArgument FunctionArg])
-> (FunctionArg
    -> ValidateT
         [FunctionIntegrityError] m (InputArgument FunctionArg))
-> ValidateT [FunctionIntegrityError] m [InputArgument FunctionArg]
forall a b. (a -> b) -> a -> b
$ \FunctionArg
arg ->
              if FunctionArgName -> Maybe FunctionArgName
forall a. a -> Maybe a
Just FunctionArgName
sessionArgName Maybe FunctionArgName -> Maybe FunctionArgName -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionArg -> Maybe FunctionArgName
faName FunctionArg
arg
                then do
                  let argTy :: PGScalarType
argTy = QualifiedPGType -> PGScalarType
_qptName (QualifiedPGType -> PGScalarType)
-> QualifiedPGType -> PGScalarType
forall a b. (a -> b) -> a -> b
$ FunctionArg -> QualifiedPGType
faType FunctionArg
arg
                  if PGScalarType
argTy PGScalarType -> PGScalarType -> Bool
forall a. Eq a => a -> a -> Bool
== PGScalarType
PGJSON
                    then InputArgument FunctionArg
-> ValidateT [FunctionIntegrityError] m (InputArgument FunctionArg)
forall a. a -> ValidateT [FunctionIntegrityError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputArgument FunctionArg
 -> ValidateT
      [FunctionIntegrityError] m (InputArgument FunctionArg))
-> InputArgument FunctionArg
-> ValidateT [FunctionIntegrityError] m (InputArgument FunctionArg)
forall a b. (a -> b) -> a -> b
$ FunctionArgName -> InputArgument FunctionArg
forall a. FunctionArgName -> InputArgument a
IASessionVariables FunctionArgName
sessionArgName
                    else [FunctionIntegrityError]
-> ValidateT [FunctionIntegrityError] m (InputArgument FunctionArg)
forall a.
[FunctionIntegrityError] -> ValidateT [FunctionIntegrityError] m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
MV.refute ([FunctionIntegrityError]
 -> ValidateT
      [FunctionIntegrityError] m (InputArgument FunctionArg))
-> [FunctionIntegrityError]
-> ValidateT [FunctionIntegrityError] m (InputArgument FunctionArg)
forall a b. (a -> b) -> a -> b
$ FunctionIntegrityError -> [FunctionIntegrityError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunctionIntegrityError -> [FunctionIntegrityError])
-> FunctionIntegrityError -> [FunctionIntegrityError]
forall a b. (a -> b) -> a -> b
$ FunctionArgName -> FunctionIntegrityError
FunctionSessionArgumentNotJSON FunctionArgName
sessionArgName
                else InputArgument FunctionArg
-> ValidateT [FunctionIntegrityError] m (InputArgument FunctionArg)
forall a. a -> ValidateT [FunctionIntegrityError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputArgument FunctionArg
 -> ValidateT
      [FunctionIntegrityError] m (InputArgument FunctionArg))
-> InputArgument FunctionArg
-> ValidateT [FunctionIntegrityError] m (InputArgument FunctionArg)
forall a b. (a -> b) -> a -> b
$ FunctionArg -> InputArgument FunctionArg
forall a. a -> InputArgument a
IAUserProvided FunctionArg
arg

    showErrors :: [FunctionIntegrityError] -> Text
showErrors [FunctionIntegrityError]
allErrors =
      Text
"the function "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedFunction
qf
        QualifiedFunction -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" cannot be tracked "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FunctionIntegrityError]
-> (FunctionIntegrityError -> Text) -> Text
forall a. [a] -> (a -> Text) -> Text
makeReasonMessage [FunctionIntegrityError]
allErrors FunctionIntegrityError -> Text
showOneError

    showOneError :: FunctionIntegrityError -> Text
showOneError = \case
      FunctionIntegrityError
FunctionNameNotGQLCompliant -> Text
"function name is not a legal GraphQL identifier"
      FunctionIntegrityError
FunctionVariadic -> Text
"function with \"VARIADIC\" parameters are not supported"
      FunctionIntegrityError
FunctionReturnNotCompositeType -> Text
"the function does not return a \"COMPOSITE\" type"
      FunctionIntegrityError
FunctionReturnNotTable -> Text
"the function does not return a table"
      FunctionIntegrityError
NonVolatileFunctionAsMutation ->
        Text
"the function was requested to be exposed as a mutation, but is not marked VOLATILE. "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Maybe the function was given the wrong volatility when it was defined?"
      FunctionSessionArgumentNotJSON FunctionArgName
argName ->
        Text
"given session argument " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionArgName
argName FunctionArgName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not of type json"
      FunctionInvalidSessionArgument FunctionArgName
argName ->
        Text
"given session argument " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionArgName
argName FunctionArgName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not the input argument of the function"
      FunctionInvalidArgumentNames [FunctionArgName]
args ->
        let argsText :: Text
argsText = Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FunctionArgName -> Text) -> [FunctionArgName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FunctionArgName -> Text
getFuncArgNameTxt [FunctionArgName]
args
         in Text
"the function arguments " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argsText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are not in compliance with GraphQL spec"