module Hasura.RQL.DDL.Relationship.Rename
  ( RenameRel,
    runRenameRel,
  )
where

import Data.Aeson
import Data.HashMap.Strict qualified as HashMap
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Schema (renameRelationshipInMetadata)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.Table.Cache

data RenameRel b = RenameRel
  { forall (b :: BackendType). RenameRel b -> SourceName
_rrSource :: SourceName,
    forall (b :: BackendType). RenameRel b -> TableName b
_rrTable :: TableName b,
    forall (b :: BackendType). RenameRel b -> RelName
_rrName :: RelName,
    forall (b :: BackendType). RenameRel b -> RelName
_rrNewName :: RelName
  }

instance (Backend b) => FromJSON (RenameRel b) where
  parseJSON :: Value -> Parser (RenameRel b)
parseJSON = String
-> (Object -> Parser (RenameRel b))
-> Value
-> Parser (RenameRel b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RenameRel" ((Object -> Parser (RenameRel b)) -> Value -> Parser (RenameRel b))
-> (Object -> Parser (RenameRel b))
-> Value
-> Parser (RenameRel b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> TableName b -> RelName -> RelName -> RenameRel b
forall (b :: BackendType).
SourceName -> TableName b -> RelName -> RelName -> RenameRel b
RenameRel
      (SourceName -> TableName b -> RelName -> RelName -> RenameRel b)
-> Parser SourceName
-> Parser (TableName b -> RelName -> RelName -> RenameRel 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 -> RelName -> RelName -> RenameRel b)
-> Parser (TableName b)
-> Parser (RelName -> RelName -> RenameRel b)
forall a b. Parser (a -> b) -> Parser a -> Parser 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 (RelName -> RelName -> RenameRel b)
-> Parser RelName -> Parser (RelName -> RenameRel b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (RelName -> RenameRel b)
-> Parser RelName -> Parser (RenameRel b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"new_name"

renameRelP2 ::
  forall b m.
  (QErrM m, CacheRM m, BackendMetadata b) =>
  SourceName ->
  TableName b ->
  RelName ->
  RelInfo b ->
  m MetadataModifier
renameRelP2 :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, BackendMetadata b) =>
SourceName
-> TableName b -> RelName -> RelInfo b -> m MetadataModifier
renameRelP2 SourceName
source TableName b
qt RelName
newRN RelInfo b
relInfo = m MetadataModifier -> m MetadataModifier
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m MetadataModifier -> m MetadataModifier)
-> m MetadataModifier -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ do
  TableCoreInfo b
tabInfo <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
qt
  -- check for conflicts in fieldInfoMap
  case FieldName -> HashMap FieldName (FieldInfo b) -> Maybe (FieldInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (RelName -> FieldName
fromRel RelName
newRN) (HashMap FieldName (FieldInfo b) -> Maybe (FieldInfo b))
-> HashMap FieldName (FieldInfo b) -> Maybe (FieldInfo b)
forall a b. (a -> b) -> a -> b
$ TableCoreInfo b -> HashMap FieldName (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tabInfo of
    Maybe (FieldInfo b)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just FieldInfo b
_ ->
      Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
        (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"cannot rename relationship "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
oldRN
        RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" to "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
newRN
        RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in table "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
qt
        TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" as a column/relationship with the name already exists"
  -- update metadata
  WriterT MetadataModifier m () -> m MetadataModifier
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT MetadataModifier m () -> m MetadataModifier)
-> WriterT MetadataModifier m () -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRM m, MonadWriter MetadataModifier m,
 BackendMetadata b) =>
SourceName -> TableName b -> RelName -> RelType -> RelName -> m ()
renameRelationshipInMetadata @b SourceName
source TableName b
qt RelName
oldRN (RelInfo b -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType RelInfo b
relInfo) RelName
newRN
  where
    oldRN :: RelName
oldRN = RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
relInfo

runRenameRel ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  RenameRel b ->
  m EncJSON
runRenameRel :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
RenameRel b -> m EncJSON
runRenameRel (RenameRel SourceName
source TableName b
qt RelName
rn RelName
newRN) = do
  TableCoreInfo b
tabInfo <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
qt
  RelInfo b
ri <- FieldInfoMap (FieldInfo b) -> RelName -> Text -> m (RelInfo b)
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType (TableCoreInfo b -> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tabInfo) RelName
rn Text
""
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ SourceName
-> TableName b -> RelName -> RelInfo b -> m MetadataModifier
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, BackendMetadata b) =>
SourceName
-> TableName b -> RelName -> RelInfo b -> m MetadataModifier
renameRelP2 SourceName
source TableName b
qt RelName
newRN RelInfo b
ri
    m MetadataModifier -> (MetadataModifier -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg