{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.SchemaCacheTypes
  ( BoolExpM (..),
    GetAggregationPredicatesDeps (..),
    BoolExpCtx (..),
    DependencyReason (..),
    SchemaDependency (..),
    SchemaObjId (..),
    SourceObjId (..),
    TableObjId (..),
    LogicalModelObjId (..),
    NativeQueryObjId (..),
    StoredProcedureObjId (..),
    purgeDependentObject,
    purgeSourceAndSchemaDependencies,
    reasonToTxt,
    reportDependentObjectsExist,
    reportSchemaObj,
    reportSchemaObjs,
    runBoolExpM,
  )
where

import Data.Aeson
import Data.Aeson.Types
import Data.Functor.Const
import Data.Text qualified as T
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.Base.Error
import Hasura.LogicalModel.Types (LogicalModelName)
import Hasura.NativeQuery.Types (NativeQueryName)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (PartialSQLExp)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Instances ()
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.Roles (RoleName, roleNameToTxt)
import Hasura.RemoteSchema.Metadata
import Hasura.SQL.AnyBackend qualified as AB
import Language.GraphQL.Draft.Syntax qualified as G

data TableObjId (b :: BackendType)
  = TOCol (Column b)
  | TORel RelName
  | TOComputedField ComputedFieldName
  | TORemoteRel RelName
  | TOForeignKey (ConstraintName b)
  | TOPerm RoleName PermType
  | TOTrigger TriggerName
  deriving ((forall x. TableObjId b -> Rep (TableObjId b) x)
-> (forall x. Rep (TableObjId b) x -> TableObjId b)
-> Generic (TableObjId b)
forall x. Rep (TableObjId b) x -> TableObjId b
forall x. TableObjId b -> Rep (TableObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (TableObjId b) x -> TableObjId b
forall (b :: BackendType) x. TableObjId b -> Rep (TableObjId b) x
$cfrom :: forall (b :: BackendType) x. TableObjId b -> Rep (TableObjId b) x
from :: forall x. TableObjId b -> Rep (TableObjId b) x
$cto :: forall (b :: BackendType) x. Rep (TableObjId b) x -> TableObjId b
to :: forall x. Rep (TableObjId b) x -> TableObjId b
Generic)

deriving instance (Backend b) => Eq (TableObjId b)

instance (Backend b) => Hashable (TableObjId b)

-- | Identifiers for components of logical models within the metadata. These
-- are used to track dependencies within the resolved schema (see
-- 'SourceInfo').
data LogicalModelObjId (b :: BackendType)
  = LMOPerm RoleName PermType
  | LMOCol (Column b)
  | LMOReferencedLogicalModel LogicalModelName
  deriving ((forall x. LogicalModelObjId b -> Rep (LogicalModelObjId b) x)
-> (forall x. Rep (LogicalModelObjId b) x -> LogicalModelObjId b)
-> Generic (LogicalModelObjId b)
forall x. Rep (LogicalModelObjId b) x -> LogicalModelObjId b
forall x. LogicalModelObjId b -> Rep (LogicalModelObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (LogicalModelObjId b) x -> LogicalModelObjId b
forall (b :: BackendType) x.
LogicalModelObjId b -> Rep (LogicalModelObjId b) x
$cfrom :: forall (b :: BackendType) x.
LogicalModelObjId b -> Rep (LogicalModelObjId b) x
from :: forall x. LogicalModelObjId b -> Rep (LogicalModelObjId b) x
$cto :: forall (b :: BackendType) x.
Rep (LogicalModelObjId b) x -> LogicalModelObjId b
to :: forall x. Rep (LogicalModelObjId b) x -> LogicalModelObjId b
Generic)

deriving stock instance (Backend b) => Eq (LogicalModelObjId b)

instance (Backend b) => Hashable (LogicalModelObjId b)

-- | Identifier for component of Native Queries within the metadata. These are
-- used to track dependencies between items in the resolved schema. For
-- instance, we use `NQOCol` along with `TOCol` from `TableObjId` to ensure
-- that the two columns that join an array relationship actually exist.
data NativeQueryObjId (b :: BackendType)
  = NQOCol (Column b)
  | NQOReferencedLogicalModel LogicalModelName
  deriving ((forall x. NativeQueryObjId b -> Rep (NativeQueryObjId b) x)
-> (forall x. Rep (NativeQueryObjId b) x -> NativeQueryObjId b)
-> Generic (NativeQueryObjId b)
forall x. Rep (NativeQueryObjId b) x -> NativeQueryObjId b
forall x. NativeQueryObjId b -> Rep (NativeQueryObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (NativeQueryObjId b) x -> NativeQueryObjId b
forall (b :: BackendType) x.
NativeQueryObjId b -> Rep (NativeQueryObjId b) x
$cfrom :: forall (b :: BackendType) x.
NativeQueryObjId b -> Rep (NativeQueryObjId b) x
from :: forall x. NativeQueryObjId b -> Rep (NativeQueryObjId b) x
$cto :: forall (b :: BackendType) x.
Rep (NativeQueryObjId b) x -> NativeQueryObjId b
to :: forall x. Rep (NativeQueryObjId b) x -> NativeQueryObjId b
Generic)

deriving instance (Backend b) => Eq (NativeQueryObjId b)

instance (Backend b) => Hashable (NativeQueryObjId b)

-- | Identifier for component of Stored Procedures within the metadata. These are
-- used to track dependencies between items in the resolved schema. For
-- instance, we use `SPOCol` along with `TOCol` from `TableObjId` to ensure
-- that the two columns that join an array relationship actually exist.
newtype StoredProcedureObjId (b :: BackendType)
  = SPOCol (Column b)
  deriving ((forall x.
 StoredProcedureObjId b -> Rep (StoredProcedureObjId b) x)
-> (forall x.
    Rep (StoredProcedureObjId b) x -> StoredProcedureObjId b)
-> Generic (StoredProcedureObjId b)
forall x. Rep (StoredProcedureObjId b) x -> StoredProcedureObjId b
forall x. StoredProcedureObjId b -> Rep (StoredProcedureObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (StoredProcedureObjId b) x -> StoredProcedureObjId b
forall (b :: BackendType) x.
StoredProcedureObjId b -> Rep (StoredProcedureObjId b) x
$cfrom :: forall (b :: BackendType) x.
StoredProcedureObjId b -> Rep (StoredProcedureObjId b) x
from :: forall x. StoredProcedureObjId b -> Rep (StoredProcedureObjId b) x
$cto :: forall (b :: BackendType) x.
Rep (StoredProcedureObjId b) x -> StoredProcedureObjId b
to :: forall x. Rep (StoredProcedureObjId b) x -> StoredProcedureObjId b
Generic)

deriving instance (Backend b) => Eq (StoredProcedureObjId b)

instance (Backend b) => Hashable (StoredProcedureObjId b)

data SourceObjId (b :: BackendType)
  = SOITable (TableName b)
  | SOITableObj (TableName b) (TableObjId b)
  | SOIFunction (FunctionName b)
  | SOINativeQuery NativeQueryName
  | SOINativeQueryObj NativeQueryName (NativeQueryObjId b)
  | SOIStoredProcedure (FunctionName b)
  | SOIStoredProcedureObj (FunctionName b) (StoredProcedureObjId b)
  | SOILogicalModel LogicalModelName
  | SOILogicalModelObj LogicalModelName (LogicalModelObjId b)
  deriving (SourceObjId b -> SourceObjId b -> Bool
(SourceObjId b -> SourceObjId b -> Bool)
-> (SourceObjId b -> SourceObjId b -> Bool) -> Eq (SourceObjId b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
SourceObjId b -> SourceObjId b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
SourceObjId b -> SourceObjId b -> Bool
== :: SourceObjId b -> SourceObjId b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
SourceObjId b -> SourceObjId b -> Bool
/= :: SourceObjId b -> SourceObjId b -> Bool
Eq, (forall x. SourceObjId b -> Rep (SourceObjId b) x)
-> (forall x. Rep (SourceObjId b) x -> SourceObjId b)
-> Generic (SourceObjId b)
forall x. Rep (SourceObjId b) x -> SourceObjId b
forall x. SourceObjId b -> Rep (SourceObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (SourceObjId b) x -> SourceObjId b
forall (b :: BackendType) x. SourceObjId b -> Rep (SourceObjId b) x
$cfrom :: forall (b :: BackendType) x. SourceObjId b -> Rep (SourceObjId b) x
from :: forall x. SourceObjId b -> Rep (SourceObjId b) x
$cto :: forall (b :: BackendType) x. Rep (SourceObjId b) x -> SourceObjId b
to :: forall x. Rep (SourceObjId b) x -> SourceObjId b
Generic)

instance (Backend b) => Hashable (SourceObjId b)

data SchemaObjId
  = SOSource SourceName
  | SOSourceObj SourceName (AB.AnyBackend SourceObjId)
  | SORemoteSchema RemoteSchemaName
  | SORemoteSchemaPermission RemoteSchemaName RoleName
  | -- | A remote relationship on a remote schema type, identified by
    -- 1. remote schema name
    -- 2. remote schema type on which the relationship is defined
    -- 3. name of the relationship
    SORemoteSchemaRemoteRelationship RemoteSchemaName G.Name RelName
  | SORole RoleName
  deriving (SchemaObjId -> SchemaObjId -> Bool
(SchemaObjId -> SchemaObjId -> Bool)
-> (SchemaObjId -> SchemaObjId -> Bool) -> Eq SchemaObjId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaObjId -> SchemaObjId -> Bool
== :: SchemaObjId -> SchemaObjId -> Bool
$c/= :: SchemaObjId -> SchemaObjId -> Bool
/= :: SchemaObjId -> SchemaObjId -> Bool
Eq, (forall x. SchemaObjId -> Rep SchemaObjId x)
-> (forall x. Rep SchemaObjId x -> SchemaObjId)
-> Generic SchemaObjId
forall x. Rep SchemaObjId x -> SchemaObjId
forall x. SchemaObjId -> Rep SchemaObjId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaObjId -> Rep SchemaObjId x
from :: forall x. SchemaObjId -> Rep SchemaObjId x
$cto :: forall x. Rep SchemaObjId x -> SchemaObjId
to :: forall x. Rep SchemaObjId x -> SchemaObjId
Generic)

instance Hashable SchemaObjId

reportSchemaObj :: SchemaObjId -> T.Text
reportSchemaObj :: SchemaObjId -> Text
reportSchemaObj = \case
  SOSource SourceName
source -> Text
"source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
source
  SOSourceObj SourceName
source AnyBackend SourceObjId
exists -> SourceName -> Text -> Text
forall {t}. ToTxt t => t -> Text -> Text
inSource SourceName
source
    (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend
      AnyBackend SourceObjId
exists
      \case
        SOITable TableName b
tn -> Text
"table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn
        SOIFunction FunctionName b
fn -> Text
"function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName b -> Text
forall a. ToTxt a => a -> Text
toTxt FunctionName b
fn
        SOINativeQuery NativeQueryName
nqn -> Text
"native query " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NativeQueryName -> Text
forall a. ToTxt a => a -> Text
toTxt NativeQueryName
nqn
        SOINativeQueryObj NativeQueryName
nqn (NQOCol Column b
cn) ->
          Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NativeQueryName -> Text
forall a. ToTxt a => a -> Text
toTxt NativeQueryName
nqn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b -> Text
forall a. ToTxt a => a -> Text
toTxt Column b
cn
        SOINativeQueryObj NativeQueryName
nqn (NQOReferencedLogicalModel LogicalModelName
inner) ->
          Text
"inner logical model " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NativeQueryName -> Text
forall a. ToTxt a => a -> Text
toTxt NativeQueryName
nqn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
inner
        SOIStoredProcedure FunctionName b
spn -> Text
"stored procedure " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName b -> Text
forall a. ToTxt a => a -> Text
toTxt FunctionName b
spn
        SOIStoredProcedureObj FunctionName b
spn (SPOCol Column b
cn) ->
          Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName b -> Text
forall a. ToTxt a => a -> Text
toTxt FunctionName b
spn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b -> Text
forall a. ToTxt a => a -> Text
toTxt Column b
cn
        SOILogicalModel LogicalModelName
lm -> Text
"logical model " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
lm
        SOILogicalModelObj LogicalModelName
lm (LMOCol Column b
cn) ->
          Text
"logical model column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
lm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b -> Text
forall a. ToTxt a => a -> Text
toTxt Column b
cn
        SOILogicalModelObj LogicalModelName
lm (LMOPerm RoleName
rn PermType
pt) ->
          Text
"permission " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
lm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
roleNameToTxt RoleName
rn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PermType -> Text
permTypeToCode PermType
pt
        SOILogicalModelObj LogicalModelName
lm (LMOReferencedLogicalModel LogicalModelName
inner) ->
          Text
"inner logical model " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
lm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
inner
        SOITableObj TableName b
tn (TOCol Column b
cn) ->
          Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column b -> Text
forall a. ToTxt a => a -> Text
toTxt Column b
cn
        SOITableObj TableName b
tn (TORel RelName
cn) ->
          Text
"relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
cn
        SOITableObj TableName b
tn (TOForeignKey ConstraintName b
cn) ->
          Text
"constraint " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConstraintName b -> Text
forall a. ToTxt a => a -> Text
toTxt ConstraintName b
cn
        SOITableObj TableName b
tn (TOPerm RoleName
rn PermType
pt) ->
          Text
"permission " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
roleNameToTxt RoleName
rn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PermType -> Text
permTypeToCode PermType
pt
        SOITableObj TableName b
tn (TOTrigger TriggerName
trn) ->
          Text
"event-trigger " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TriggerName -> Text
triggerNameToTxt TriggerName
trn
        SOITableObj TableName b
tn (TOComputedField ComputedFieldName
ccn) ->
          Text
"computed field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName -> Text
computedFieldNameToText ComputedFieldName
ccn
        SOITableObj TableName b
tn (TORemoteRel RelName
rn) ->
          Text
"remote relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
tn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName -> Text
relNameToTxt RelName
rn
  SORemoteSchema RemoteSchemaName
remoteSchemaName ->
    Text
"remote schema " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmptyText -> Text
unNonEmptyText (RemoteSchemaName -> NonEmptyText
unRemoteSchemaName RemoteSchemaName
remoteSchemaName)
  SORemoteSchemaPermission RemoteSchemaName
remoteSchemaName RoleName
roleName ->
    Text
"remote schema permission "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmptyText -> Text
unNonEmptyText (RemoteSchemaName -> NonEmptyText
unRemoteSchemaName RemoteSchemaName
remoteSchemaName)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      Text -> RoleName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RoleName
roleName
  SORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName ->
    Text
"remote_relationship "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
relationshipName
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
typeName
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in remote schema "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName -> Text
forall a. ToTxt a => a -> Text
toTxt RemoteSchemaName
remoteSchemaName
  SORole RoleName
roleName -> Text
"role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
roleNameToTxt RoleName
roleName
  where
    inSource :: t -> Text -> Text
inSource t
s Text
t = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source " Text -> t -> Text
forall t. ToTxt t => Text -> t -> Text
<>> t
s

reportSchemaObjs :: [SchemaObjId] -> Text
reportSchemaObjs :: [SchemaObjId] -> Text
reportSchemaObjs = [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([Text] -> Text)
-> ([SchemaObjId] -> [Text]) -> [SchemaObjId] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text])
-> ([SchemaObjId] -> [Text]) -> [SchemaObjId] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaObjId -> Text) -> [SchemaObjId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SchemaObjId -> Text
reportSchemaObj

instance Show SchemaObjId where
  show :: SchemaObjId -> String
show SchemaObjId
soi = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SchemaObjId -> Text
reportSchemaObj SchemaObjId
soi

instance ToJSON SchemaObjId where
  toJSON :: SchemaObjId -> Value
toJSON = Text -> Value
String (Text -> Value) -> (SchemaObjId -> Text) -> SchemaObjId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaObjId -> Text
reportSchemaObj

instance ToJSONKey SchemaObjId where
  toJSONKey :: ToJSONKeyFunction SchemaObjId
toJSONKey = (SchemaObjId -> Text) -> ToJSONKeyFunction SchemaObjId
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText SchemaObjId -> Text
reportSchemaObj

data DependencyReason
  = DRTable
  | DRColumn
  | DRRemoteTable
  | DRLeftColumn
  | DRRightColumn
  | DRUsingColumn
  | DRFkey
  | DRRemoteFkey
  | DRUntyped
  | DROnType
  | DRSessionVariable
  | DRPayload
  | DRParent
  | DRRemoteSchema
  | DRRemoteRelationship
  | DRParentRole
  | DRLogicalModel
  | DRReferencedLogicalModel
  deriving (Int -> DependencyReason -> ShowS
[DependencyReason] -> ShowS
DependencyReason -> String
(Int -> DependencyReason -> ShowS)
-> (DependencyReason -> String)
-> ([DependencyReason] -> ShowS)
-> Show DependencyReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DependencyReason -> ShowS
showsPrec :: Int -> DependencyReason -> ShowS
$cshow :: DependencyReason -> String
show :: DependencyReason -> String
$cshowList :: [DependencyReason] -> ShowS
showList :: [DependencyReason] -> ShowS
Show, DependencyReason -> DependencyReason -> Bool
(DependencyReason -> DependencyReason -> Bool)
-> (DependencyReason -> DependencyReason -> Bool)
-> Eq DependencyReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DependencyReason -> DependencyReason -> Bool
== :: DependencyReason -> DependencyReason -> Bool
$c/= :: DependencyReason -> DependencyReason -> Bool
/= :: DependencyReason -> DependencyReason -> Bool
Eq, (forall x. DependencyReason -> Rep DependencyReason x)
-> (forall x. Rep DependencyReason x -> DependencyReason)
-> Generic DependencyReason
forall x. Rep DependencyReason x -> DependencyReason
forall x. DependencyReason -> Rep DependencyReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DependencyReason -> Rep DependencyReason x
from :: forall x. DependencyReason -> Rep DependencyReason x
$cto :: forall x. Rep DependencyReason x -> DependencyReason
to :: forall x. Rep DependencyReason x -> DependencyReason
Generic)

instance Hashable DependencyReason

reasonToTxt :: DependencyReason -> Text
reasonToTxt :: DependencyReason -> Text
reasonToTxt = \case
  DependencyReason
DRTable -> Text
"table"
  DependencyReason
DRColumn -> Text
"column"
  DependencyReason
DRRemoteTable -> Text
"remote_table"
  DependencyReason
DRLeftColumn -> Text
"left_column"
  DependencyReason
DRRightColumn -> Text
"right_column"
  DependencyReason
DRUsingColumn -> Text
"using_column"
  DependencyReason
DRFkey -> Text
"fkey"
  DependencyReason
DRRemoteFkey -> Text
"remote_fkey"
  DependencyReason
DRUntyped -> Text
"untyped"
  DependencyReason
DROnType -> Text
"on_type"
  DependencyReason
DRSessionVariable -> Text
"session_variable"
  DependencyReason
DRPayload -> Text
"payload"
  DependencyReason
DRParent -> Text
"parent"
  DependencyReason
DRRemoteSchema -> Text
"remote_schema"
  DependencyReason
DRRemoteRelationship -> Text
"remote_relationship"
  DependencyReason
DRParentRole -> Text
"parent_role"
  DependencyReason
DRLogicalModel -> Text
"logical_model"
  DependencyReason
DRReferencedLogicalModel -> Text
"inner_logical_model"

instance ToJSON DependencyReason where
  toJSON :: DependencyReason -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (DependencyReason -> Text) -> DependencyReason -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyReason -> Text
reasonToTxt

data SchemaDependency = SchemaDependency
  { SchemaDependency -> SchemaObjId
sdObjId :: SchemaObjId,
    SchemaDependency -> DependencyReason
sdReason :: DependencyReason
  }
  deriving (Int -> SchemaDependency -> ShowS
[SchemaDependency] -> ShowS
SchemaDependency -> String
(Int -> SchemaDependency -> ShowS)
-> (SchemaDependency -> String)
-> ([SchemaDependency] -> ShowS)
-> Show SchemaDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaDependency -> ShowS
showsPrec :: Int -> SchemaDependency -> ShowS
$cshow :: SchemaDependency -> String
show :: SchemaDependency -> String
$cshowList :: [SchemaDependency] -> ShowS
showList :: [SchemaDependency] -> ShowS
Show, SchemaDependency -> SchemaDependency -> Bool
(SchemaDependency -> SchemaDependency -> Bool)
-> (SchemaDependency -> SchemaDependency -> Bool)
-> Eq SchemaDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaDependency -> SchemaDependency -> Bool
== :: SchemaDependency -> SchemaDependency -> Bool
$c/= :: SchemaDependency -> SchemaDependency -> Bool
/= :: SchemaDependency -> SchemaDependency -> Bool
Eq, (forall x. SchemaDependency -> Rep SchemaDependency x)
-> (forall x. Rep SchemaDependency x -> SchemaDependency)
-> Generic SchemaDependency
forall x. Rep SchemaDependency x -> SchemaDependency
forall x. SchemaDependency -> Rep SchemaDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaDependency -> Rep SchemaDependency x
from :: forall x. SchemaDependency -> Rep SchemaDependency x
$cto :: forall x. Rep SchemaDependency x -> SchemaDependency
to :: forall x. Rep SchemaDependency x -> SchemaDependency
Generic)

instance ToJSON SchemaDependency where
  toJSON :: SchemaDependency -> Value
toJSON = Options -> SchemaDependency -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: SchemaDependency -> Encoding
toEncoding = Options -> SchemaDependency -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

instance Hashable SchemaDependency

reportDependentObjectsExist :: (MonadError QErr m) => [SchemaObjId] -> m ()
reportDependentObjectsExist :: forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
dependentObjects =
  Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DependencyError
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"cannot drop due to the following dependent objects: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [SchemaObjId] -> Text
reportSchemaObjs [SchemaObjId]
dependentObjects

purgeSourceAndSchemaDependencies ::
  (MonadError QErr m) =>
  SchemaObjId ->
  WriterT MetadataModifier m ()
purgeSourceAndSchemaDependencies :: forall (m :: * -> *).
MonadError QErr m =>
SchemaObjId -> WriterT MetadataModifier m ()
purgeSourceAndSchemaDependencies = \case
  SOSourceObj SourceName
sourceName AnyBackend SourceObjId
objectID -> do
    forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend SourceObjId
objectID ((forall (b :: BackendType).
  Backend b =>
  SourceObjId b -> WriterT MetadataModifier m ())
 -> WriterT MetadataModifier m ())
-> (forall (b :: BackendType).
    Backend b =>
    SourceObjId b -> WriterT MetadataModifier m ())
-> WriterT MetadataModifier m ()
forall a b. (a -> b) -> a -> b
$ SourceName
-> SourceObjId b -> WriterT MetadataModifier m MetadataModifier
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, Backend b) =>
SourceName -> SourceObjId b -> m MetadataModifier
purgeDependentObject SourceName
sourceName (SourceObjId b -> WriterT MetadataModifier m MetadataModifier)
-> (MetadataModifier -> WriterT MetadataModifier m ())
-> SourceObjId b
-> WriterT MetadataModifier m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MetadataModifier -> WriterT MetadataModifier m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  SORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName -> do
    MetadataModifier -> WriterT MetadataModifier m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (MetadataModifier -> WriterT MetadataModifier m ())
-> MetadataModifier -> WriterT MetadataModifier m ()
forall a b. (a -> b) -> a -> b
$ RemoteSchemaName -> Name -> RelName -> MetadataModifier
dropRemoteSchemaRemoteRelationshipInMetadata RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName
  SchemaObjId
_ ->
    () -> WriterT MetadataModifier m ()
forall a. a -> WriterT MetadataModifier m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

purgeDependentObject ::
  forall b m.
  (MonadError QErr m, Backend b) =>
  SourceName ->
  SourceObjId b ->
  m MetadataModifier
purgeDependentObject :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, Backend b) =>
SourceName -> SourceObjId b -> m MetadataModifier
purgeDependentObject SourceName
source SourceObjId b
sourceObjId = case SourceObjId b
sourceObjId of
  SOITableObj TableName b
tn TableObjId b
tableObj ->
    MetadataModifier -> m MetadataModifier
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (MetadataModifier -> m MetadataModifier)
-> MetadataModifier -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
      ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
tn
      ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case TableObjId b
tableObj of
        TOPerm RoleName
rn PermType
pt -> RoleName -> PermType -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
rn PermType
pt
        TORel RelName
rn -> RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata RelName
rn
        TOTrigger TriggerName
trn -> TriggerName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
TriggerName -> TableMetadata b -> TableMetadata b
dropEventTriggerInMetadata TriggerName
trn
        TOComputedField ComputedFieldName
ccn -> ComputedFieldName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata ComputedFieldName
ccn
        TORemoteRel RelName
rrn -> RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRemoteRelationshipInMetadata RelName
rrn
        TableObjId b
_ -> TableMetadata b -> TableMetadata b
forall a. a -> a
id
  SOIFunction FunctionName b
qf -> MetadataModifier -> m MetadataModifier
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataModifier -> m MetadataModifier)
-> MetadataModifier -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
SourceName -> FunctionName b -> MetadataModifier
dropFunctionInMetadata @b SourceName
source FunctionName b
qf
  SourceObjId b
_ ->
    Text -> m MetadataModifier
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
      (Text -> m MetadataModifier) -> Text -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ Text
"unexpected dependent object: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SchemaObjId -> Text
reportSchemaObj (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
sourceObjId)

-- | Type class to collect schema dependencies from backend-specific aggregation predicates.
class (Backend b) => GetAggregationPredicatesDeps b where
  getAggregationPredicateDeps ::
    AggregationPredicates b (PartialSQLExp b) ->
    BoolExpM b [SchemaDependency]
  default getAggregationPredicateDeps ::
    (AggregationPredicates b ~ Const Void) =>
    AggregationPredicates b (PartialSQLExp b) ->
    BoolExpM b [SchemaDependency]
  getAggregationPredicateDeps = Void -> BoolExpM b [SchemaDependency]
forall a. Void -> a
absurd (Void -> BoolExpM b [SchemaDependency])
-> (Const Void (PartialSQLExp b) -> Void)
-> Const Void (PartialSQLExp b)
-> BoolExpM b [SchemaDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const Void (PartialSQLExp b) -> Void
forall {k} a (b :: k). Const a b -> a
getConst

-- | The monad for doing schema dependency discovery for boolean expressions.
-- maintains the table context of the expressions being translated.
newtype BoolExpM b a = BoolExpM {forall (b :: BackendType) a.
BoolExpM b a -> Reader (BoolExpCtx b) a
unBoolExpM :: Reader (BoolExpCtx b) a}
  deriving ((forall a b. (a -> b) -> BoolExpM b a -> BoolExpM b b)
-> (forall a b. a -> BoolExpM b b -> BoolExpM b a)
-> Functor (BoolExpM b)
forall a b. a -> BoolExpM b b -> BoolExpM b a
forall a b. (a -> b) -> BoolExpM b a -> BoolExpM b b
forall (b :: BackendType) a b. a -> BoolExpM b b -> BoolExpM b a
forall (b :: BackendType) a b.
(a -> b) -> BoolExpM b a -> BoolExpM b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (b :: BackendType) a b.
(a -> b) -> BoolExpM b a -> BoolExpM b b
fmap :: forall a b. (a -> b) -> BoolExpM b a -> BoolExpM b b
$c<$ :: forall (b :: BackendType) a b. a -> BoolExpM b b -> BoolExpM b a
<$ :: forall a b. a -> BoolExpM b b -> BoolExpM b a
Functor, Functor (BoolExpM b)
Functor (BoolExpM b)
-> (forall a. a -> BoolExpM b a)
-> (forall a b.
    BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b)
-> (forall a b c.
    (a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c)
-> (forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b)
-> (forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b a)
-> Applicative (BoolExpM b)
forall a. a -> BoolExpM b a
forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b a
forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall a b. BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
forall a b c.
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
forall (b :: BackendType). Functor (BoolExpM b)
forall (b :: BackendType) a. a -> BoolExpM b a
forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b a
forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall (b :: BackendType) a b.
BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
forall (b :: BackendType) a b c.
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (b :: BackendType) a. a -> BoolExpM b a
pure :: forall a. a -> BoolExpM b a
$c<*> :: forall (b :: BackendType) a b.
BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
<*> :: forall a b. BoolExpM b (a -> b) -> BoolExpM b a -> BoolExpM b b
$cliftA2 :: forall (b :: BackendType) a b c.
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
liftA2 :: forall a b c.
(a -> b -> c) -> BoolExpM b a -> BoolExpM b b -> BoolExpM b c
$c*> :: forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
*> :: forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b
$c<* :: forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b a
<* :: forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b a
Applicative, Applicative (BoolExpM b)
Applicative (BoolExpM b)
-> (forall a b.
    BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b)
-> (forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b)
-> (forall a. a -> BoolExpM b a)
-> Monad (BoolExpM b)
forall a. a -> BoolExpM b a
forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall a b. BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
forall (b :: BackendType). Applicative (BoolExpM b)
forall (b :: BackendType) a. a -> BoolExpM b a
forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
forall (b :: BackendType) a b.
BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (b :: BackendType) a b.
BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
>>= :: forall a b. BoolExpM b a -> (a -> BoolExpM b b) -> BoolExpM b b
$c>> :: forall (b :: BackendType) a b.
BoolExpM b a -> BoolExpM b b -> BoolExpM b b
>> :: forall a b. BoolExpM b a -> BoolExpM b b -> BoolExpM b b
$creturn :: forall (b :: BackendType) a. a -> BoolExpM b a
return :: forall a. a -> BoolExpM b a
Monad, MonadReader (BoolExpCtx b))

-- | The table type context of schema dependency discovery. Boolean expressions
-- may refer to a so-called 'root table' (identified by a '$'-sign in the
-- expression input syntax) or the 'current' table.
data BoolExpCtx b = BoolExpCtx
  { forall (b :: BackendType). BoolExpCtx b -> SourceName
source :: SourceName,
    -- | Reference to the 'current' table type.
    forall (b :: BackendType). BoolExpCtx b -> TableName b
currTable :: TableName b,
    -- | Reference to the 'root' table type.
    forall (b :: BackendType). BoolExpCtx b -> TableName b
rootTable :: TableName b
  }

runBoolExpM :: BoolExpCtx b -> BoolExpM b a -> a
runBoolExpM :: forall (b :: BackendType) a. BoolExpCtx b -> BoolExpM b a -> a
runBoolExpM BoolExpCtx b
ctx = (Reader (BoolExpCtx b) a -> BoolExpCtx b -> a)
-> BoolExpCtx b -> Reader (BoolExpCtx b) a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader (BoolExpCtx b) a -> BoolExpCtx b -> a
forall r a. Reader r a -> r -> a
runReader BoolExpCtx b
ctx (Reader (BoolExpCtx b) a -> a)
-> (BoolExpM b a -> Reader (BoolExpCtx b) a) -> BoolExpM b a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolExpM b a -> Reader (BoolExpCtx b) a
forall (b :: BackendType) a.
BoolExpM b a -> Reader (BoolExpCtx b) a
unBoolExpM