graphql-engine/server/src-lib/Hasura/RQL/DDL/QueryCollection.hs

module Hasura.RQL.DDL.QueryCollection
  ( runCreateCollection,
    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

addCollectionP2 ::
  (QErrM m) =>
  CollectionDef ->
  m ()
addCollectionP2 (CollectionDef queryList) =
  withPathK "queries" $
    unless (null duplicateNames) $
      throw400 NotSupported $
        "found duplicate query names "
          <> dquoteList (unNonEmptyText . unQueryName <$> toList duplicateNames)
  where
    duplicateNames = duplicates $ map _lqName queryList

runCreateCollection ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  CreateCollection ->
  m EncJSON
runCreateCollection cc = do
  collDetM <- getCollectionDefM collName
  withPathK "name" $
    onJust collDetM $
      const $
        throw400 AlreadyExists $
          "query collection with name " <> collName <<> " already exists"
  withPathK "definition" $ addCollectionP2 def
  withNewInconsistentObjsCheck $
    buildSchemaCache $
      MetadataModifier $
        metaQueryCollections %~ OMap.insert collName cc
  return successMsg
  where
    CreateCollection collName def _ = cc

runAddQueryToCollection ::
  (CacheRWM m, MonadError QErr m, MetadataM m) =>
  AddQueryToCollection ->
  m EncJSON
runAddQueryToCollection (AddQueryToCollection collName queryName query) = do
  (CreateCollection _ (CollectionDef qList) comment) <- getCollectionDef collName
  let queryExists = flip any qList $ \q -> _lqName q == queryName

  when queryExists $
    throw400 AlreadyExists $
      "query with name "
        <> queryName <<> " already exists in collection " <>> collName
  let collDef = CollectionDef $ qList <> pure listQ
  withNewInconsistentObjsCheck $
    buildSchemaCache $
      MetadataModifier $
        metaQueryCollections
          %~ OMap.insert collName (CreateCollection collName collDef comment)
  return successMsg
  where
    listQ = ListedQuery queryName query

runDropCollection ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  DropCollection ->
  m EncJSON
runDropCollection (DropCollection collName cascade) = do
  cascadeModifier <- withPathK "collection" $ do
    assertCollectionDefined collName
    allowlist <- fetchAllAllowlistCollections
    if (collName `elem` allowlist)
      then
        if not cascade
          then
            throw400 DependencyError $
              "query collection with name "
                <> collName <<> " is present in the allowlist; cannot proceed to drop. "
                <> "please use cascade to confirm you wish to drop it from the allowlist as well"
          else dropCollectionFromAllowlist collName
      else pure mempty

  withNewInconsistentObjsCheck $
    buildSchemaCache $
      cascadeModifier <> MetadataModifier (metaQueryCollections %~ OMap.delete collName)

  pure successMsg

runDropQueryFromCollection ::
  (CacheRWM m, MonadError QErr m, MetadataM m) =>
  DropQueryFromCollection ->
  m EncJSON
runDropQueryFromCollection (DropQueryFromCollection collName queryName) = do
  CreateCollection _ (CollectionDef qList) _ <- getCollectionDef collName
  let queryExists = flip any qList $ \q -> _lqName q == queryName
  unless queryExists $
    throw400 NotFound $
      "query with name "
        <> queryName <<> " not found in collection " <>> collName

  withNewInconsistentObjsCheck $
    buildSchemaCache $
      MetadataModifier $
        metaQueryCollections . ix collName . ccDefinition . cdQueries
          %~ filter ((/=) queryName . _lqName)
  pure successMsg

runAddCollectionToAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  AllowlistEntry ->
  m EncJSON
runAddCollectionToAllowlist entry = do
  withPathK "collection" $ assertCollectionDefined (aeCollection entry)
  allowlist <- withPathK "allowlist" fetchAllowlist
  case metadataAllowlistInsert entry allowlist of
    Left msg ->
      pure . encJFromJValue . Aeson.object $
        ["message" Aeson..= msg]
    Right allowlist' -> do
      withNewInconsistentObjsCheck . buildSchemaCache $ MetadataModifier (metaAllowlist .~ allowlist')
      pure 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 collName = do
  withPathK "collection" $ assertCollectionDefined collName
  allowList <- withPathK "allowlist" fetchAllowlist
  case OMap.lookup collName allowList of
    Nothing -> throw400 NotFound $ "collection " <> collName <<> " doesn't exist in the allowlist"
    Just _ -> pure $ MetadataModifier $ metaAllowlist .~ OMap.delete collName allowList

runDropCollectionFromAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  DropCollectionFromAllowlist ->
  m EncJSON
runDropCollectionFromAllowlist (DropCollectionFromAllowlist collName) = do
  withNewInconsistentObjsCheck . buildSchemaCache =<< dropCollectionFromAllowlist collName
  return successMsg

runUpdateScopeOfCollectionInAllowlist ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  UpdateScopeOfCollectionInAllowlist ->
  m EncJSON
runUpdateScopeOfCollectionInAllowlist (UpdateScopeOfCollectionInAllowlist entry) = do
  withPathK "collection" $ assertCollectionDefined (aeCollection entry)
  al <- withPathK "allowlist" fetchAllowlist
  modifier <- case metadataAllowlistUpdateScope entry al of
    Left err -> throw400 NotFound err
    Right al' ->
      pure . MetadataModifier $
        metaAllowlist .~ al'
  withNewInconsistentObjsCheck $ buildSchemaCache modifier
  return successMsg

-- helpers

assertCollectionDefined :: (QErrM m, MetadataM m) => CollectionName -> m ()
assertCollectionDefined = void . getCollectionDef

getCollectionDef ::
  (QErrM m, MetadataM m) =>
  CollectionName ->
  m CreateCollection
getCollectionDef collName = do
  detM <- getCollectionDefM collName
  onNothing detM $
    throw400 NotExists $
      "query collection with name " <> collName <<> " does not exist"

getCollectionDefM ::
  (QErrM m, MetadataM m) =>
  CollectionName ->
  m (Maybe CreateCollection)
getCollectionDefM collName =
  OMap.lookup collName <$> fetchAllCollections

fetchAllCollections :: MetadataM m => m QueryCollections
fetchAllCollections =
  _metaQueryCollections <$> getMetadata

fetchAllowlist :: MetadataM m => m MetadataAllowlist
fetchAllowlist = _metaAllowlist <$> getMetadata

fetchAllAllowlistCollections :: MetadataM m => m [CollectionName]
fetchAllAllowlistCollections = metadataAllowlistAllCollections <$> fetchAllowlist