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
{ AddComputedField b -> SourceName
_afcSource :: SourceName,
AddComputedField b -> TableName b
_afcTable :: TableName b,
AddComputedField b -> ComputedFieldName
_afcName :: ComputedFieldName,
AddComputedField b -> ComputedFieldDefinition b
_afcDefinition :: ComputedFieldDefinition b,
:: Comment
}
deriving stock ((forall x. AddComputedField b -> Rep (AddComputedField b) x)
-> (forall x. Rep (AddComputedField b) x -> AddComputedField b)
-> Generic (AddComputedField b)
forall x. Rep (AddComputedField b) x -> AddComputedField b
forall x. AddComputedField b -> Rep (AddComputedField b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (AddComputedField b) x -> AddComputedField b
forall (b :: BackendType) x.
AddComputedField b -> Rep (AddComputedField b) x
$cto :: forall (b :: BackendType) x.
Rep (AddComputedField b) x -> AddComputedField b
$cfrom :: forall (b :: BackendType) x.
AddComputedField b -> Rep (AddComputedField b) x
Generic)
instance (Backend b) => ToJSON (AddComputedField b) where
toJSON :: AddComputedField b -> Value
toJSON = Options -> AddComputedField b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
instance (Backend b) => FromJSON (AddComputedField b) where
parseJSON :: Value -> Parser (AddComputedField b)
parseJSON = String
-> (Object -> Parser (AddComputedField b))
-> Value
-> Parser (AddComputedField b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AddComputedField" ((Object -> Parser (AddComputedField b))
-> Value -> Parser (AddComputedField b))
-> (Object -> Parser (AddComputedField b))
-> Value
-> Parser (AddComputedField b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
SourceName
-> TableName b
-> ComputedFieldName
-> ComputedFieldDefinition b
-> Comment
-> AddComputedField b
forall (b :: BackendType).
SourceName
-> TableName b
-> ComputedFieldName
-> ComputedFieldDefinition b
-> Comment
-> AddComputedField b
AddComputedField
(SourceName
-> TableName b
-> ComputedFieldName
-> ComputedFieldDefinition b
-> Comment
-> AddComputedField b)
-> Parser SourceName
-> Parser
(TableName b
-> ComputedFieldName
-> ComputedFieldDefinition b
-> Comment
-> AddComputedField b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
Parser
(TableName b
-> ComputedFieldName
-> ComputedFieldDefinition b
-> Comment
-> AddComputedField b)
-> Parser (TableName b)
-> Parser
(ComputedFieldName
-> ComputedFieldDefinition b -> Comment -> AddComputedField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
Parser
(ComputedFieldName
-> ComputedFieldDefinition b -> Comment -> AddComputedField b)
-> Parser ComputedFieldName
-> Parser
(ComputedFieldDefinition b -> Comment -> AddComputedField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ComputedFieldName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
Parser (ComputedFieldDefinition b -> Comment -> AddComputedField b)
-> Parser (ComputedFieldDefinition b)
-> Parser (Comment -> AddComputedField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (ComputedFieldDefinition b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"definition"
Parser (Comment -> AddComputedField b)
-> Parser Comment -> Parser (AddComputedField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Comment)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment" Parser (Maybe Comment) -> Comment -> Parser Comment
forall a. Parser (Maybe a) -> a -> Parser a
.!= Comment
Automatic
runAddComputedField ::
forall b m.
(BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m) =>
AddComputedField b ->
m EncJSON
runAddComputedField :: AddComputedField b -> m EncJSON
runAddComputedField AddComputedField b
q = do
m (TableInfo b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TableInfo b) -> m ()) -> m (TableInfo b) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m (TableInfo b) -> m (TableInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"table" (m (TableInfo b) -> m (TableInfo b))
-> m (TableInfo b) -> m (TableInfo b)
forall a b. (a -> b) -> a -> b
$ SourceName -> TableName b -> m (TableInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
source TableName b
table
let metadataObj :: MetadataObjId
metadataObj =
SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$
SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
ComputedFieldName -> TableMetadataObjId
MTOComputedField ComputedFieldName
computedFieldName
metadata :: ComputedFieldMetadata b
metadata = ComputedFieldName
-> ComputedFieldDefinition b -> Comment -> ComputedFieldMetadata b
forall (b :: BackendType).
ComputedFieldName
-> ComputedFieldDefinition b -> Comment -> ComputedFieldMetadata b
ComputedFieldMetadata ComputedFieldName
computedFieldName (AddComputedField b -> ComputedFieldDefinition b
forall (b :: BackendType).
AddComputedField b -> ComputedFieldDefinition b
_afcDefinition AddComputedField b
q) (AddComputedField b -> Comment
forall (b :: BackendType). AddComputedField b -> Comment
_afcComment AddComputedField b
q)
MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
(Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
table ASetter' Metadata (TableMetadata b)
-> ((ComputedFields b -> Identity (ComputedFields b))
-> TableMetadata b -> Identity (TableMetadata b))
-> (ComputedFields b -> Identity (ComputedFields b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ComputedFields b -> Identity (ComputedFields b))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (ComputedFields b)
tmComputedFields
((ComputedFields b -> Identity (ComputedFields b))
-> Metadata -> Identity Metadata)
-> (ComputedFields b -> ComputedFields b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ComputedFieldName
-> ComputedFieldMetadata b -> ComputedFields b -> ComputedFields b
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert ComputedFieldName
computedFieldName ComputedFieldMetadata b
metadata
EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
where
source :: SourceName
source = AddComputedField b -> SourceName
forall (b :: BackendType). AddComputedField b -> SourceName
_afcSource AddComputedField b
q
table :: TableName b
table = AddComputedField b -> TableName b
forall (b :: BackendType). AddComputedField b -> TableName b
_afcTable AddComputedField b
q
computedFieldName :: ComputedFieldName
computedFieldName = AddComputedField b -> ComputedFieldName
forall (b :: BackendType). AddComputedField b -> ComputedFieldName
_afcName AddComputedField b
q
data DropComputedField b = DropComputedField
{ DropComputedField b -> SourceName
_dccSource :: SourceName,
DropComputedField b -> TableName b
_dccTable :: TableName b,
DropComputedField b -> ComputedFieldName
_dccName :: ComputedFieldName,
DropComputedField b -> Bool
_dccCascade :: Bool
}
instance (Backend b) => FromJSON (DropComputedField b) where
parseJSON :: Value -> Parser (DropComputedField b)
parseJSON = String
-> (Object -> Parser (DropComputedField b))
-> Value
-> Parser (DropComputedField b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DropComputedField" ((Object -> Parser (DropComputedField b))
-> Value -> Parser (DropComputedField b))
-> (Object -> Parser (DropComputedField b))
-> Value
-> Parser (DropComputedField b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
SourceName
-> TableName b -> ComputedFieldName -> Bool -> DropComputedField b
forall (b :: BackendType).
SourceName
-> TableName b -> ComputedFieldName -> Bool -> DropComputedField b
DropComputedField
(SourceName
-> TableName b -> ComputedFieldName -> Bool -> DropComputedField b)
-> Parser SourceName
-> Parser
(TableName b -> ComputedFieldName -> Bool -> DropComputedField b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
Parser
(TableName b -> ComputedFieldName -> Bool -> DropComputedField b)
-> Parser (TableName b)
-> Parser (ComputedFieldName -> Bool -> DropComputedField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
Parser (ComputedFieldName -> Bool -> DropComputedField b)
-> Parser ComputedFieldName -> Parser (Bool -> DropComputedField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ComputedFieldName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
Parser (Bool -> DropComputedField b)
-> Parser Bool -> Parser (DropComputedField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cascade" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
runDropComputedField ::
forall b m.
(QErrM m, CacheRWM m, MetadataM m, BackendMetadata b) =>
DropComputedField b ->
m EncJSON
runDropComputedField :: DropComputedField b -> m EncJSON
runDropComputedField (DropComputedField SourceName
source TableName b
table ComputedFieldName
computedField Bool
cascade) = do
FieldInfoMap (FieldInfo b)
fields <- Text
-> m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"table" (m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b)))
-> m (FieldInfoMap (FieldInfo b)) -> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> a -> b
$ TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName
-> TableName b -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
table
m (ComputedFieldInfo b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (ComputedFieldInfo b) -> m ())
-> m (ComputedFieldInfo b) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m (ComputedFieldInfo b) -> m (ComputedFieldInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"name" (m (ComputedFieldInfo b) -> m (ComputedFieldInfo b))
-> m (ComputedFieldInfo b) -> m (ComputedFieldInfo b)
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b)
-> ComputedFieldName -> m (ComputedFieldInfo b)
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> ComputedFieldName -> m (ComputedFieldInfo backend)
askComputedFieldInfo FieldInfoMap (FieldInfo b)
fields ComputedFieldName
computedField
SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
let deps :: [SchemaObjId]
deps =
SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs SchemaCache
sc (SchemaObjId -> [SchemaObjId]) -> SchemaObjId -> [SchemaObjId]
forall a b. (a -> b) -> a -> b
$
SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$
SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$
TableName b -> TableObjId b -> SourceObjId b
forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
table (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$
ComputedFieldName -> TableObjId b
forall (b :: BackendType). ComputedFieldName -> TableObjId b
TOComputedField ComputedFieldName
computedField
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
cascade Bool -> Bool -> Bool
|| [SchemaObjId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
deps) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [SchemaObjId] -> m ()
forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
deps
m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck do
[TableMetadata b -> TableMetadata b]
metadataModifiers <- (SchemaObjId -> m (TableMetadata b -> TableMetadata b))
-> [SchemaObjId] -> m [TableMetadata b -> TableMetadata b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SchemaObjId -> m (TableMetadata b -> TableMetadata b)
purgeComputedFieldDependency [SchemaObjId]
deps
MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
(Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
table
ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ComputedFieldName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata ComputedFieldName
computedField (TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> [TableMetadata b -> TableMetadata b]
-> TableMetadata b
-> TableMetadata b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) TableMetadata b -> TableMetadata b
forall a. a -> a
id [TableMetadata b -> TableMetadata b]
metadataModifiers
EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
where
purgeComputedFieldDependency :: SchemaObjId -> m (TableMetadata b -> TableMetadata b)
purgeComputedFieldDependency = \case
SOSourceObj SourceName
_ AnyBackend SourceObjId
exists
| Just (SOITableObj TableName b
_ (TOPerm RoleName
roleName PermType
permType)) <-
AnyBackend SourceObjId -> Maybe (SourceObjId b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @b AnyBackend SourceObjId
exists ->
(TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ RoleName -> PermType -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
roleName PermType
permType
SchemaObjId
d ->
Text -> m (TableMetadata b -> TableMetadata b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (TableMetadata b -> TableMetadata b))
-> Text -> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$
Text
"unexpected dependency for computed field "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName
computedField ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"; "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SchemaObjId -> Text
reportSchemaObj SchemaObjId
d