graphql-engine/server/src-lib/Hasura/RQL/DDL/RemoteRelationship.hs

module Hasura.RQL.DDL.RemoteRelationship
  ( runCreateRemoteRelationship
  , runDeleteRemoteRelationship
  , runUpdateRemoteRelationship
  , DeleteRemoteRelationship
  , dropRemoteRelationshipInMetadata
  , PartiallyResolvedSource(..)
  , buildRemoteFieldInfo
  ) where

import           Hasura.Prelude

import qualified Data.Aeson                                 as J
import qualified Data.HashMap.Strict                        as Map
import qualified Data.HashMap.Strict.InsOrd                 as OMap
import qualified Data.HashSet                               as S

import           Data.Aeson
import           Data.Text.Extended

import qualified Hasura.SQL.AnyBackend                      as AB

import           Hasura.Base.Error
import           Hasura.EncJSON
import           Hasura.RQL.DDL.RemoteRelationship.Validate
import           Hasura.RQL.Types
import           Hasura.SQL.AnyBackend                      (mkAnyBackend)


runCreateRemoteRelationship
  :: forall b m
   . (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b)
  => RemoteRelationship b
  -> m EncJSON
runCreateRemoteRelationship RemoteRelationship {..} = do
  void $ askTabInfo @b _rtrSource _rtrTable
  let metadataObj = MOSourceObjId _rtrSource
                    $ AB.mkAnyBackend
                    $ SMOTableObj @b _rtrTable
                    $ MTORemoteRelationship _rtrName
      metadata = RemoteRelationshipMetadata _rtrName _rtrDefinition
  buildSchemaCacheFor metadataObj
    $ MetadataModifier
    $ tableMetadataSetter @b _rtrSource _rtrTable.tmRemoteRelationships
      %~ OMap.insert _rtrName metadata
  pure successMsg

runUpdateRemoteRelationship
  :: forall b m
   . (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b)
  => RemoteRelationship b
  -> m EncJSON
runUpdateRemoteRelationship RemoteRelationship {..} = do
  fieldInfoMap <- askFieldInfoMap @b _rtrSource _rtrTable
  void $ askRemoteRel fieldInfoMap _rtrName
  let metadataObj = MOSourceObjId _rtrSource
                      $ AB.mkAnyBackend
                      $ SMOTableObj @b _rtrTable
                      $ MTORemoteRelationship _rtrName
      metadata = RemoteRelationshipMetadata _rtrName _rtrDefinition
  buildSchemaCacheFor metadataObj
    $ MetadataModifier
    $ tableMetadataSetter @b _rtrSource _rtrTable.tmRemoteRelationships
      %~ OMap.insert _rtrName metadata
  pure successMsg

data DeleteRemoteRelationship (b :: BackendType)
  = DeleteRemoteRelationship
  { _drrSource :: !SourceName
  , _drrTable  :: !(TableName b)
  , _drrName   :: !RemoteRelationshipName
  }

instance Backend b => FromJSON (DeleteRemoteRelationship b) where
  parseJSON = withObject "delete remote relationship" $ \o ->
    DeleteRemoteRelationship
      <$> o .:? "source" .!= defaultSource
      <*> o .: "table"
      <*> o .: "name"

runDeleteRemoteRelationship
  :: forall b m
   . (BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m)
  => DeleteRemoteRelationship b
  -> m EncJSON
runDeleteRemoteRelationship (DeleteRemoteRelationship source table relName) = do
  fieldInfoMap <- askFieldInfoMap @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

dropRemoteRelationshipInMetadata
  :: RemoteRelationshipName -> TableMetadata b -> TableMetadata b
dropRemoteRelationshipInMetadata name =
  tmRemoteRelationships %~ OMap.delete name


-- | 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)))
  }

-- 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
  :: forall m b
   . (Backend b, QErrM m)
  => SourceName
  -> TableName b
  -> FieldInfoMap (FieldInfo b)
  -> RemoteRelationship b
  -> HashMap SourceName (AB.AnyBackend PartiallyResolvedSource)
  -> RemoteSchemaMap
  -> m (RemoteFieldInfo b, [SchemaDependency])
