module Hasura.RQL.DDL.QueryCollection
  ( runCreateCollection,
    runRenameCollection,
    runDropCollection,
    runAddQueryToCollection,
    runDropQueryFromCollection,
    runAddCollectionToAllowlist,
    runDropCollectionFromAllowlist,
    runUpdateScopeOfCollectionInAllowlist,
  )
where

import Control.Lens ((.~))
import Data.Aeson qualified as J
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.List.Extended (duplicates)
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.SchemaCache.Build

addCollectionP2 ::
  (QErrM m) =>
  CollectionDef ->
  m ()
addCollectionP2 :: forall (m :: * -> *). QErrM m => CollectionDef -> m ()
addCollectionP2 (CollectionDef [ListedQuery]
queryList) =
  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"queries"
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet QueryName -> Bool
forall a. HashSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet QueryName
duplicateNames)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"found duplicate query names "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList (NonEmptyText -> Text
unNonEmptyText (NonEmptyText -> Text)
-> (QueryName -> NonEmptyText) -> QueryName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryName -> NonEmptyText
unQueryName (QueryName -> Text) -> [QueryName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet QueryName -> [QueryName]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet QueryName
duplicateNames)
  where
    duplicateNames :: HashSet QueryName
duplicateNames = [QueryName] -> HashSet QueryName
forall a. Hashable a => [a] -> HashSet a
duplicates ([QueryName] -> HashSet QueryName)
-> [QueryName] -> HashSet QueryName
forall a b. (a -> b) -> a -> b
$ (ListedQuery -> QueryName) -> [ListedQuery] -> [QueryName]
forall a b. (a -> b) -> [a] -> [b]
map ListedQuery -> QueryName
_lqName [ListedQuery]
queryList

runCreateCollection ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  CreateCollection ->
  m EncJSON
runCreateCollection :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
CreateCollection -> m EncJSON
runCreateCollection CreateCollection
cc = do
  Maybe CreateCollection
collDetM <- CollectionName -> m (Maybe CreateCollection)
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m (Maybe CreateCollection)
getCollectionDefM CollectionName
collName
  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"name"
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe CreateCollection -> (CreateCollection -> m Any) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe CreateCollection
collDetM
    ((CreateCollection -> m Any) -> m ())
-> (CreateCollection -> m Any) -> m ()
forall a b. (a -> b) -> a -> b
$ m Any -> CreateCollection -> m Any
forall a b. a -> b -> a
const
    (m Any -> CreateCollection -> m Any)
-> m Any -> CreateCollection -> m Any
forall a b. (a -> b) -> a -> b
$ 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
"query collection with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName
collName
    CollectionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists"
  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"definition" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionDef -> m ()
forall (m :: * -> *). QErrM m => CollectionDef -> m ()
addCollectionP2 CollectionDef
def
  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
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (QueryCollections -> Identity QueryCollections)
-> Metadata -> Identity Metadata
Lens' Metadata QueryCollections
metaQueryCollections
    ((QueryCollections -> Identity QueryCollections)
 -> Metadata -> Identity Metadata)
-> (QueryCollections -> QueryCollections) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CollectionName
-> CreateCollection -> QueryCollections -> QueryCollections
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert CollectionName
collName CreateCollection
cc
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg
  where
    CreateCollection CollectionName
collName CollectionDef
def Maybe Text
_ = CreateCollection
cc

runRenameCollection ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  RenameCollection ->
  m EncJSON
runRenameCollection :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
RenameCollection -> m EncJSON
runRenameCollection (RenameCollection CollectionName
oldName CollectionName
newName) = do
  CreateCollection
_ <- CollectionName -> m CreateCollection
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m CreateCollection
getCollectionDef CollectionName
oldName
  Maybe CreateCollection
newCollDefM <- CollectionName -> m (Maybe CreateCollection)
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m (Maybe CreateCollection)
getCollectionDefM CollectionName
newName
  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"new_name"
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe CreateCollection -> (CreateCollection -> m Any) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe CreateCollection
newCollDefM
    ((CreateCollection -> m Any) -> m ())
-> (CreateCollection -> m Any) -> m ()
forall a b. (a -> b) -> a -> b
$ m Any -> CreateCollection -> m Any
forall a b. a -> b -> a
const
    (m Any -> CreateCollection -> m Any)
-> m Any -> CreateCollection -> m Any
forall a b. (a -> b) -> a -> b
$ 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
"query collection with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName
newName
    CollectionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> 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
$ 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
$ (QueryCollections -> Identity QueryCollections)
-> Metadata -> Identity Metadata
Lens' Metadata QueryCollections
metaQueryCollections
    ((QueryCollections -> Identity QueryCollections)
 -> Metadata -> Identity Metadata)
-> (QueryCollections -> QueryCollections) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CollectionName
-> CollectionName -> QueryCollections -> QueryCollections
changeCollectionName CollectionName
oldName CollectionName
newName
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg
  where
    changeCollectionName :: CollectionName -> CollectionName -> QueryCollections -> QueryCollections
    changeCollectionName :: CollectionName
-> CollectionName -> QueryCollections -> QueryCollections
changeCollectionName CollectionName
oldKey CollectionName
newKey QueryCollections
oMap = case CollectionName -> QueryCollections -> Maybe CreateCollection
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup CollectionName
oldKey QueryCollections
oMap of
      Maybe CreateCollection
Nothing -> QueryCollections
oMap
      Just CreateCollection
oldVal ->
        let newVal :: CreateCollection
newVal = CreateCollection
oldVal CreateCollection
-> (CreateCollection -> CreateCollection) -> CreateCollection
forall a b. a -> (a -> b) -> b
& (CollectionName -> Identity CollectionName)
-> CreateCollection -> Identity CreateCollection
Lens' CreateCollection CollectionName
ccName ((CollectionName -> Identity CollectionName)
 -> CreateCollection -> Identity CreateCollection)
-> CollectionName -> CreateCollection -> CreateCollection
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CollectionName
newKey
         in CollectionName
-> CreateCollection -> QueryCollections -> QueryCollections
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert CollectionName
newKey CreateCollection
newVal (CollectionName -> QueryCollections -> QueryCollections
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete CollectionName
oldKey QueryCollections
oMap)

runAddQueryToCollection ::
  (CacheRWM m, MonadError QErr m, MetadataM m) =>
  AddQueryToCollection ->
  m EncJSON
runAddQueryToCollection :: forall (m :: * -> *).
(CacheRWM m, MonadError QErr m, MetadataM m) =>
AddQueryToCollection -> m EncJSON
runAddQueryToCollection (AddQueryToCollection CollectionName
collName QueryName
queryName GQLQueryWithText
query) = do
  (CreateCollection CollectionName
_ (CollectionDef [ListedQuery]
qList) Maybe Text
comment) <- CollectionName -> m CreateCollection
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m CreateCollection
getCollectionDef CollectionName
collName
  let queryExists :: Bool
queryExists = ((ListedQuery -> Bool) -> [ListedQuery] -> Bool)
-> [ListedQuery] -> (ListedQuery -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ListedQuery -> Bool) -> [ListedQuery] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [ListedQuery]
qList ((ListedQuery -> Bool) -> Bool) -> (ListedQuery -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \ListedQuery
q -> ListedQuery -> QueryName
_lqName ListedQuery
q QueryName -> QueryName -> Bool
forall a. Eq a => a -> a -> Bool
== QueryName
queryName

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
queryExists
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> 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
"query with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryName
queryName
    QueryName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists in collection "
    Text -> CollectionName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> CollectionName
collName
  let collDef :: CollectionDef
collDef = [ListedQuery] -> CollectionDef
CollectionDef ([ListedQuery] -> CollectionDef) -> [ListedQuery] -> CollectionDef
forall a b. (a -> b) -> a -> b
$ [ListedQuery]
qList [ListedQuery] -> [ListedQuery] -> [ListedQuery]
forall a. Semigroup a => a -> a -> a
<> ListedQuery -> [ListedQuery]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListedQuery
listQ
  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
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (QueryCollections -> Identity QueryCollections)
-> Metadata -> Identity Metadata
Lens' Metadata QueryCollections
metaQueryCollections
    ((QueryCollections -> Identity QueryCollections)
 -> Metadata -> Identity Metadata)
-> (QueryCollections -> QueryCollections) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CollectionName
-> CreateCollection -> QueryCollections -> QueryCollections
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert CollectionName
collName (CollectionName -> CollectionDef -> Maybe Text -> CreateCollection
CreateCollection CollectionName
collName CollectionDef
collDef Maybe Text
comment)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg
  where
    listQ :: ListedQuery
listQ = QueryName -> GQLQueryWithText -> ListedQuery
ListedQuery QueryName
queryName GQLQueryWithText
query

runDropCollection ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  DropCollection ->
  m EncJSON
runDropCollection :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m) =>
DropCollection -> m EncJSON
runDropCollection (DropCollection CollectionName
collName Bool
cascade) = do
  MetadataModifier
cascadeModifier <- Text -> m MetadataModifier -> m MetadataModifier
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"collection" (m MetadataModifier -> m MetadataModifier)
-> m MetadataModifier -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ do
    CollectionName -> m ()
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m ()
assertCollectionDefined CollectionName
collName
    [CollectionName]
allowlist <- m [CollectionName]
forall (m :: * -> *). MetadataM m => m [CollectionName]
fetchAllAllowlistCollections
    if (CollectionName
collName CollectionName -> [CollectionName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CollectionName]
allowlist)
      then
        if Bool -> Bool
not Bool
cascade
          then
            Code -> Text -> m MetadataModifier
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DependencyError
              (Text -> m MetadataModifier) -> Text -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ Text
"query collection with name "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName
collName
              CollectionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is present in the allowlist; cannot proceed to drop. "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"please use cascade to confirm you wish to drop it from the allowlist as well"
          else CollectionName -> m MetadataModifier
forall (m :: * -> *).
(MonadError QErr m, MetadataM m) =>
CollectionName -> m MetadataModifier
dropCollectionFromAllowlist CollectionName
collName
      else MetadataModifier -> m MetadataModifier
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataModifier
forall a. Monoid a => a
mempty

  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
$ MetadataModifier
cascadeModifier
    MetadataModifier -> MetadataModifier -> MetadataModifier
forall a. Semigroup a => a -> a -> a
<> (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((QueryCollections -> Identity QueryCollections)
-> Metadata -> Identity Metadata
Lens' Metadata QueryCollections
metaQueryCollections ((QueryCollections -> Identity QueryCollections)
 -> Metadata -> Identity Metadata)
-> (QueryCollections -> QueryCollections) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CollectionName -> QueryCollections -> QueryCollections
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete CollectionName
collName)

  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runDropQueryFromCollection ::
  (CacheRWM m, MonadError QErr m, MetadataM m) =>
  DropQueryFromCollection ->
  m EncJSON
runDropQueryFromCollection :: forall (m :: * -> *).
(CacheRWM m, MonadError QErr m, MetadataM m) =>
DropQueryFromCollection -> m EncJSON
runDropQueryFromCollection (DropQueryFromCollection CollectionName
collName QueryName
queryName) = do
  CreateCollection CollectionName
_ (CollectionDef [ListedQuery]
qList) Maybe Text
_ <- CollectionName -> m CreateCollection
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m CreateCollection
getCollectionDef CollectionName
collName
  let queryExists :: Bool
queryExists = ((ListedQuery -> Bool) -> [ListedQuery] -> Bool)
-> [ListedQuery] -> (ListedQuery -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ListedQuery -> Bool) -> [ListedQuery] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [ListedQuery]
qList ((ListedQuery -> Bool) -> Bool) -> (ListedQuery -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \ListedQuery
q -> ListedQuery -> QueryName
_lqName ListedQuery
q QueryName -> QueryName -> Bool
forall a. Eq a => a -> a -> Bool
== QueryName
queryName
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
queryExists
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"query with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryName
queryName
    QueryName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found in collection "
    Text -> CollectionName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> CollectionName
collName

  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
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (QueryCollections -> Identity QueryCollections)
-> Metadata -> Identity Metadata
Lens' Metadata QueryCollections
metaQueryCollections
    ((QueryCollections -> Identity QueryCollections)
 -> Metadata -> Identity Metadata)
-> (([ListedQuery] -> Identity [ListedQuery])
    -> QueryCollections -> Identity QueryCollections)
-> ([ListedQuery] -> Identity [ListedQuery])
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index QueryCollections
-> Traversal' QueryCollections (IxValue QueryCollections)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index QueryCollections
CollectionName
collName
    ((CreateCollection -> Identity CreateCollection)
 -> QueryCollections -> Identity QueryCollections)
-> (([ListedQuery] -> Identity [ListedQuery])
    -> CreateCollection -> Identity CreateCollection)
-> ([ListedQuery] -> Identity [ListedQuery])
-> QueryCollections
-> Identity QueryCollections
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CollectionDef -> Identity CollectionDef)
-> CreateCollection -> Identity CreateCollection
Lens' CreateCollection CollectionDef
ccDefinition
    ((CollectionDef -> Identity CollectionDef)
 -> CreateCollection -> Identity CreateCollection)
-> (([ListedQuery] -> Identity [ListedQuery])
    -> CollectionDef -> Identity CollectionDef)
-> ([ListedQuery] -> Identity [ListedQuery])
-> CreateCollection
-> Identity CreateCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ListedQuery] -> Identity [ListedQuery])
-> CollectionDef -> Identity CollectionDef
Iso' CollectionDef [ListedQuery]
cdQueries
    (([ListedQuery] -> Identity [ListedQuery])
 -> Metadata -> Identity Metadata)
