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