{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.DDL.QueryTags
  ( SetQueryTagsConfig,
    runSetQueryTagsConfig,
  )
where

import Control.Lens
import Data.Aeson
import Data.Aeson.TH qualified as J
import Data.HashMap.Strict.InsOrd qualified as OM
import Data.Text.Extended (toTxt, (<<>))
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.QueryTags
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.SQL.Tag

data SetQueryTagsConfig = SetQueryTagsConfig
  { SetQueryTagsConfig -> SourceName
_sqtSourceName :: SourceName,
    SetQueryTagsConfig -> QueryTagsConfig
_sqtConfig :: QueryTagsConfig
  }

$(J.deriveToJSON hasuraJSON {J.omitNothingFields = True} ''SetQueryTagsConfig)

instance FromJSON SetQueryTagsConfig where
  parseJSON :: Value -> Parser SetQueryTagsConfig
parseJSON = String
-> (Object -> Parser SetQueryTagsConfig)
-> Value
-> Parser SetQueryTagsConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetQueryTagsConfig" ((Object -> Parser SetQueryTagsConfig)
 -> Value -> Parser SetQueryTagsConfig)
-> (Object -> Parser SetQueryTagsConfig)
-> Value
-> Parser SetQueryTagsConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    SourceName
sourceName <- Object
o Object -> Key -> Parser SourceName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source_name"
    QueryTagsConfig
queryTagsConfig <- Value -> Parser QueryTagsConfig
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser QueryTagsConfig)
-> Value -> Parser QueryTagsConfig
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object Object
o
    SetQueryTagsConfig -> Parser SetQueryTagsConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SetQueryTagsConfig -> Parser SetQueryTagsConfig)
-> SetQueryTagsConfig -> Parser SetQueryTagsConfig
forall a b. (a -> b) -> a -> b
$ SourceName -> QueryTagsConfig -> SetQueryTagsConfig
SetQueryTagsConfig SourceName
sourceName QueryTagsConfig
queryTagsConfig

runSetQueryTagsConfig ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  SetQueryTagsConfig ->
  m EncJSON
runSetQueryTagsConfig :: SetQueryTagsConfig -> m EncJSON
runSetQueryTagsConfig (SetQueryTagsConfig SourceName
sourceName QueryTagsConfig
queryTagsConfig) = do
  Metadata
oldMetadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  case SourceName
-> InsOrdHashMap SourceName BackendSourceMetadata
-> Maybe BackendSourceMetadata
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
OM.lookup SourceName
sourceName (Metadata -> InsOrdHashMap SourceName BackendSourceMetadata
_metaSources Metadata
oldMetadata) of
    Maybe BackendSourceMetadata
Nothing -> Code -> Text -> m EncJSON
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text -> m EncJSON) -> Text -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Text
"source with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
    Just BackendSourceMetadata
exists -> do
      let backendType :: BackendType
backendType = BackendSourceMetadata -> BackendType
getBackendType BackendSourceMetadata
exists
      case BackendType
backendType of
        Postgres PostgresKind
_ -> AnyBackend SourceMetadata -> Maybe QueryTagsConfig -> m EncJSON
setQueryTagsConfigInMetadata (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
exists) (QueryTagsConfig -> Maybe QueryTagsConfig
forall a. a -> Maybe a
Just QueryTagsConfig
queryTagsConfig)
        BackendType
_ -> BackendType -> m EncJSON
forall (m :: * -> *) a a. (MonadError QErr m, ToTxt a) => a -> m a
queryTagsNotSupported BackendType
backendType
  where
    getBackendType :: BackendSourceMetadata -> BackendType
    getBackendType :: BackendSourceMetadata -> BackendType
getBackendType BackendSourceMetadata
exists =
      AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> BackendType)
-> BackendType
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
exists) ((forall (b :: BackendType).
  Backend b =>
  SourceMetadata b -> BackendType)
 -> BackendType)
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> BackendType)
-> BackendType
forall a b. (a -> b) -> a -> b
$ \(SourceMetadata b
_sourceMetadata :: SourceMetadata b) ->
        BackendTag b -> BackendType
forall (b :: BackendType). BackendTag b -> BackendType
reify (BackendTag b -> BackendType) -> BackendTag b -> BackendType
forall a b. (a -> b) -> a -> b
$ HasTag b => BackendTag b
forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b

    setQueryTagsConfigInMetadata :: AnyBackend SourceMetadata -> Maybe QueryTagsConfig -> m EncJSON
setQueryTagsConfigInMetadata AnyBackend SourceMetadata
exists Maybe QueryTagsConfig
qtConfig = do
      let metadataModifier :: MetadataModifier
metadataModifier = AnyBackend SourceMetadata
-> Maybe QueryTagsConfig -> MetadataModifier
queryTagsMetadataModifier AnyBackend SourceMetadata
exists Maybe QueryTagsConfig
qtConfig
      MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (SourceName -> MetadataObjId
MOSource SourceName
sourceName) MetadataModifier
metadataModifier
      EncJSON -> m EncJSON
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

    queryTagsNotSupported :: a -> m a
queryTagsNotSupported a
backendType = Code -> Text -> m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToTxt a => a -> Text
toTxt a
backendType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" sources do not support query-tags yet"

    queryTagsMetadataModifier :: AnyBackend SourceMetadata
-> Maybe QueryTagsConfig -> MetadataModifier
queryTagsMetadataModifier AnyBackend SourceMetadata
exists Maybe QueryTagsConfig
qtConfig =
      AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> MetadataModifier)
-> MetadataModifier
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend SourceMetadata
exists ((forall (b :: BackendType).
  Backend b =>
  SourceMetadata b -> MetadataModifier)
 -> MetadataModifier)
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> MetadataModifier)
-> MetadataModifier
forall a b. (a -> b) -> a -> b
$ \(_sourceMetadata :: SourceMetadata b) ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (InsOrdHashMap SourceName BackendSourceMetadata
 -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
-> Metadata -> Identity Metadata
Lens' Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
metaSources ((InsOrdHashMap SourceName BackendSourceMetadata
  -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
 -> Metadata -> Identity Metadata)
-> ((Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
    -> InsOrdHashMap SourceName BackendSourceMetadata
    -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
-> (Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap SourceName BackendSourceMetadata)
-> Traversal'
     (InsOrdHashMap SourceName BackendSourceMetadata)
     (IxValue (InsOrdHashMap SourceName BackendSourceMetadata))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap SourceName BackendSourceMetadata)
SourceName
sourceName ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> InsOrdHashMap SourceName BackendSourceMetadata
 -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
-> ((Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
-> InsOrdHashMap SourceName BackendSourceMetadata
-> Identity (InsOrdHashMap SourceName BackendSourceMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backend b => Prism' BackendSourceMetadata (SourceMetadata b)
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType).
Lens' (SourceMetadata b) (Maybe QueryTagsConfig)
smQueryTags ((Maybe QueryTagsConfig -> Identity (Maybe QueryTagsConfig))
 -> Metadata -> Identity Metadata)
-> Maybe QueryTagsConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe QueryTagsConfig
qtConfig