-> ([ListedQuery] -> [ListedQuery]) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (ListedQuery -> Bool) -> [ListedQuery] -> [ListedQuery]
forall a. (a -> Bool) -> [a] -> [a]
filter (QueryName -> QueryName -> Bool
forall a. Eq a => a -> a -> Bool
(/=) QueryName
queryName (QueryName -> Bool)
-> (ListedQuery -> QueryName) -> ListedQuery -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListedQuery -> QueryName
_lqName)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runAddCollectionToAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  AllowlistEntry ->
  m EncJSON
runAddCollectionToAllowlist :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m) =>
AllowlistEntry -> m EncJSON
runAddCollectionToAllowlist AllowlistEntry
entry = do
  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"collection" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionName -> m ()
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m ()
assertCollectionDefined (AllowlistEntry -> CollectionName
aeCollection AllowlistEntry
entry)
  MetadataAllowlist
allowlist <- Text -> m MetadataAllowlist -> m MetadataAllowlist
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"allowlist" m MetadataAllowlist
forall (m :: * -> *). MetadataM m => m MetadataAllowlist
fetchAllowlist
  case AllowlistEntry
-> MetadataAllowlist -> Either Text MetadataAllowlist
metadataAllowlistInsert AllowlistEntry
entry MetadataAllowlist
allowlist of
    Left Text
