module Hasura.RQL.DDL.Endpoint
  ( runCreateEndpoint,
    runDropEndpoint,
    dropEndpointInMetadata,
  )
where

import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.SchemaCache.Build

runCreateEndpoint ::
  ( MonadError QErr m,
    CacheRWM m,
    MetadataM m
  ) =>
  CreateEndpoint ->
  m EncJSON
runCreateEndpoint :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
CreateEndpoint -> m EncJSON
runCreateEndpoint endpoint :: CreateEndpoint
endpoint@EndpointMetadata {Maybe Text
NonEmpty EndpointMethod
EndpointUrl
EndpointName
EndpointDef QueryReference
_ceName :: EndpointName
_ceUrl :: EndpointUrl
_ceMethods :: NonEmpty EndpointMethod
_ceDefinition :: EndpointDef QueryReference
_ceComment :: Maybe Text
_ceName :: forall query. EndpointMetadata query -> EndpointName
_ceUrl :: forall query. EndpointMetadata query -> EndpointUrl
_ceMethods :: forall query. EndpointMetadata query -> NonEmpty EndpointMethod
_ceDefinition :: forall query. EndpointMetadata query -> EndpointDef query
_ceComment :: forall query. EndpointMetadata query -> Maybe Text
..} = do
  Endpoints
endpointsMap <- Metadata -> Endpoints
_metaRestEndpoints (Metadata -> Endpoints) -> m Metadata -> m Endpoints
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

  EndpointName -> Endpoints -> Maybe CreateEndpoint
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup EndpointName
_ceName Endpoints
endpointsMap Maybe CreateEndpoint -> (CreateEndpoint -> m Any) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
`for_` \CreateEndpoint
_ ->
    Code -> Text -> m Any
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
      (Text -> m Any) -> Text -> m Any
forall a b. (a -> b) -> a -> b
$ Text
"Endpoint with name: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EndpointName -> Text
forall a. ToTxt a => a -> Text
toTxt EndpointName
_ceName
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists"

  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
$ MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (EndpointName -> MetadataObjId
MOEndpoint EndpointName
_ceName)
    (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
$ (Endpoints -> Identity Endpoints) -> Metadata -> Identity Metadata
Lens' Metadata Endpoints
metaRestEndpoints
    ((Endpoints -> Identity Endpoints)
 -> Metadata -> Identity Metadata)
-> (Endpoints -> Endpoints) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ EndpointName -> CreateEndpoint -> Endpoints -> Endpoints
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert EndpointName
_ceName CreateEndpoint
endpoint
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

runDropEndpoint ::
  ( MonadError QErr m,
    CacheRWM m,
    MetadataM m
  ) =>
  DropEndpoint ->
  m EncJSON
runDropEndpoint :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
DropEndpoint -> m EncJSON
runDropEndpoint DropEndpoint {EndpointName
_deName :: EndpointName
_deName :: DropEndpoint -> EndpointName
..} = do
  EndpointName -> m ()
forall (m :: * -> *).
(MetadataM m, MonadError QErr m) =>
EndpointName -> m ()
checkExists EndpointName
_deName
  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
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ EndpointName -> MetadataModifier
dropEndpointInMetadata EndpointName
_deName
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

dropEndpointInMetadata :: EndpointName -> MetadataModifier
dropEndpointInMetadata :: EndpointName -> MetadataModifier
dropEndpointInMetadata EndpointName
name =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Endpoints -> Identity Endpoints) -> Metadata -> Identity Metadata
Lens' Metadata Endpoints
metaRestEndpoints ((Endpoints -> Identity Endpoints)
 -> Metadata -> Identity Metadata)
-> (Endpoints -> Endpoints) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ EndpointName -> Endpoints -> Endpoints
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete EndpointName
name

checkExists :: (MetadataM m, MonadError QErr m) => EndpointName -> m ()
checkExists :: forall (m :: * -> *).
(MetadataM m, MonadError QErr m) =>
EndpointName -> m ()
checkExists EndpointName
name = do
  Endpoints
endpointsMap <- Metadata -> Endpoints
_metaRestEndpoints (Metadata -> Endpoints) -> m Metadata -> m Endpoints
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  m CreateEndpoint -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (m CreateEndpoint -> m ()) -> m CreateEndpoint -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe CreateEndpoint -> m CreateEndpoint -> m CreateEndpoint
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (EndpointName -> Endpoints -> Maybe CreateEndpoint
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup EndpointName
name Endpoints
endpointsMap)
    (m CreateEndpoint -> m CreateEndpoint)
-> m CreateEndpoint -> m CreateEndpoint
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m CreateEndpoint
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m CreateEndpoint) -> Text -> m CreateEndpoint
forall a b. (a -> b) -> a -> b
$ Text
"endpoint with name: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EndpointName -> Text
forall a. ToTxt a => a -> Text
toTxt EndpointName
name
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist"