graphql-engine/server/src-lib/Hasura/RQL/DDL/ComputedField.hs
Vladimir Ciobanu da8f6981d4 server: reduce the number of backend dispatches
Fixes https://github.com/hasura/graphql-engine-mono/issues/712

Main point of interest: the `Hasura.SQL.Backend` module.

This PR creates an `Exists` type indexed by indexed type and packed constraint while hiding all of its complexity by not exporting the constructor.

Existential constructors/types which are no longer (directly) existential:
- [X] BackendSourceInfo :: BackendSourceInfo
- [x] BackendSourceMetadata :: BackendSourceMetadata
- [x] MOSourceObjId :: MetadatObjId
- [x] SOSourceObj :: SchemaObjId
- [x] RFDB :: RootField
- [x] LQP :: LiveQueryPlan
- [x] ExecutionStep :: ExecStepDB

This PR also removes ALL usages of `Typeable.cast` from our codebase. We still need to derive `Typeable` in a few places in order to be able to derive `Data` in one place. I have not dug deeper to see why this is needed.

GitOrigin-RevId: bb47e957192e4bb0af4c4116aee7bb92f7983445
2021-03-15 13:03:55 +00:00

131 lines
4.5 KiB
Haskell

{- |
Description: Add/Drop computed fields in metadata
-}
module Hasura.RQL.DDL.ComputedField
( AddComputedField(..)
, ComputedFieldDefinition(..)
, runAddComputedField
, DropComputedField
, runDropComputedField
, dropComputedFieldInMetadata
) where
import Hasura.Prelude
import qualified Data.HashMap.Strict.InsOrd as OMap
import Data.Aeson
import Data.Text.Extended
import qualified Hasura.SQL.AnyBackend as AB
import Hasura.EncJSON
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Deps
import Hasura.RQL.DDL.Permission
import Hasura.RQL.Types
data AddComputedField b
= AddComputedField
{ _afcSource :: !SourceName
, _afcTable :: !(TableName b)
, _afcName :: !ComputedFieldName
, _afcDefinition :: !(ComputedFieldDefinition b)
, _afcComment :: !(Maybe Text)
} deriving (Generic)
deriving instance (Backend b) => Show (AddComputedField b)
deriving instance (Backend b) => Eq (AddComputedField b)
instance (Backend b) => NFData (AddComputedField b)
instance (Backend b) => Cacheable (AddComputedField b)
instance (Backend b) => ToJSON (AddComputedField b) where
toJSON = genericToJSON hasuraJSON
instance (Backend b) => FromJSON (AddComputedField b) where
parseJSON = withObject "Object" $ \o ->
AddComputedField
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "name"
<*> o .: "definition"
<*> o .:? "comment"
runAddComputedField :: (MonadError QErr m, CacheRWM m, MetadataM m) => AddComputedField 'Postgres -> m EncJSON
runAddComputedField q = do
withPathK "table" $ askTabInfo source table
let metadataObj = MOSourceObjId source
$ AB.mkAnyBackend
$ SMOTableObj table
$ MTOComputedField computedFieldName
metadata = ComputedFieldMetadata computedFieldName (_afcDefinition q) (_afcComment q)
buildSchemaCacheFor metadataObj
$ MetadataModifier
$ tableMetadataSetter 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
} deriving (Generic)
deriving instance (Backend b) => Show (DropComputedField b)
deriving instance (Backend b) => Eq (DropComputedField b)
instance (Backend b) => ToJSON (DropComputedField b) where
toJSON = genericToJSON hasuraJSON
instance (Backend b) => FromJSON (DropComputedField b) where
parseJSON = withObject "Object" $ \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 source table
void $ withPathK "name" $ askComputedFieldInfo fields computedField
-- Dependencies check
sc <- askSchemaCache
let deps = getDependentObjs sc
$ SOSourceObj source
$ AB.mkAnyBackend
$ SOITableObj table
$ TOComputedField computedField
when (not cascade && not (null deps)) $ reportDeps deps
withNewInconsistentObjsCheck do
metadataModifiers <- mapM purgeComputedFieldDependency deps
buildSchemaCache $ MetadataModifier $
tableMetadataSetter 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
dropComputedFieldInMetadata
:: ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata name =
tmComputedFields %~ OMap.delete name