mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
c7d4117964
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8976 GitOrigin-RevId: bbb54468f04e1df1d595691ccb21a9d28a4eb010
369 lines
16 KiB
Haskell
369 lines
16 KiB
Haskell
-- | This module contains Data Connector request/response planning code and utility
|
|
-- functions and types that are common across the different categories of requests
|
|
-- (ie queries, mutations, etc). It contains code and concepts that are independent
|
|
-- of these different categories.
|
|
--
|
|
-- Both 'Hasura.Backends.DataConnector.Plan.QueryPlan' and
|
|
-- 'Hasura.Backends.DataConnector.Plan.MutationPlan' use the contents of this module,
|
|
-- for example 'Hasura.Backends.DataConnector.Plan.QueryPlan.mkQueryPlan`.
|
|
module Hasura.Backends.DataConnector.Plan.Common
|
|
( Plan (..),
|
|
TableRelationships (..),
|
|
FieldPrefix,
|
|
noPrefix,
|
|
prefixWith,
|
|
applyPrefix,
|
|
Cardinality (..),
|
|
recordTableRelationship,
|
|
recordTableRelationshipFromRelInfo,
|
|
prepareLiteral,
|
|
translateBoolExpToExpression,
|
|
mkRelationshipName,
|
|
mapFieldNameHashMap,
|
|
encodeAssocListAsObject,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.Trans.Writer.CPS qualified as CPS
|
|
import Data.Aeson qualified as J
|
|
import Data.Aeson.Encoding qualified as JE
|
|
import Data.Aeson.Types qualified as J
|
|
import Data.Bifunctor (Bifunctor (bimap))
|
|
import Data.ByteString qualified as BS
|
|
import Data.Has (Has (modifier))
|
|
import Data.HashMap.Strict qualified as HashMap
|
|
import Data.Text qualified as T
|
|
import Data.Text.Encoding qualified as TE
|
|
import Data.Text.Extended (toTxt, (<<>), (<>>))
|
|
import Hasura.Backends.DataConnector.API qualified as API
|
|
import Hasura.Backends.DataConnector.Adapter.Backend
|
|
import Hasura.Backends.DataConnector.Adapter.Types
|
|
import Hasura.Base.Error
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR.BoolExp
|
|
import Hasura.RQL.IR.Value
|
|
import Hasura.RQL.Types.Backend (SessionVarType)
|
|
import Hasura.RQL.Types.BackendType
|
|
import Hasura.RQL.Types.Column
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.Relationships.Local (RelInfo (..))
|
|
import Hasura.SQL.Types (CollectableType (..))
|
|
import Hasura.Session
|
|
import Witch qualified
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Represents a 'request' to be sent to a data connector agent ('_pRequest') and a function
|
|
-- that is capable of reshaping the response to that request into the final JSON form expected
|
|
-- to be returned by the GraphQL endpoint ('_pResponseReshaper').
|
|
data Plan request response = Plan
|
|
{ _pRequest :: request,
|
|
_pResponseReshaper :: forall m. (MonadError QErr m) => response -> m J.Encoding
|
|
}
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | A monoidal data structure used to record Table Relationships encountered during request
|
|
-- translation. Used with 'recordTableRelationship'.
|
|
newtype TableRelationships = TableRelationships
|
|
{unTableRelationships :: HashMap API.TableName (HashMap API.RelationshipName API.Relationship)}
|
|
deriving stock (Eq, Show)
|
|
|
|
instance Semigroup TableRelationships where
|
|
(TableRelationships l) <> (TableRelationships r) = TableRelationships $ HashMap.unionWith HashMap.union l r
|
|
|
|
instance Monoid TableRelationships where
|
|
mempty = TableRelationships mempty
|
|
|
|
-- | Records a table relationship encountered during request translation into the output of the current
|
|
-- 'CPS.WriterT'
|
|
recordTableRelationship ::
|
|
( Has TableRelationships writerOutput,
|
|
Monoid writerOutput,
|
|
MonadError QErr m
|
|
) =>
|
|
API.TableName ->
|
|
API.RelationshipName ->
|
|
API.Relationship ->
|
|
CPS.WriterT writerOutput m ()
|
|
recordTableRelationship sourceTableName relationshipName relationship =
|
|
let newRelationship = TableRelationships $ HashMap.singleton sourceTableName (HashMap.singleton relationshipName relationship)
|
|
in CPS.tell $ modifier (const newRelationship) mempty
|
|
|
|
recordTableRelationshipFromRelInfo ::
|
|
( Has TableRelationships writerOutput,
|
|
Monoid writerOutput,
|
|
MonadError QErr m
|
|
) =>
|
|
API.TableName ->
|
|
RelInfo 'DataConnector ->
|
|
CPS.WriterT writerOutput m (API.RelationshipName, API.Relationship)
|
|
recordTableRelationshipFromRelInfo sourceTableName RelInfo {..} = do
|
|
let relationshipName = mkRelationshipName riName
|
|
let relationshipType = case riType of
|
|
ObjRel -> API.ObjectRelationship
|
|
ArrRel -> API.ArrayRelationship
|
|
let relationship =
|
|
API.Relationship
|
|
{ _rTargetTable = Witch.from riRTable,
|
|
_rRelationshipType = relationshipType,
|
|
_rColumnMapping = HashMap.fromList $ bimap Witch.from Witch.from <$> HashMap.toList riMapping
|
|
}
|
|
recordTableRelationship
|
|
sourceTableName
|
|
relationshipName
|
|
relationship
|
|
pure (relationshipName, relationship)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Represents a potential prefix that can be applied to a field name, useful for
|
|
-- namespacing field names that may be otherwise duplicated.
|
|
newtype FieldPrefix = FieldPrefix (Maybe FieldName)
|
|
deriving stock (Show, Eq)
|
|
|
|
instance Semigroup FieldPrefix where
|
|
(FieldPrefix Nothing) <> (FieldPrefix something) = FieldPrefix something
|
|
(FieldPrefix something) <> (FieldPrefix Nothing) = FieldPrefix something
|
|
(FieldPrefix (Just l)) <> (FieldPrefix (Just r)) = FieldPrefix . Just $ l <> "_" <> r
|
|
|
|
instance Monoid FieldPrefix where
|
|
mempty = FieldPrefix Nothing
|
|
|
|
noPrefix :: FieldPrefix
|
|
noPrefix = FieldPrefix Nothing
|
|
|
|
prefixWith :: FieldName -> FieldPrefix
|
|
prefixWith = FieldPrefix . Just
|
|
|
|
applyPrefix :: FieldPrefix -> FieldName -> FieldName
|
|
applyPrefix (FieldPrefix fieldNamePrefix) fieldName = maybe fieldName (\prefix -> prefix <> "_" <> fieldName) fieldNamePrefix
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
data Cardinality
|
|
= Single
|
|
| Many
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
prepareLiteral ::
|
|
MonadError QErr m =>
|
|
SessionVariables ->
|
|
UnpreparedValue 'DataConnector ->
|
|
m Literal
|
|
prepareLiteral sessionVariables = \case
|
|
UVLiteral literal -> pure $ literal
|
|
UVParameter _ e -> pure (ValueLiteral (columnTypeToScalarType $ cvType e) (cvValue e))
|
|
UVSession -> throw400 NotSupported "prepareLiteral: UVSession"
|
|
UVSessionVar sessionVarType sessionVar -> do
|
|
textValue <-
|
|
getSessionVariableValue sessionVar sessionVariables
|
|
`onNothing` throw400 NotSupported ("prepareLiteral: session var not found: " <>> sessionVar)
|
|
parseSessionVariable sessionVar sessionVarType textValue
|
|
|
|
parseSessionVariable ::
|
|
forall m.
|
|
MonadError QErr m =>
|
|
SessionVariable ->
|
|
SessionVarType 'DataConnector ->
|
|
Text ->
|
|
m Literal
|
|
parseSessionVariable varName varType varValue = do
|
|
case varType of
|
|
CollectableTypeScalar scalarType@(ScalarType customTypeName _) ->
|
|
parseCustomValue scalarType (customTypeName <> " JSON value")
|
|
CollectableTypeArray scalarType@(ScalarType customTypeName _) ->
|
|
parseCustomArray scalarType ("JSON array of " <> customTypeName <> " JSON values")
|
|
where
|
|
parseCustomValue :: ScalarType -> Text -> m Literal
|
|
parseCustomValue scalarType description =
|
|
case scalarType of
|
|
ScalarType _ (Just GraphQLString) ->
|
|
-- Special case for string: uses literal session variable value rather than trying to parse a JSON string
|
|
pure . ValueLiteral scalarType $ J.String varValue
|
|
_ ->
|
|
parseValue' (parseValue scalarType) (ValueLiteral scalarType) description
|
|
|
|
parseCustomArray :: ScalarType -> Text -> m Literal
|
|
parseCustomArray scalarType =
|
|
parseValue' parser (ArrayLiteral scalarType)
|
|
where
|
|
parser :: (J.Value -> J.Parser [J.Value])
|
|
parser = J.withArray "array of JSON values" (fmap toList . traverse (parseValue scalarType))
|
|
|
|
parseValue' :: (J.Value -> J.Parser a) -> (a -> Literal) -> Text -> m Literal
|
|
parseValue' parser toLiteral description =
|
|
toLiteral
|
|
<$> (J.eitherDecodeStrict' valValueBS >>= J.parseEither parser)
|
|
`onLeft` (\err -> throw400 ParseFailed ("Expected " <> description <> " for session variable " <> varName <<> ". " <> T.pack err))
|
|
|
|
valValueBS :: BS.ByteString
|
|
valValueBS = TE.encodeUtf8 varValue
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
translateBoolExpToExpression ::
|
|
( Has TableRelationships writerOutput,
|
|
Monoid writerOutput,
|
|
MonadError QErr m
|
|
) =>
|
|
SessionVariables ->
|
|
API.TableName ->
|
|
AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector) ->
|
|
CPS.WriterT writerOutput m (Maybe API.Expression)
|
|
translateBoolExpToExpression sessionVariables sourceTableName boolExp = do
|
|
removeAlwaysTrueExpression <$> translateBoolExp sessionVariables sourceTableName boolExp
|
|
|
|
translateBoolExp ::
|
|
( Has TableRelationships writerOutput,
|
|
Monoid writerOutput,
|
|
MonadError QErr m
|
|
) =>
|
|
SessionVariables ->
|
|
API.TableName ->
|
|
AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector) ->
|
|
CPS.WriterT writerOutput m API.Expression
|
|
translateBoolExp sessionVariables sourceTableName = \case
|
|
BoolAnd xs ->
|
|
mkIfZeroOrMany API.And . mapMaybe removeAlwaysTrueExpression <$> traverse (translateBoolExp' sourceTableName) xs
|
|
BoolOr xs ->
|
|
mkIfZeroOrMany API.Or . mapMaybe removeAlwaysFalseExpression <$> traverse (translateBoolExp' sourceTableName) xs
|
|
BoolNot x ->
|
|
API.Not <$> (translateBoolExp' sourceTableName) x
|
|
BoolField (AVColumn c xs) ->
|
|
lift $ mkIfZeroOrMany API.And <$> traverse (translateOp sessionVariables (Witch.from $ ciColumn c) (Witch.from . columnTypeToScalarType $ ciType c)) xs
|
|
BoolField (AVRelationship relationshipInfo (RelationshipFilters {rfTargetTablePermissions, rfFilter})) -> do
|
|
(relationshipName, API.Relationship {..}) <- recordTableRelationshipFromRelInfo sourceTableName relationshipInfo
|
|
-- TODO: How does this function keep track of the root table?
|
|
API.Exists (API.RelatedTable relationshipName) <$> translateBoolExp' _rTargetTable (BoolAnd [rfTargetTablePermissions, rfFilter])
|
|
BoolExists GExists {..} ->
|
|
let tableName = Witch.from _geTable
|
|
in API.Exists (API.UnrelatedTable tableName) <$> translateBoolExp' tableName _geWhere
|
|
where
|
|
translateBoolExp' = translateBoolExp sessionVariables
|
|
|
|
-- Makes an 'API.Expression' like 'API.And' if there is zero or many input expressions otherwise
|
|
-- just returns the singleton expression. This helps remove redundant 'API.And' etcs from the expression.
|
|
mkIfZeroOrMany :: ([API.Expression] -> API.Expression) -> [API.Expression] -> API.Expression
|
|
mkIfZeroOrMany mk = \case
|
|
[singleExp] -> singleExp
|
|
zeroOrManyExps -> mk zeroOrManyExps
|
|
|
|
removeAlwaysTrueExpression :: API.Expression -> Maybe API.Expression
|
|
removeAlwaysTrueExpression = \case
|
|
API.And [] -> Nothing
|
|
API.Not (API.Or []) -> Nothing
|
|
other -> Just other
|
|
|
|
removeAlwaysFalseExpression :: API.Expression -> Maybe API.Expression
|
|
removeAlwaysFalseExpression = \case
|
|
API.Or [] -> Nothing
|
|
API.Not (API.And []) -> Nothing
|
|
other -> Just other
|
|
|
|
translateOp ::
|
|
MonadError QErr m =>
|
|
SessionVariables ->
|
|
API.ColumnName ->
|
|
API.ScalarType ->
|
|
OpExpG 'DataConnector (UnpreparedValue 'DataConnector) ->
|
|
m API.Expression
|
|
translateOp sessionVariables columnName columnType opExp = do
|
|
preparedOpExp <- traverse (prepareLiteral sessionVariables) $ opExp
|
|
case preparedOpExp of
|
|
AEQ _ (ValueLiteral scalarType value) ->
|
|
pure $ mkApplyBinaryComparisonOperatorToScalar API.Equal value scalarType
|
|
AEQ _ (ArrayLiteral _scalarType _array) ->
|
|
throw400 NotSupported "Array literals not supported for AEQ operator"
|
|
ANE _ (ValueLiteral scalarType value) ->
|
|
pure . API.Not $ mkApplyBinaryComparisonOperatorToScalar API.Equal value scalarType
|
|
ANE _ (ArrayLiteral _scalarType _array) ->
|
|
throw400 NotSupported "Array literals not supported for ANE operator"
|
|
AGT (ValueLiteral scalarType value) ->
|
|
pure $ mkApplyBinaryComparisonOperatorToScalar API.GreaterThan value scalarType
|
|
AGT (ArrayLiteral _scalarType _array) ->
|
|
throw400 NotSupported "Array literals not supported for AGT operator"
|
|
ALT (ValueLiteral scalarType value) ->
|
|
pure $ mkApplyBinaryComparisonOperatorToScalar API.LessThan value scalarType
|
|
ALT (ArrayLiteral _scalarType _array) ->
|
|
throw400 NotSupported "Array literals not supported for ALT operator"
|
|
AGTE (ValueLiteral scalarType value) ->
|
|
pure $ mkApplyBinaryComparisonOperatorToScalar API.GreaterThanOrEqual value scalarType
|
|
AGTE (ArrayLiteral _scalarType _array) ->
|
|
throw400 NotSupported "Array literals not supported for AGTE operator"
|
|
ALTE (ValueLiteral scalarType value) ->
|
|
pure $ mkApplyBinaryComparisonOperatorToScalar API.LessThanOrEqual value scalarType
|
|
ALTE (ArrayLiteral _scalarType _array) ->
|
|
throw400 NotSupported "Array literals not supported for ALTE operator"
|
|
ANISNULL ->
|
|
pure $ API.ApplyUnaryComparisonOperator API.IsNull currentComparisonColumn
|
|
ANISNOTNULL ->
|
|
pure $ API.Not (API.ApplyUnaryComparisonOperator API.IsNull currentComparisonColumn)
|
|
AIN literal -> pure $ inOperator literal
|
|
ANIN literal -> pure . API.Not $ inOperator literal
|
|
CEQ rootOrCurrentColumn ->
|
|
pure $ mkApplyBinaryComparisonOperatorToAnotherColumn API.Equal rootOrCurrentColumn
|
|
CNE rootOrCurrentColumn ->
|
|
pure $ API.Not $ mkApplyBinaryComparisonOperatorToAnotherColumn API.Equal rootOrCurrentColumn
|
|
CGT rootOrCurrentColumn ->
|
|
pure $ mkApplyBinaryComparisonOperatorToAnotherColumn API.GreaterThan rootOrCurrentColumn
|
|
CLT rootOrCurrentColumn ->
|
|
pure $ mkApplyBinaryComparisonOperatorToAnotherColumn API.LessThan rootOrCurrentColumn
|
|
CGTE rootOrCurrentColumn ->
|
|
pure $ mkApplyBinaryComparisonOperatorToAnotherColumn API.GreaterThanOrEqual rootOrCurrentColumn
|
|
CLTE rootOrCurrentColumn ->
|
|
pure $ mkApplyBinaryComparisonOperatorToAnotherColumn API.LessThanOrEqual rootOrCurrentColumn
|
|
ALIKE _literal ->
|
|
throw400 NotSupported "The ALIKE operator is not supported by the Data Connector backend"
|
|
ANLIKE _literal ->
|
|
throw400 NotSupported "The ANLIKE operator is not supported by the Data Connector backend"
|
|
ACast _literal ->
|
|
throw400 NotSupported "The ACast operator is not supported by the Data Connector backend"
|
|
ABackendSpecific CustomBooleanOperator {..} -> case _cboRHS of
|
|
Nothing -> pure $ API.ApplyUnaryComparisonOperator (API.CustomUnaryComparisonOperator _cboName) currentComparisonColumn
|
|
Just (Left rootOrCurrentColumn) ->
|
|
pure $ mkApplyBinaryComparisonOperatorToAnotherColumn (API.CustomBinaryComparisonOperator _cboName) rootOrCurrentColumn
|
|
Just (Right (ValueLiteral scalarType value)) ->
|
|
pure $ mkApplyBinaryComparisonOperatorToScalar (API.CustomBinaryComparisonOperator _cboName) value scalarType
|
|
Just (Right (ArrayLiteral scalarType array)) ->
|
|
pure $ API.ApplyBinaryArrayComparisonOperator (API.CustomBinaryArrayComparisonOperator _cboName) currentComparisonColumn array (Witch.from scalarType)
|
|
where
|
|
currentComparisonColumn :: API.ComparisonColumn
|
|
currentComparisonColumn = API.ComparisonColumn API.CurrentTable columnName columnType
|
|
|
|
mkApplyBinaryComparisonOperatorToAnotherColumn :: API.BinaryComparisonOperator -> RootOrCurrentColumn 'DataConnector -> API.Expression
|
|
mkApplyBinaryComparisonOperatorToAnotherColumn operator (RootOrCurrentColumn rootOrCurrent otherColumnName) =
|
|
let columnPath = case rootOrCurrent of
|
|
IsRoot -> API.QueryTable
|
|
IsCurrent -> API.CurrentTable
|
|
in API.ApplyBinaryComparisonOperator operator currentComparisonColumn (API.AnotherColumnComparison $ API.ComparisonColumn columnPath (Witch.from otherColumnName) columnType)
|
|
|
|
inOperator :: Literal -> API.Expression
|
|
inOperator literal =
|
|
let (values, scalarType) = case literal of
|
|
ArrayLiteral scalarType' array -> (array, scalarType')
|
|
ValueLiteral scalarType' value -> ([value], scalarType')
|
|
in API.ApplyBinaryArrayComparisonOperator API.In currentComparisonColumn values (Witch.from scalarType)
|
|
|
|
mkApplyBinaryComparisonOperatorToScalar :: API.BinaryComparisonOperator -> J.Value -> ScalarType -> API.Expression
|
|
mkApplyBinaryComparisonOperatorToScalar operator value scalarType =
|
|
API.ApplyBinaryComparisonOperator operator currentComparisonColumn (API.ScalarValueComparison $ API.ScalarValue value (Witch.from scalarType))
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
mkRelationshipName :: RelName -> API.RelationshipName
|
|
mkRelationshipName relName = API.RelationshipName $ toTxt relName
|
|
|
|
mapFieldNameHashMap :: HashMap FieldName v -> HashMap API.FieldName v
|
|
mapFieldNameHashMap = HashMap.mapKeys (API.FieldName . getFieldNameTxt)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
encodeAssocListAsObject :: [(Text, J.Encoding)] -> J.Encoding
|
|
encodeAssocListAsObject =
|
|
JE.dict
|
|
JE.text
|
|
id
|
|
(\fn -> foldr (uncurry fn))
|