module Hasura.Backends.DataConnector.Adapter.ConfigTransform
  ( transformSourceConfig,
    validateConnSourceConfig,
  )
where

--------------------------------------------------------------------------------

import Data.Aeson qualified as J
import Data.Aeson.Kriti.Functions qualified as KFunc
import Data.Environment qualified as Env
import Data.Text qualified as Text
import Data.Text.Extended qualified as Text
import Hasura.Backends.DataConnector.API (ConfigSchemaResponse)
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.Types (ConnSourceConfig (ConnSourceConfig, template, value), SourceConfig (..))
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
import Hasura.Base.Error (Code (DataConnectorError, NotSupported), QErr, throw400)
import Hasura.Prelude
import Hasura.RQL.Types.Common as Common
import Hasura.Session (SessionVariables)
import Kriti.Error qualified as Kriti

--------------------------------------------------------------------------------

transformConfig :: (MonadError QErr m) => API.Config -> Maybe Text -> Maybe SessionVariables -> Env.Environment -> m API.Config
transformConfig :: forall (m :: * -> *).
MonadError QErr m =>
Config
-> Maybe Text -> Maybe SessionVariables -> Environment -> m Config
transformConfig Config
config Maybe Text
maybeTemplate Maybe SessionVariables
sessionVariables Environment
env = do
  case Maybe Text
maybeTemplate of
    Maybe Text
Nothing -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config
    (Just Text
t) ->
      case Text
-> [(Text, Value)]
-> HashMap Text KritiFunc
-> Either SerializedError Value
KFunc.runKritiWith Text
t ([(Text
"$config", Config -> Value
forall a. ToJSON a => a -> Value
J.toJSON Config
config), (Text
"$env", Environment -> Value
forall a. ToJSON a => a -> Value
J.toJSON Environment
env), (Text
"$session", Value
-> (SessionVariables -> Value) -> Maybe SessionVariables -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Pair] -> Value
J.object []) SessionVariables -> Value
forall a. ToJSON a => a -> Value
J.toJSON Maybe SessionVariables
sessionVariables)]) (Environment -> HashMap Text KritiFunc
additionalFunctions Environment
env) of
        Left SerializedError
e -> Code -> Text -> m Config
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m Config) -> Text -> m Config
forall a b. (a -> b) -> a -> b
$ Text
"transformConfig: Kriti template transform failed - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SerializedError -> Text
forall a. Show a => a -> Text
tshow SerializedError
e
        Right (J.Object Object
r) -> Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> m Config) -> Config -> m Config
forall a b. (a -> b) -> a -> b
$ Object -> Config
API.Config Object
r
        Right Value
o -> Code -> Text -> m Config
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m Config) -> Text -> m Config
forall a b. (a -> b) -> a -> b
$ Text
"transformConfig: Kriti did not decode into Object - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
forall a. Show a => a -> Text
tshow Value
o

transformSourceConfig :: (MonadError QErr m) => SourceConfig -> Maybe SessionVariables -> m SourceConfig
transformSourceConfig :: forall (m :: * -> *).
MonadError QErr m =>
SourceConfig -> Maybe SessionVariables -> m SourceConfig
transformSourceConfig sc :: SourceConfig
sc@SourceConfig {Config
_scConfig :: Config
_scConfig :: SourceConfig -> Config
_scConfig, Maybe Text
_scTemplate :: Maybe Text
_scTemplate :: SourceConfig -> Maybe Text
_scTemplate, Environment
_scEnvironment :: Environment
_scEnvironment :: SourceConfig -> Environment
_scEnvironment} Maybe SessionVariables
sessionVariables = do
  Config
transformedConfig <- Config
-> Maybe Text -> Maybe SessionVariables -> Environment -> m Config
forall (m :: * -> *).
MonadError QErr m =>
Config
-> Maybe Text -> Maybe SessionVariables -> Environment -> m Config
transformConfig Config
_scConfig Maybe Text
_scTemplate Maybe SessionVariables
sessionVariables Environment
_scEnvironment
  SourceConfig -> m SourceConfig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceConfig
sc {_scConfig :: Config
_scConfig = Config
transformedConfig}

