mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-24 07:52:14 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
396 lines
17 KiB
Haskell
396 lines
17 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Hasura.RQL.DDL.RemoteRelationship
|
|
( CreateFromSourceRelationship (..),
|
|
runCreateRemoteRelationship,
|
|
runDeleteRemoteRelationship,
|
|
runUpdateRemoteRelationship,
|
|
DeleteFromSourceRelationship (..),
|
|
dropRemoteRelationshipInMetadata,
|
|
PartiallyResolvedSource (..),
|
|
buildRemoteFieldInfo,
|
|
CreateRemoteSchemaRemoteRelationship (..),
|
|
runCreateRemoteSchemaRemoteRelationship,
|
|
runUpdateRemoteSchemaRemoteRelationship,
|
|
DeleteRemoteSchemaRemoteRelationship (..),
|
|
runDeleteRemoteSchemaRemoteRelationship,
|
|
getRemoteSchemaEntityJoinColumns,
|
|
)
|
|
where
|
|
|
|
import Control.Lens (at, non, to, (^?))
|
|
import Data.Aeson (FromJSON (..), ToJSON (..), (.!=), (.:), (.:?), (.=))
|
|
import Data.Aeson qualified as J
|
|
import Data.Aeson.KeyMap qualified as KM
|
|
import Data.Aeson.TH qualified as J
|
|
import Data.HashMap.Strict qualified as Map
|
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
|
import Data.Text.Extended ((<<>), (<>>))
|
|
import Hasura.Base.Error
|
|
( Code (NotExists, NotFound, NotSupported, RemoteSchemaError),
|
|
QErr,
|
|
QErrM,
|
|
runAesonParser,
|
|
throw400,
|
|
)
|
|
import Hasura.EncJSON (EncJSON)
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.Backend
|
|
import Hasura.RQL.Types.Column
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.Metadata
|
|
import Hasura.RQL.Types.Metadata.Backend
|
|
import Hasura.RQL.Types.Metadata.Object
|
|
import Hasura.RQL.Types.Relationships.Remote
|
|
import Hasura.RQL.Types.Relationships.ToSource
|
|
import Hasura.RQL.Types.SchemaCache
|
|
import Hasura.RQL.Types.SchemaCache.Build
|
|
import Hasura.RQL.Types.SchemaCacheTypes
|
|
import Hasura.RQL.Types.Source
|
|
import Hasura.RQL.Types.Table
|
|
import Hasura.RemoteSchema.Metadata
|
|
import Hasura.RemoteSchema.SchemaCache
|
|
import Hasura.SQL.AnyBackend qualified as AB
|
|
import Hasura.SQL.Backend
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Create or update relationship from source
|
|
|
|
-- | Argument to the @_create_remote_relationship@ and
|
|
-- @_update_remote_relationship@ families of metadata commands.
|
|
--
|
|
-- For historical reason, this type is also used to represent a db-to-rs schema
|
|
-- in the metadata.
|
|
data CreateFromSourceRelationship (b :: BackendType) = CreateFromSourceRelationship
|
|
{ _crrSource :: SourceName,
|
|
_crrTable :: TableName b,
|
|
_crrName :: RelName,
|
|
_crrDefinition :: RemoteRelationshipDefinition
|
|
}
|
|
|
|
deriving stock instance (Eq (TableName b)) => Eq (CreateFromSourceRelationship b)
|
|
|
|
deriving stock instance (Show (TableName b)) => Show (CreateFromSourceRelationship b)
|
|
|
|
instance Backend b => FromJSON (CreateFromSourceRelationship b) where
|
|
parseJSON = J.withObject "CreateFromSourceRelationship" $ \o -> do
|
|
_crrSource <- o .:? "source" .!= defaultSource
|
|
_crrTable <- o .: "table"
|
|
_crrName <- o .: "name"
|
|
-- In the old format, the definition is inlined; in the new format, the
|
|
-- definition is in the "definition" object, and we don't allow legacy
|
|
-- fields to appear under it.
|
|
remoteSchema :: Maybe J.Value <- o .:? "remote_schema"
|
|
definition <- o .:? "definition"
|
|
_crrDefinition <- case (remoteSchema, definition) of
|
|
-- old format
|
|
(Just {}, Nothing) -> parseRemoteRelationshipDefinition RRPLegacy $ J.Object o
|
|
-- new format
|
|
(Nothing, Just def) -> parseRemoteRelationshipDefinition RRPStrict def
|
|
-- both or neither
|
|
_ -> fail "create_remote_relationship expects exactly one of: remote_schema, definition"
|
|
pure $ CreateFromSourceRelationship {..}
|
|
|
|
instance (Backend b) => ToJSON (CreateFromSourceRelationship b) where
|
|
toJSON CreateFromSourceRelationship {..} =
|
|
-- We need to introspect the definition, to know whether we need to inline
|
|
-- it, or if it needs to be in a distinct "definition" object.
|
|
J.object $ case _crrDefinition of
|
|
-- old format
|
|
RelationshipToSchema RRFOldDBToRemoteSchema _ ->
|
|
case J.toJSON _crrDefinition of
|
|
-- The result of this serialization will be an empty list if this
|
|
-- conversion fails (which it should _never_ do), in which case those
|
|
-- fields will be omitted from the serialized JSON. This could only
|
|
-- happen if the ToJSON instance of RemoteRelationshipDefinition were
|
|
-- changed to return something that isn't an object.
|
|
J.Object obj -> commonFields <> KM.toList obj
|
|
_ -> []
|
|
-- new format
|
|
_ -> ("definition" .= _crrDefinition) : commonFields
|
|
where
|
|
commonFields =
|
|
[ "source" .= _crrSource,
|
|
"table" .= _crrTable,
|
|
"name" .= _crrName
|
|
]
|
|
|
|
runCreateRemoteRelationship ::
|
|
forall b m.
|
|
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
|
|
CreateFromSourceRelationship b ->
|
|
m EncJSON
|
|
runCreateRemoteRelationship CreateFromSourceRelationship {..} = do
|
|
void $ askTableInfo @b _crrSource _crrTable
|
|
let metadataObj =
|
|
MOSourceObjId _crrSource $
|
|
AB.mkAnyBackend $
|
|
SMOTableObj @b _crrTable $
|
|
MTORemoteRelationship _crrName
|
|
buildSchemaCacheFor metadataObj $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b _crrSource _crrTable . tmRemoteRelationships
|
|
%~ OMap.insert _crrName (RemoteRelationship _crrName _crrDefinition)
|
|
pure successMsg
|
|
|
|
runUpdateRemoteRelationship ::
|
|
forall b m.
|
|
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
|
|
CreateFromSourceRelationship b ->
|
|
m EncJSON
|
|
runUpdateRemoteRelationship CreateFromSourceRelationship {..} = do
|
|
fieldInfoMap <- askTableFieldInfoMap @b _crrSource _crrTable
|
|
let metadataObj =
|
|
MOSourceObjId _crrSource $
|
|
AB.mkAnyBackend $
|
|
SMOTableObj @b _crrTable $
|
|
MTORemoteRelationship _crrName
|
|
void $ askRemoteRel fieldInfoMap _crrName
|
|
buildSchemaCacheFor metadataObj $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b _crrSource _crrTable . tmRemoteRelationships
|
|
%~ OMap.insert _crrName (RemoteRelationship _crrName _crrDefinition)
|
|
pure successMsg
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Drop relationship from source
|
|
|
|
-- | Argument to the @_drop_remote_relationship@ family of metadata commands.
|
|
data DeleteFromSourceRelationship (b :: BackendType) = DeleteFromSourceRelationship
|
|
{ _drrSource :: SourceName,
|
|
_drrTable :: TableName b,
|
|
_drrName :: RelName
|
|
}
|
|
|
|
instance Backend b => FromJSON (DeleteFromSourceRelationship b) where
|
|
parseJSON = J.withObject "DeleteFromSourceRelationship" $ \o ->
|
|
DeleteFromSourceRelationship
|
|
<$> o .:? "source" .!= defaultSource
|
|
<*> o .: "table"
|
|
<*> o .: "name"
|
|
|
|
runDeleteRemoteRelationship ::
|
|
forall b m.
|
|
(BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m) =>
|
|
DeleteFromSourceRelationship b ->
|
|
m EncJSON
|
|
runDeleteRemoteRelationship (DeleteFromSourceRelationship source table relName) = do
|
|
fieldInfoMap <- askTableFieldInfoMap @b source table
|
|
void $ askRemoteRel fieldInfoMap relName
|
|
let metadataObj =
|
|
MOSourceObjId source $
|
|
AB.mkAnyBackend $
|
|
SMOTableObj @b table $
|
|
MTORemoteRelationship relName
|
|
buildSchemaCacheFor metadataObj $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b source table %~ dropRemoteRelationshipInMetadata relName
|
|
pure successMsg
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Create relationship from remote schema
|
|
|
|
data CreateRemoteSchemaRemoteRelationship = CreateRemoteSchemaRemoteRelationship
|
|
{ _crsrrRemoteSchema :: RemoteSchemaName,
|
|
_crsrrType :: G.Name,
|
|
_crsrrName :: RelName,
|
|
_crsrrDefinition :: RemoteRelationshipDefinition
|
|
}
|
|
deriving (Generic)
|
|
|
|
instance FromJSON CreateRemoteSchemaRemoteRelationship where
|
|
parseJSON = J.withObject "CreateRemoteSchemaRemoteRelationship" $ \o ->
|
|
CreateRemoteSchemaRemoteRelationship
|
|
<$> o .: "remote_schema"
|
|
<*> o .: "type_name"
|
|
<*> o .: "name"
|
|
<*> (o .: "definition" >>= parseRemoteRelationshipDefinition RRPStrict)
|
|
|
|
$(J.deriveToJSON hasuraJSON ''CreateRemoteSchemaRemoteRelationship)
|
|
|
|
runCreateRemoteSchemaRemoteRelationship ::
|
|
forall m.
|
|
(MonadError QErr m, CacheRWM m, MetadataM m) =>
|
|
CreateRemoteSchemaRemoteRelationship ->
|
|
m EncJSON
|
|
runCreateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship {..} = do
|
|
let metadataObj =
|
|
MORemoteSchemaRemoteRelationship _crsrrRemoteSchema _crsrrType _crsrrName
|
|
buildSchemaCacheFor metadataObj $
|
|
MetadataModifier $
|
|
metaRemoteSchemas
|
|
. ix _crsrrRemoteSchema
|
|
. rsmRemoteRelationships
|
|
. at _crsrrType
|
|
. non (RemoteSchemaTypeRelationships _crsrrType mempty)
|
|
. rstrsRelationships
|
|
%~ OMap.insert _crsrrName (RemoteRelationship _crsrrName _crsrrDefinition)
|
|
pure successMsg
|
|
|
|
runUpdateRemoteSchemaRemoteRelationship ::
|
|
forall m.
|
|
(MonadError QErr m, CacheRWM m, MetadataM m) =>
|
|
CreateRemoteSchemaRemoteRelationship ->
|
|
m EncJSON
|
|
runUpdateRemoteSchemaRemoteRelationship crss@CreateRemoteSchemaRemoteRelationship {..} = do
|
|
schemaCache <- askSchemaCache
|
|
let remoteRelationship =
|
|
schemaCache
|
|
^? to scRemoteSchemas
|
|
. ix _crsrrRemoteSchema
|
|
. rscRemoteRelationships
|
|
. ix _crsrrType
|
|
. ix _crsrrName
|
|
void $
|
|
onNothing remoteRelationship $
|
|
throw400 NotExists $
|
|
"no relationship defined on remote schema " <>> _crsrrRemoteSchema <<> " with name " <>> _crsrrName
|
|
runCreateRemoteSchemaRemoteRelationship crss
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Drop relationship from remote schema
|
|
|
|
-- | Argument to the @_drop_remote_relationship@ family of metadata commands.
|
|
data DeleteRemoteSchemaRemoteRelationship = DeleteRemoteSchemaRemoteRelationship
|
|
{ _drsrrRemoteSchema :: RemoteSchemaName,
|
|
_drsrrTypeName :: G.Name,
|
|
_drsrrName :: RelName
|
|
}
|
|
|
|
instance FromJSON DeleteRemoteSchemaRemoteRelationship where
|
|
parseJSON = J.withObject "DeleteRemoteSchemaRemoteRelationship" $ \o ->
|
|
DeleteRemoteSchemaRemoteRelationship
|
|
<$> o .: "remote_schema"
|
|
<*> o .: "type_name"
|
|
<*> o .: "name"
|
|
|
|
runDeleteRemoteSchemaRemoteRelationship ::
|
|
forall m.
|
|
(MonadError QErr m, CacheRWM m, MetadataM m) =>
|
|
DeleteRemoteSchemaRemoteRelationship ->
|
|
m EncJSON
|
|
runDeleteRemoteSchemaRemoteRelationship DeleteRemoteSchemaRemoteRelationship {..} = do
|
|
let relName = _drsrrName
|
|
metadataObj =
|
|
MORemoteSchemaRemoteRelationship _drsrrRemoteSchema _drsrrTypeName relName
|
|
buildSchemaCacheFor metadataObj $
|
|
MetadataModifier $
|
|
metaRemoteSchemas . ix _drsrrRemoteSchema . rsmRemoteRelationships . ix _drsrrTypeName . rstrsRelationships
|
|
%~ OMap.delete relName
|
|
pure successMsg
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Schema cache building (TODO: move this elsewere!)
|
|
|
|
-- | Internal intermediary step.
|
|
--
|
|
-- We build the output of sources in two steps:
|
|
-- 1. we first resolve sources, and collect the core info of their tables
|
|
-- 2. we then build the entire output from the collection of partially resolved sources
|
|
--
|
|
-- We need this split to be able to resolve cross-source relationships: to process one source's
|
|
-- remote relationship, we need to know about the target source's tables core info.
|
|
--
|
|
-- This data structure is used as an argument to @AnyBackend@ in the backend-agnostic intermediary
|
|
-- collection, and used here to build remote field info.
|
|
data PartiallyResolvedSource b = PartiallyResolvedSource
|
|
{ _prsSourceMetadata :: SourceMetadata b,
|
|
_resolvedSource :: ResolvedSource b,
|
|
_tableCoreInfoMap :: HashMap (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
|
|
_eventTriggerInfoMap :: HashMap (TableName b) (EventTriggerInfoMap b)
|
|
}
|
|
|
|
-- | Builds the schema cache representation of a remote relationship
|
|
-- TODO: this is not actually called by the remote relationship DDL API and is only used as part of
|
|
-- the schema cache process. Should this be moved elsewhere?
|
|
buildRemoteFieldInfo ::
|
|
QErrM m =>
|
|
-- | The entity on which the remote relationship is defined
|
|
LHSIdentifier ->
|
|
-- | join fields provided by the LHS entity
|
|
Map.HashMap FieldName lhsJoinField ->
|
|
-- | definition of remote relationship
|
|
RemoteRelationship ->
|
|
-- | Required context to process cross boundary relationships
|
|
HashMap SourceName (AB.AnyBackend PartiallyResolvedSource) ->
|
|
-- | Required context to process cross boundary relationships
|
|
PartiallyResolvedRemoteSchemaMap ->
|
|
-- | returns
|
|
-- 1. schema cache representation of the remote relationships
|
|
-- 2. the dependencies on the RHS of the join. The dependencies
|
|
-- on the LHS entities has to be handled by the calling function
|
|
m (RemoteFieldInfo lhsJoinField, [SchemaDependency])
|
|
buildRemoteFieldInfo lhsIdentifier lhsJoinFields RemoteRelationship {..} allSources remoteSchemaMap =
|
|
case _rrDefinition of
|
|
RelationshipToSource ToSourceRelationshipDef {..} -> do
|
|
targetTables <-
|
|
Map.lookup _tsrdSource allSources
|
|
`onNothing` throw400 NotFound ("source not found: " <>> _tsrdSource)
|
|
AB.dispatchAnyBackend @Backend targetTables \(partiallyResolvedSource :: PartiallyResolvedSource b') -> do
|
|
let PartiallyResolvedSource _ targetSourceInfo targetTablesInfo _ = partiallyResolvedSource
|
|
(targetTable :: TableName b') <- runAesonParser J.parseJSON _tsrdTable
|
|
targetColumns <-
|
|
fmap _tciFieldInfoMap $
|
|
onNothing (Map.lookup targetTable targetTablesInfo) $
|
|
throw400 NotExists $
|
|
"table " <> targetTable <<> " does not exist in source: " <> sourceNameToText _tsrdSource
|
|
-- TODO: rhs fields should also ideally be DBJoinFields
|
|
columnPairs <- for (Map.toList _tsrdFieldMapping) \(srcFieldName, tgtFieldName) -> do
|
|
lhsJoinField <- askFieldInfo lhsJoinFields srcFieldName
|
|
tgtField <- askFieldInfo targetColumns tgtFieldName
|
|
pure (srcFieldName, lhsJoinField, tgtField)
|
|
columnMapping <- for columnPairs \(srcFieldName, srcColumn, tgtColumn) -> do
|
|
tgtScalar <- case ciType tgtColumn of
|
|
ColumnScalar scalarType -> pure scalarType
|
|
ColumnEnumReference _ -> throw400 NotSupported "relationships to enum fields are not supported yet"
|
|
pure (srcFieldName, (srcColumn, tgtScalar, ciColumn tgtColumn))
|
|
let sourceConfig = _rsConfig targetSourceInfo
|
|
rsri =
|
|
RemoteSourceFieldInfo _rrName _tsrdRelationshipType _tsrdSource sourceConfig targetTable $
|
|
fmap (\(_, tgtType, tgtColumn) -> (tgtType, tgtColumn)) $
|
|
Map.fromList columnMapping
|
|
rhsDependencies =
|
|
SchemaDependency (SOSourceObj _tsrdSource $ AB.mkAnyBackend $ SOITable @b' targetTable) DRTable
|
|
: flip map columnPairs \(_, _srcColumn, tgtColumn) ->
|
|
SchemaDependency
|
|
( SOSourceObj _tsrdSource $
|
|
AB.mkAnyBackend $
|
|
SOITableObj @b' targetTable $
|
|
TOCol @b' $
|
|
ciColumn tgtColumn
|
|
)
|
|
DRRemoteRelationship
|
|
requiredLHSJoinFields = fmap (\(srcField, _, _) -> srcField) $ Map.fromList columnMapping
|
|
pure (RemoteFieldInfo requiredLHSJoinFields $ RFISource $ AB.mkAnyBackend @b' rsri, rhsDependencies)
|
|
RelationshipToSchema _ remoteRelationship@ToSchemaRelationshipDef {..} -> do
|
|
RemoteSchemaCtx {..} <-
|
|
onNothing (Map.lookup _trrdRemoteSchema remoteSchemaMap) $
|
|
throw400 RemoteSchemaError $
|
|
"remote schema with name " <> _trrdRemoteSchema <<> " not found"
|
|
(requiredLHSJoinFields, remoteField) <-
|
|
validateToSchemaRelationship remoteRelationship lhsIdentifier _rrName (_rscInfo, _rscIntroOriginal) lhsJoinFields
|
|
`onLeft` (throw400 RemoteSchemaError . errorToText)
|
|
let rhsDependencies = [SchemaDependency (SORemoteSchema _trrdRemoteSchema) DRRemoteSchema]
|
|
pure (RemoteFieldInfo requiredLHSJoinFields $ RFISchema remoteField, rhsDependencies)
|
|
|
|
getRemoteSchemaEntityJoinColumns ::
|
|
(MonadError QErr m) =>
|
|
RemoteSchemaName ->
|
|
RemoteSchemaIntrospection ->
|
|
G.Name ->
|
|
m (HashMap FieldName G.Name)
|
|
getRemoteSchemaEntityJoinColumns remoteSchemaName introspection typeName = do
|
|
typeDefinition <-
|
|
onNothing (lookupType introspection typeName) $
|
|
throw400 NotFound ("no type named " <> typeName <<> " defined in remote schema " <>> remoteSchemaName)
|
|
case typeDefinition of
|
|
G.TypeDefinitionObject objectDefinition ->
|
|
pure $
|
|
Map.fromList $ do
|
|
fieldDefinition <- G._otdFieldsDefinition objectDefinition
|
|
guard $ null $ G._fldArgumentsDefinition fieldDefinition
|
|
pure (FieldName $ G.unName $ G._fldName fieldDefinition, G._fldName fieldDefinition)
|
|
_ -> throw400 NotSupported "remote relationships on a remote schema can only be defined on object types"
|