graphql-engine/server/src-lib/Hasura/RQL/DDL/ComputedField.hs
Antoine Leblanc 21254256a1 Improve error messages of Metadata API.
### Description

This PR improves error messages in our metadata API by displaying a message with the name of the failing command and a link to our documentation. Furthermore, it harmonizes our internal uses of `withObject`, to respect the convention of using the Haskell type name, now that the Aeson error message is displayed as an "internal error message".

https://github.com/hasura/graphql-engine-mono/pull/1905

GitOrigin-RevId: e4064ba3290306437aa7e45faa316c60e51bc6b6
2021-09-20 19:50:22 +00:00

128 lines
4.1 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.Base.Error
import Hasura.EncJSON
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 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"
runAddComputedField
:: forall b m
. (BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m)
=> AddComputedField b
-> m EncJSON
runAddComputedField q = do
withPathK "table" $ askTabInfo @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 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
when (not cascade && not (null deps)) $ reportDeps 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
dropComputedFieldInMetadata
:: ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata name =
tmComputedFields %~ OMap.delete name