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.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 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