buildRemoteFieldInfo sourceSource sourceTable fields RemoteRelationship{..} allSources remoteSchemaMap =
  case _rtrDefinition of
    RemoteSourceRelDef RemoteSourceRelationshipDef{..} -> do
      targetTables <- Map.lookup _rsrSource allSources
        `onNothing` throw400 NotFound ("source not found: " <>> _rsrSource)
      AB.dispatchAnyBackend @Backend targetTables \(partiallyResolvedSource :: PartiallyResolvedSource b') -> do
        let PartiallyResolvedSource _ targetSourceInfo targetTablesInfo = partiallyResolvedSource
        (targetTable :: TableName b') <- runAesonParser J.parseJSON _rsrTable
        targetColumns <- fmap _tciFieldInfoMap $
          onNothing ( Map.lookup targetTable targetTablesInfo) $ throwTableDoesNotExist @b' targetTable
        columnPairs <- for (Map.toList _rsrFieldMapping) \(srcFieldName, tgtFieldName) -> do
          srcField  <- askFieldInfo fields srcFieldName
          tgtField  <- askFieldInfo targetColumns tgtFieldName
          srcColumn <- case srcField of
            FIColumn column -> pure column
            _               -> throw400 NotSupported "relationships from non-columns are not supported yet"
          pure (srcFieldName, srcColumn, tgtField)
        mapping <- for columnPairs \(srcFieldName, srcColumn, tgtColumn) -> do
          tgtScalar <- case pgiType tgtColumn of
            ColumnScalar scalarType -> pure scalarType
            ColumnEnumReference _   -> throw400 NotSupported "relationships to enum fields are not supported yet"
          pure (srcFieldName, (srcColumn, tgtScalar, pgiColumn tgtColumn))
        let sourceConfig = _rsConfig targetSourceInfo
            rsri = RemoteSourceRelationshipInfo _rtrName _rsrRelationshipType _rsrSource sourceConfig targetTable $ Map.fromList mapping
            tableDependencies =
              [ SchemaDependency (SOSourceObj sourceSource $ AB.mkAnyBackend $ SOITable @b  sourceTable) DRTable
              , SchemaDependency (SOSourceObj _rsrSource   $ AB.mkAnyBackend $ SOITable @b' targetTable) DRTable
              ]
            columnDependencies = flip concatMap columnPairs \(_, srcColumn, tgtColumn) ->
              [ SchemaDependency (SOSourceObj sourceSource $ AB.mkAnyBackend $ SOITableObj @b  sourceTable $ TOCol @b  $ pgiColumn srcColumn) DRRemoteRelationship
              , SchemaDependency (SOSourceObj _rsrSource   $ AB.mkAnyBackend $ SOITableObj @b' targetTable $ TOCol @b' $ pgiColumn tgtColumn) DRRemoteRelationship
              ]
        pure (RFISource $ mkAnyBackend @b' rsri, tableDependencies <> columnDependencies)
    RemoteSchemaRelDef _ remoteRelationship@RemoteSchemaRelationshipDef{..} -> do
      RemoteSchemaCtx {..} <-
        onNothing (Map.lookup _rrdRemoteSchemaName remoteSchemaMap)
          $ throw400 RemoteSchemaError $ "remote schema with name " <> _rrdRemoteSchemaName <<> " not found"
      remoteField <- validateRemoteSchemaRelationship remoteRelationship _rtrTable _rtrName _rtrSource (_rscInfo, _rscIntroOriginal) fields
        `onLeft` (throw400 RemoteSchemaError . errorToText)
      let tableDep = SchemaDependency (SOSourceObj _rtrSource $ AB.mkAnyBackend $ SOITable @b _rtrTable) DRTable
          remoteSchemaDep = SchemaDependency (SORemoteSchema _rrdRemoteSchemaName) DRRemoteSchema
          fieldsDep = S.toList (_rfiHasuraFields remoteField) <&> \case
            JoinColumn columnInfo ->
              -- TODO: shouldn't this be DRColumn??
              mkColDep @b DRRemoteRelationship _rtrSource _rtrTable $ pgiColumn columnInfo
            JoinComputedField computedFieldInfo ->
              mkComputedFieldDep @b DRRemoteRelationship _rtrSource _rtrTable $ _scfName computedFieldInfo
          schemaDependencies = (tableDep : remoteSchemaDep : fieldsDep)
      pure (RFISchema remoteField, schemaDependencies)