-- | Apply a transformation to a 'ConnSourceConfig' without validating the result.
transformConnSourceConfigUnsafe :: (MonadError QErr m) => ConnSourceConfig -> Maybe SessionVariables -> Env.Environment -> m API.Config
transformConnSourceConfigUnsafe :: forall (m :: * -> *).
MonadError QErr m =>
ConnSourceConfig
-> Maybe SessionVariables -> Environment -> m Config
transformConnSourceConfigUnsafe ConnSourceConfig {Config
value :: ConnSourceConfig -> Config
value :: Config
value, Maybe Text
template :: ConnSourceConfig -> Maybe Text
template :: Maybe Text
template} Maybe SessionVariables
sessionVariables Environment
env = Config
-> Maybe Text -> Maybe SessionVariables -> Environment -> m Config
forall (m :: * -> *).
MonadError QErr m =>
Config
-> Maybe Text -> Maybe SessionVariables -> Environment -> m Config
transformConfig Config
value Maybe Text
template Maybe SessionVariables
sessionVariables Environment
env

-- | Apply a transformation to a 'ConnSourceConfig' and validate the result.
validateConnSourceConfig ::
  (MonadError QErr m) =>
  DC.DataConnectorName ->
  Common.SourceName ->
  ConfigSchemaResponse ->
  ConnSourceConfig ->
  Maybe SessionVariables ->
  Env.Environment ->
  m ()
validateConnSourceConfig :: forall (m :: * -> *).
MonadError QErr m =>
DataConnectorName
-> SourceName
-> ConfigSchemaResponse
-> ConnSourceConfig
-> Maybe SessionVariables
-> Environment
-> m ()
validateConnSourceConfig DataConnectorName
dcName SourceName
sourceName ConfigSchemaResponse
configSchemaResponse ConnSourceConfig
connSourceConfig Maybe SessionVariables
sessionVariables Environment
env = do
  Config
transformedConfig <- ConnSourceConfig
-> Maybe SessionVariables -> Environment -> m Config
forall (m :: * -> *).
MonadError QErr m =>
ConnSourceConfig
-> Maybe SessionVariables -> Environment -> m Config
transformConnSourceConfigUnsafe ConnSourceConfig
connSourceConfig Maybe SessionVariables
sessionVariables Environment
env
  SourceName
-> DataConnectorName -> ConfigSchemaResponse -> Config -> m ()
forall (m :: * -> *).
MonadError QErr m =>
SourceName
-> DataConnectorName -> ConfigSchemaResponse -> Config -> m ()
validateConfiguration SourceName
sourceName DataConnectorName
dcName ConfigSchemaResponse
configSchemaResponse Config
transformedConfig

validateConfiguration ::
  (MonadError QErr m) =>
  Common.SourceName ->
  DC.DataConnectorName ->
  API.ConfigSchemaResponse ->
  API.Config ->
  m ()
validateConfiguration :: forall (m :: * -> *).
MonadError QErr m =>
SourceName
-> DataConnectorName -> ConfigSchemaResponse -> Config -> m ()
validateConfiguration SourceName
sourceName DataConnectorName
dataConnectorName ConfigSchemaResponse
configSchema Config
config = do
  let errors :: [ValidationError]
errors = ConfigSchemaResponse -> Config -> [ValidationError]
API.validateConfigAgainstConfigSchema ConfigSchemaResponse
configSchema Config
config
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ValidationError]
errors)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ let errorsText :: Text
errorsText = [Text] -> Text
Text.unlines ((Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (ValidationError -> Text) -> ValidationError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidationError -> Text
Text.pack (ValidationError -> Text) -> [ValidationError] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ValidationError]
errors)
       in Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
            Code
DataConnectorError
            (Text
"Configuration for source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall t. ToTxt t => t -> Text
Text.dquote SourceName
sourceName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not valid based on the configuration schema declared by the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataConnectorName -> Text
forall t. ToTxt t => t -> Text
Text.dquote DataConnectorName
dataConnectorName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" data connector agent. Errors:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errorsText)

additionalFunctions :: Env.Environment -> HashMap Text (J.Value -> Either Kriti.CustomFunctionError J.Value)
additionalFunctions :: Environment -> HashMap Text KritiFunc
additionalFunctions Environment
env = Environment -> HashMap Text KritiFunc
KFunc.environmentFunctions Environment
env