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

import Control.Lens ((.~))
import Data.Aeson qualified as Aeson
import Data.HashMap.Strict.InsOrd qualified as OMap
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 :: 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 (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 (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet QueryName
duplicateNames)
  where
    duplicateNames :: HashSet QueryName
duplicateNames = [QueryName] -> HashSet QueryName
forall a. (Eq 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 :: 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 ()) -> m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust Maybe CreateCollection
collDetM ((CreateCollection -> m ()) -> m ())
-> (CreateCollection -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
      m () -> CreateCollection -> m ()
forall a b. a -> b -> a
const (m () -> CreateCollection -> m ())
-> m () -> CreateCollection -> 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 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
OMap.insert CollectionName
collName CreateCollection
cc
  EncJSON -> m EncJSON
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 :: 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 ()) -> m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust Maybe CreateCollection
newCollDefM ((CreateCollection -> m ()) -> m ())
-> (CreateCollection -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
      m () -> CreateCollection -> m ()
forall a b. a -> b -> a
const (m () -> CreateCollection -> m ())
-> m () -> CreateCollection -> 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 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 (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
OMap.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
OMap.insert CollectionName
newKey CreateCollection
newVal (CollectionName -> QueryCollections -> QueryCollections
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.delete CollectionName
oldKey QueryCollections
oMap)

runAddQueryToCollection ::
  (CacheRWM m, MonadError QErr m, MetadataM m) =>
  AddQueryToCollection ->
  m EncJSON
runAddQueryToCollection :: 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 (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
OMap.insert CollectionName
collName (CollectionName -> CollectionDef -> Maybe Text -> CreateCollection
CreateCollection CollectionName
collName CollectionDef
collDef Maybe Text
comment)
  EncJSON -> m EncJSON
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 :: 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 (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 (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
OMap.delete CollectionName
collName)

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

runDropQueryFromCollection ::
  (CacheRWM m, MonadError QErr m, MetadataM m) =>
  DropQueryFromCollection ->
  m EncJSON
runDropQueryFromCollection :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runAddCollectionToAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  AllowlistEntry ->
  m EncJSON
runAddCollectionToAllowlist :: 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 (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
Aeson.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
Aeson..= 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 (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 :: 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
OMap.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 (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
OMap.delete CollectionName
collName MetadataAllowlist
allowList

runDropCollectionFromAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  DropCollectionFromAllowlist ->
  m EncJSON
runDropCollectionFromAllowlist :: 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 (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

runUpdateScopeOfCollectionInAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  UpdateScopeOfCollectionInAllowlist ->
  m EncJSON
runUpdateScopeOfCollectionInAllowlist :: 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 (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 (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

-- helpers

assertCollectionDefined :: (QErrM m, MetadataM m) => CollectionName -> m ()
assertCollectionDefined :: 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 :: 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 :: CollectionName -> m (Maybe CreateCollection)
getCollectionDefM CollectionName
collName =
  CollectionName -> QueryCollections -> Maybe CreateCollection
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
OMap.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 :: 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 :: 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 :: 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