graphql-engine/server/src-lib/Hasura/RQL/DDL/ComputedField.hs
2022-08-01 09:33:35 +00:00

131 lines
4.2 KiB
Haskell

-- |
-- Description: Add/Drop computed fields in metadata
module Hasura.RQL.DDL.ComputedField
( AddComputedField (..),
runAddComputedField,
DropComputedField,
runDropComputedField,
dropComputedFieldInMetadata,
)
where
import Data.Aeson
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Permission
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
data AddComputedField b = AddComputedField
{ _afcSource :: SourceName,
_afcTable :: TableName b,
_afcName :: ComputedFieldName,
_afcDefinition :: ComputedFieldDefinition b,
_afcComment :: Comment
}
deriving stock (Generic)
instance (Backend b) => ToJSON (AddComputedField b) where
toJSON = genericToJSON hasuraJSON
instance (Backend b) => FromJSON (AddComputedField b) where
parseJSON = withObject "AddComputedField" $ \o ->
AddComputedField
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "name"
<*> o .: "definition"
<*> o .:? "comment" .!= Automatic
runAddComputedField ::
forall b m.
(BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m) =>
AddComputedField b ->
m EncJSON
runAddComputedField q = do
void $ withPathK "table" $ askTableInfo @b source table
let metadataObj =
MOSourceObjId source $
AB.mkAnyBackend $
SMOTableObj @b table $
MTOComputedField computedFieldName
metadata = ComputedFieldMetadata computedFieldName (_afcDefinition q) (_afcComment q)
buildSchemaCacheFor metadataObj $
MetadataModifier $
tableMetadataSetter @b source table . tmComputedFields
%~ OMap.insert computedFieldName metadata
pure successMsg
where
source = _afcSource q
table = _afcTable q
computedFieldName = _afcName q
data DropComputedField b = DropComputedField
{ _dccSource :: SourceName,
_dccTable :: TableName b,
_dccName :: ComputedFieldName,
_dccCascade :: Bool
}
instance (Backend b) => FromJSON (DropComputedField b) where
parseJSON = withObject "DropComputedField" $ \o ->
DropComputedField
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "name"
<*> o .:? "cascade" .!= False
runDropComputedField ::
forall b m.
(QErrM m, CacheRWM m, MetadataM m, BackendMetadata b) =>
DropComputedField b ->
m EncJSON
runDropComputedField (DropComputedField source table computedField cascade) = do
-- Validation
fields <- withPathK "table" $ _tciFieldInfoMap <$> askTableCoreInfo @b source table
void $ withPathK "name" $ askComputedFieldInfo fields computedField
-- Dependencies check
sc <- askSchemaCache
let deps =
getDependentObjs sc $
SOSourceObj source $
AB.mkAnyBackend $
SOITableObj @b table $
TOComputedField computedField
unless (cascade || null deps) $ reportDependentObjectsExist deps
withNewInconsistentObjsCheck do
metadataModifiers <- mapM purgeComputedFieldDependency deps
buildSchemaCache $
MetadataModifier $
tableMetadataSetter @b source table
%~ dropComputedFieldInMetadata computedField . foldl' (.) id metadataModifiers
pure successMsg
where
purgeComputedFieldDependency = \case
-- TODO: do a better check of ensuring that the dependency is as expected.
-- i.e, the only allowed dependent objects on a computed fields are permissions
-- on the same table
SOSourceObj _ exists
| Just (SOITableObj _ (TOPerm roleName permType)) <-
AB.unpackAnyBackend @b exists ->
pure $ dropPermissionInMetadata roleName permType
d ->
throw500 $
"unexpected dependency for computed field "
<> computedField <<> "; "
<> reportSchemaObj d