graphql-engine/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs
Auke Booij 86aef93d31 server: remove a few unused Lift instances (#114)
GitOrigin-RevId: b5679e9579d226f7209b73ac966d29391c308c06
2020-11-26 13:58:07 +00:00

256 lines
10 KiB
Haskell

{- |
Description: Create/delete SQL functions to/from Hasura metadata.
-}
module Hasura.RQL.DDL.Schema.Function where
import Hasura.Prelude
import qualified Control.Monad.Validate as MV
import qualified Data.HashMap.Strict as M
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Text.Extended
import qualified Language.GraphQL.Draft.Syntax as G
import Hasura.Backends.Postgres.SQL.Types
import Hasura.EncJSON
import Hasura.RQL.Types
import Hasura.Server.Utils (englishList, makeReasonMessage)
mkFunctionArgs :: Int -> [QualifiedPGType] -> [FunctionArgName] -> [FunctionArg]
mkFunctionArgs defArgsNo tys argNames =
bool withNames withNoNames $ null argNames
where
hasDefaultBoolSeq = replicate (length tys - defArgsNo) (HasDefault False)
-- only last arguments can have default expression
<> replicate defArgsNo (HasDefault True)
tysWithHasDefault = zip tys hasDefaultBoolSeq
withNoNames = flip map tysWithHasDefault $ uncurry $ FunctionArg Nothing
withNames = zipWith mkArg argNames tysWithHasDefault
mkArg "" (ty, hasDef) = FunctionArg Nothing ty hasDef
mkArg n (ty, hasDef) = FunctionArg (Just n) ty hasDef
validateFuncArgs :: MonadError QErr m => [FunctionArg] -> m ()
validateFuncArgs args =
for_ (nonEmpty invalidArgs) \someInvalidArgs ->
throw400 NotSupported $
"arguments: " <> englishList "and" someInvalidArgs
<> " are not in compliance with GraphQL spec"
where
funcArgsText = mapMaybe (fmap getFuncArgNameTxt . faName) args
invalidArgs = filter (isNothing . G.mkName) funcArgsText
data FunctionIntegrityError
= FunctionNameNotGQLCompliant
| FunctionVariadic
| FunctionReturnNotCompositeType
| FunctionReturnNotSetof
| FunctionReturnNotSetofTable
| NonVolatileFunctionAsMutation
| FunctionSessionArgumentNotJSON !FunctionArgName
| FunctionInvalidSessionArgument !FunctionArgName
| FunctionInvalidArgumentNames [FunctionArgName]
deriving (Show, Eq)
mkFunctionInfo
:: (QErrM m)
=> QualifiedFunction
-> SystemDefined
-> FunctionConfig
-> RawFunctionInfo
-> m (FunctionInfo, SchemaDependency)
mkFunctionInfo qf systemDefined FunctionConfig{..} rawFuncInfo =
either (throw400 NotSupported . showErrors) pure
=<< MV.runValidateT validateFunction
where
functionArgs = mkFunctionArgs defArgsNo inpArgTyps inpArgNames
RawFunctionInfo hasVariadic funVol retSn retN retTyTyp retSet
inpArgTyps inpArgNames defArgsNo returnsTab descM
= rawFuncInfo
returnType = QualifiedPGType retSn retN retTyTyp
throwValidateError = MV.dispute . pure
validateFunction = do
unless (has _Right $ qualifiedObjectToName qf) $
throwValidateError FunctionNameNotGQLCompliant
when hasVariadic $ throwValidateError FunctionVariadic
when (retTyTyp /= PGKindComposite) $ throwValidateError FunctionReturnNotCompositeType
unless retSet $ throwValidateError FunctionReturnNotSetof
unless returnsTab $ throwValidateError FunctionReturnNotSetofTable
-- 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:
when (funVol /= FTVOLATILE && _fcExposedAs == Just FEAMutation) $
throwValidateError $ NonVolatileFunctionAsMutation
-- If 'exposed_as' is omitted we'll infer it from the volatility:
let exposeAs = flip fromMaybe _fcExposedAs $ case funVol of
FTVOLATILE -> FEAMutation
_ -> FEAQuery
-- validate function argument names
validateFunctionArgNames
inputArguments <- makeInputArguments
let retTable = typeToTable returnType
pure ( FunctionInfo qf systemDefined funVol exposeAs inputArguments retTable descM
, SchemaDependency (SOTable retTable) DRTable
)
validateFunctionArgNames = do
let argNames = mapMaybe faName functionArgs
invalidArgs = filter (isNothing . G.mkName . getFuncArgNameTxt) argNames
unless (null invalidArgs) $
throwValidateError $ FunctionInvalidArgumentNames invalidArgs
makeInputArguments =
case _fcSessionArgument of
Nothing -> pure $ Seq.fromList $ map IAUserProvided functionArgs
Just sessionArgName -> do
unless (any (\arg -> Just sessionArgName == faName arg) functionArgs) $
throwValidateError $ FunctionInvalidSessionArgument sessionArgName
fmap Seq.fromList $ forM functionArgs $ \arg ->
if Just sessionArgName == faName arg then do
let argTy = _qptName $ faType arg
if argTy == PGJSON then pure $ IASessionVariables sessionArgName
else MV.refute $ pure $ FunctionSessionArgumentNotJSON sessionArgName
else pure $ IAUserProvided arg
showErrors allErrors =
"the function " <> qf <<> " cannot be tracked "
<> makeReasonMessage allErrors showOneError
showOneError = \case
FunctionNameNotGQLCompliant -> "function name is not a legal GraphQL identifier"
FunctionVariadic -> "function with \"VARIADIC\" parameters are not supported"
FunctionReturnNotCompositeType -> "the function does not return a \"COMPOSITE\" type"
FunctionReturnNotSetof -> "the function does not return a SETOF"
FunctionReturnNotSetofTable -> "the function does not return a SETOF table"
NonVolatileFunctionAsMutation ->
"the function was requested to be exposed as a mutation, but is not marked VOLATILE. " <>
"Maybe the function was given the wrong volatility when it was defined?"
FunctionSessionArgumentNotJSON argName ->
"given session argument " <> argName <<> " is not of type json"
FunctionInvalidSessionArgument argName ->
"given session argument " <> argName <<> " not the input argument of the function"
FunctionInvalidArgumentNames args ->
let argsText = T.intercalate "," $ map getFuncArgNameTxt args
in "the function arguments " <> argsText <> " are not in compliance with GraphQL spec"
saveFunctionToCatalog
:: (MonadTx m, HasSystemDefined m)
=> QualifiedFunction -> FunctionConfig -> m ()
saveFunctionToCatalog (QualifiedObject sn fn) config = do
systemDefined <- askSystemDefined
liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
INSERT INTO "hdb_catalog"."hdb_function"
(function_schema, function_name, configuration, is_system_defined)
VALUES ($1, $2, $3, $4)
|] (sn, fn, Q.AltJ config, systemDefined) False
delFunctionFromCatalog :: QualifiedFunction -> Q.TxE QErr ()
delFunctionFromCatalog (QualifiedObject sn fn) =
Q.unitQE defaultTxErrorHandler [Q.sql|
DELETE FROM hdb_catalog.hdb_function
WHERE function_schema = $1
AND function_name = $2
|] (sn, fn) False
newtype TrackFunction
= TrackFunction
{ tfName :: QualifiedFunction}
deriving (Show, Eq, FromJSON, ToJSON)
-- | Track function, Phase 1:
-- Validate function tracking operation. Fails if function is already being
-- tracked, or if a table with the same name is being tracked.
trackFunctionP1
:: (CacheRM m, QErrM m) => QualifiedFunction -> m ()
trackFunctionP1 qf = do
rawSchemaCache <- askSchemaCache
when (M.member qf $ scFunctions rawSchemaCache) $
throw400 AlreadyTracked $ "function already tracked : " <>> qf
let qt = fmap (TableName . getFunctionTxt) qf
when (M.member qt $ scTables rawSchemaCache) $
throw400 NotSupported $ "table with name " <> qf <<> " already exists"
trackFunctionP2 :: (MonadTx m, CacheRWM m, HasSystemDefined m)
=> QualifiedFunction -> FunctionConfig -> m EncJSON
trackFunctionP2 qf config = do
saveFunctionToCatalog qf config
buildSchemaCacheFor $ MOFunction qf
return successMsg
handleMultipleFunctions :: (QErrM m) => QualifiedFunction -> [a] -> m a
handleMultipleFunctions qf = \case
[] ->
throw400 NotExists $ "no such function exists in postgres : " <>> qf
[fi] -> return fi
_ ->
throw400 NotSupported $
"function " <> qf <<> " is overloaded. Overloaded functions are not supported"
fetchRawFunctionInfo :: MonadTx m => QualifiedFunction -> m RawFunctionInfo
fetchRawFunctionInfo qf@(QualifiedObject sn fn) =
handleMultipleFunctions qf =<< map (Q.getAltJ . runIdentity) <$> fetchFromDatabase
where
fetchFromDatabase = liftTx $
Q.listQE defaultTxErrorHandler [Q.sql|
SELECT function_info
FROM hdb_catalog.hdb_function_info_agg
WHERE function_schema = $1
AND function_name = $2
|] (sn, fn) True
runTrackFunc
:: (MonadTx m, CacheRWM m, HasSystemDefined m)
=> TrackFunction -> m EncJSON
runTrackFunc (TrackFunction qf)= do
trackFunctionP1 qf
trackFunctionP2 qf emptyFunctionConfig
runTrackFunctionV2
:: ( QErrM m, CacheRWM m, HasSystemDefined m
, MonadTx m
)
=> TrackFunctionV2 -> m EncJSON
runTrackFunctionV2 (TrackFunctionV2 qf config) = do
trackFunctionP1 qf
trackFunctionP2 qf config
-- | JSON API payload for 'untrack_function':
--
-- https://hasura.io/docs/1.0/graphql/core/api-reference/schema-metadata-api/custom-functions.html#untrack-function
newtype UnTrackFunction
= UnTrackFunction
{ utfName :: QualifiedFunction }
deriving (Show, Eq, FromJSON, ToJSON)
runUntrackFunc
:: (QErrM m, CacheRWM m, MonadTx m)
=> UnTrackFunction -> m EncJSON
runUntrackFunc (UnTrackFunction qf) = do
void $ askFunctionInfo qf
liftTx $ delFunctionFromCatalog qf
withNewInconsistentObjsCheck buildSchemaCache
return successMsg