msg ->
      EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (EncJSON -> m EncJSON)
-> ([Pair] -> EncJSON) -> [Pair] -> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue
        (Value -> EncJSON) -> ([Pair] -> Value) -> [Pair] -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
J.object
        ([Pair] -> m EncJSON) -> [Pair] -> m EncJSON
forall a b. (a -> b) -> a -> b
$ [Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
msg]
    Right MetadataAllowlist
allowlist' -> do
      m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ())
-> (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ((MetadataAllowlist -> Identity MetadataAllowlist)
-> Metadata -> Identity Metadata
Lens' Metadata MetadataAllowlist
metaAllowlist ((MetadataAllowlist -> Identity MetadataAllowlist)
 -> Metadata -> Identity Metadata)
-> MetadataAllowlist -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MetadataAllowlist
allowlist')
      EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

-- Create a metadata modifier that drops a collection from the allowlist.
-- This is factored out for use in 'runDropCollection'.
dropCollectionFromAllowlist ::
  (MonadError QErr m, MetadataM m) =>
  CollectionName ->
  m MetadataModifier
dropCollectionFromAllowlist :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m) =>
CollectionName -> m MetadataModifier
dropCollectionFromAllowlist CollectionName
collName = do
  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"collection" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionName -> m ()
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m ()
assertCollectionDefined CollectionName
collName
  MetadataAllowlist
allowList <- Text -> m MetadataAllowlist -> m MetadataAllowlist
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"allowlist" m MetadataAllowlist
forall (m :: * -> *). MetadataM m => m MetadataAllowlist
fetchAllowlist
  case CollectionName -> MetadataAllowlist -> Maybe AllowlistEntry
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup CollectionName
collName MetadataAllowlist
allowList of
    Maybe AllowlistEntry
Nothing -> Code -> Text -> m MetadataModifier
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text -> m MetadataModifier) -> Text -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ Text
"collection " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName
collName CollectionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" doesn't exist in the allowlist"
    Just AllowlistEntry
_ -> 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
$ (MetadataAllowlist -> Identity MetadataAllowlist)
-> Metadata -> Identity Metadata
Lens' Metadata MetadataAllowlist
metaAllowlist ((MetadataAllowlist -> Identity MetadataAllowlist)
 -> Metadata -> Identity Metadata)
-> MetadataAllowlist -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CollectionName -> MetadataAllowlist -> MetadataAllowlist
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete CollectionName
collName MetadataAllowlist
allowList

runDropCollectionFromAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  DropCollectionFromAllowlist ->
  m EncJSON
runDropCollectionFromAllowlist :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m) =>
DropCollectionFromAllowlist -> m EncJSON
runDropCollectionFromAllowlist (DropCollectionFromAllowlist CollectionName
collName) = do
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ())
-> (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache (MetadataModifier -> m ()) -> m MetadataModifier -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CollectionName -> m MetadataModifier
forall (m :: * -> *).
(MonadError QErr m, MetadataM m) =>
CollectionName -> m MetadataModifier
dropCollectionFromAllowlist CollectionName
collName
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

runUpdateScopeOfCollectionInAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  UpdateScopeOfCollectionInAllowlist ->
  m EncJSON
runUpdateScopeOfCollectionInAllowlist :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m) =>
UpdateScopeOfCollectionInAllowlist -> m EncJSON
runUpdateScopeOfCollectionInAllowlist (UpdateScopeOfCollectionInAllowlist AllowlistEntry
entry) = do
  Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"collection" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CollectionName -> m ()
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m ()
assertCollectionDefined (AllowlistEntry -> CollectionName
aeCollection AllowlistEntry
entry)
  MetadataAllowlist
al <- Text -> m MetadataAllowlist -> m MetadataAllowlist
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"allowlist" m MetadataAllowlist
forall (m :: * -> *). MetadataM m => m MetadataAllowlist
fetchAllowlist
  MetadataModifier
modifier <- case AllowlistEntry
-> MetadataAllowlist -> Either Text MetadataAllowlist
metadataAllowlistUpdateScope AllowlistEntry
entry MetadataAllowlist
al of
    Left Text
err -> Code -> Text -> m MetadataModifier
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound Text
err
    Right MetadataAllowlist
al' ->
      MetadataModifier -> m MetadataModifier
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (MetadataModifier -> m MetadataModifier)
-> ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata)
-> m MetadataModifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
        ((Metadata -> Metadata) -> m MetadataModifier)
-> (Metadata -> Metadata) -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ (MetadataAllowlist -> Identity MetadataAllowlist)
-> Metadata -> Identity Metadata
Lens' Metadata MetadataAllowlist
metaAllowlist
        ((MetadataAllowlist -> Identity MetadataAllowlist)
 -> Metadata -> Identity Metadata)
-> MetadataAllowlist -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MetadataAllowlist
al'
  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
modifier
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

-- helpers

assertCollectionDefined :: (QErrM m, MetadataM m) => CollectionName -> m ()
assertCollectionDefined :: forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m ()
assertCollectionDefined = m CreateCollection -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m CreateCollection -> m ())
-> (CollectionName -> m CreateCollection) -> CollectionName -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollectionName -> m CreateCollection
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m CreateCollection
getCollectionDef

getCollectionDef ::
  (QErrM m, MetadataM m) =>
  CollectionName ->
  m CreateCollection
getCollectionDef :: forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m CreateCollection
getCollectionDef CollectionName
collName = do
  Maybe CreateCollection
detM <- CollectionName -> m (Maybe CreateCollection)
forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m (Maybe CreateCollection)
getCollectionDefM CollectionName
collName
  Maybe CreateCollection -> m CreateCollection -> m CreateCollection
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe CreateCollection
detM
    (m CreateCollection -> m CreateCollection)
-> m CreateCollection -> m CreateCollection
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m CreateCollection
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m CreateCollection) -> Text -> m CreateCollection
forall a b. (a -> b) -> a -> b
$ Text
"query collection with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName
collName
    CollectionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"

getCollectionDefM ::
  (QErrM m, MetadataM m) =>
  CollectionName ->
  m (Maybe CreateCollection)
getCollectionDefM :: forall (m :: * -> *).
(QErrM m, MetadataM m) =>
CollectionName -> m (Maybe CreateCollection)
getCollectionDefM CollectionName
collName =
  CollectionName -> QueryCollections -> Maybe CreateCollection
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup CollectionName
collName (QueryCollections -> Maybe CreateCollection)
-> m QueryCollections -> m (Maybe CreateCollection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m QueryCollections
forall (m :: * -> *). MetadataM m => m QueryCollections
fetchAllCollections

fetchAllCollections :: (MetadataM m) => m QueryCollections
fetchAllCollections :: forall (m :: * -> *). MetadataM m => m QueryCollections
fetchAllCollections =
  Metadata -> QueryCollections
_metaQueryCollections (Metadata -> QueryCollections) -> m Metadata -> m QueryCollections
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

fetchAllowlist :: (MetadataM m) => m MetadataAllowlist
fetchAllowlist :: forall (m :: * -> *). MetadataM m => m MetadataAllowlist
fetchAllowlist = Metadata -> MetadataAllowlist
_metaAllowlist (Metadata -> MetadataAllowlist)
-> m Metadata -> m MetadataAllowlist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

fetchAllAllowlistCollections :: (MetadataM m) => m [CollectionName]
fetchAllAllowlistCollections :: forall (m :: * -> *). MetadataM m => m [CollectionName]
fetchAllAllowlistCollections = MetadataAllowlist -> [CollectionName]
metadataAllowlistAllCollections (MetadataAllowlist -> [CollectionName])
-> m MetadataAllowlist -> m [CollectionName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MetadataAllowlist
forall (m :: * -> *). MetadataM m => m MetadataAllowlist
fetchAllowlist