{-# LANGUAGE PolyKinds #-}

-- | We validate 'TransformFn' terms inside 'RequestTransform' before
-- dispatching Metadata actions in 'runMetadataQueryV1M'. Validation
-- follows the same HKD pattern from 'applyRequestTransform' but using
-- 'btraverseC' to call 'validate' from the 'Transform' class on all
-- the HKD fields.
module Hasura.RQL.DDL.Webhook.Transform.Validation
  ( Unvalidated (..),
    Unvalidated1 (..),
    unUnvalidate,
    unUnvalidate1,
    validateRequestTransform,
    validateTransforms,
  )
where

import Control.Lens (Lens', LensLike, lens, traverseOf)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as J
import Data.Functor.Barbie (FunctorB (bmap), btraverseC)
import Data.Functor.Compose (Compose (..))
import Data.Kind
import Data.Validation (Validation, toEither)
import Hasura.Base.Error (Code (..), QErr (..), QErrExtra (..), err400)
import Hasura.EncJSON (EncJSON)
import Hasura.Prelude
import Hasura.RQL.DDL.Webhook.Transform
import Hasura.RQL.DDL.Webhook.Transform.Body (validateBodyTransformFn)
import Hasura.RQL.DDL.Webhook.Transform.Class
import Hasura.RQL.Types.Webhook.Transform.Class

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

type Tuple1 a b = Compose ((,) a) b

type OptionalTuple1 a b = WithOptional (Tuple1 a b)

-- | A variation on 'RequestTransformFn' where 'TransformFn' is tupled
-- with 'TemplatingEngine'. This is necessary to validate the 'TransformFn'.
--
-- TODO: In the future we most likely want to embed the
-- 'TemplatingEngine' in the 'TransformFn' or the
-- 'Template'/'UnwrappedTemplate', in which case we would not need
-- this alias for validation.
type ValidationFields = RequestFields (OptionalTuple1 TemplatingEngine TransformFn)

-- TODO(SOLOMON): Add lens law unit tests

-- | A lens for zipping our defunctionalized transform with the
-- 'TemplatingEngine' for validation.
transformFns :: Lens' RequestTransform ValidationFields
transformFns :: Lens' RequestTransform ValidationFields
transformFns = (RequestTransform -> ValidationFields)
-> (RequestTransform -> ValidationFields -> RequestTransform)
-> Lens' RequestTransform ValidationFields
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RequestTransform -> ValidationFields
getter RequestTransform -> ValidationFields -> RequestTransform
setter
  where
    getter :: RequestTransform -> ValidationFields
    getter :: RequestTransform -> ValidationFields
getter RequestTransform {TemplatingEngine
Version
RequestFields (WithOptional TransformFn)
version :: Version
requestFields :: RequestFields (WithOptional TransformFn)
templateEngine :: TemplatingEngine
version :: RequestTransform -> Version
requestFields :: RequestTransform -> RequestFields (WithOptional TransformFn)
templateEngine :: RequestTransform -> TemplatingEngine
..} =
      (forall a.
 WithOptional TransformFn a
 -> OptionalTuple1 TemplatingEngine TransformFn a)
-> RequestFields (WithOptional TransformFn) -> ValidationFields
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> RequestFields f -> RequestFields g
bmap (Maybe (Tuple1 TemplatingEngine TransformFn a)
-> WithOptional (Tuple1 TemplatingEngine TransformFn) a
forall (f :: * -> *) result.
Maybe (f result) -> WithOptional f result
WithOptional (Maybe (Tuple1 TemplatingEngine TransformFn a)
 -> WithOptional (Tuple1 TemplatingEngine TransformFn) a)
-> (WithOptional TransformFn a
    -> Maybe (Tuple1 TemplatingEngine TransformFn a))
-> WithOptional TransformFn a
-> WithOptional (Tuple1 TemplatingEngine TransformFn) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransformFn a -> Tuple1 TemplatingEngine TransformFn a)
-> Maybe (TransformFn a)
-> Maybe (Tuple1 TemplatingEngine TransformFn a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplatingEngine, TransformFn a)
-> Tuple1 TemplatingEngine TransformFn a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((TemplatingEngine, TransformFn a)
 -> Tuple1 TemplatingEngine TransformFn a)
-> (TransformFn a -> (TemplatingEngine, TransformFn a))
-> TransformFn a
-> Tuple1 TemplatingEngine TransformFn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemplatingEngine
templateEngine,)) (Maybe (TransformFn a)
 -> Maybe (Tuple1 TemplatingEngine TransformFn a))
-> (WithOptional TransformFn a -> Maybe (TransformFn a))
-> WithOptional TransformFn a
-> Maybe (Tuple1 TemplatingEngine TransformFn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithOptional TransformFn a -> Maybe (TransformFn a)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional) RequestFields (WithOptional TransformFn)
requestFields

    setter :: RequestTransform -> ValidationFields -> RequestTransform
    setter :: RequestTransform -> ValidationFields -> RequestTransform
setter RequestTransform
rt ValidationFields
requestFields' =
      RequestTransform
rt {requestFields :: RequestFields (WithOptional TransformFn)
requestFields = (forall a.
 OptionalTuple1 TemplatingEngine TransformFn a
 -> WithOptional TransformFn a)
-> ValidationFields -> RequestFields (WithOptional TransformFn)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> RequestFields f -> RequestFields g
bmap (Maybe (TransformFn a) -> WithOptional TransformFn a
forall (f :: * -> *) result.
Maybe (f result) -> WithOptional f result
WithOptional (Maybe (TransformFn a) -> WithOptional TransformFn a)
-> (OptionalTuple1 TemplatingEngine TransformFn a
    -> Maybe (TransformFn a))
-> OptionalTuple1 TemplatingEngine TransformFn a
-> WithOptional TransformFn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Compose ((,) TemplatingEngine) TransformFn a -> TransformFn a)
-> Maybe (Compose ((,) TemplatingEngine) TransformFn a)
-> Maybe (TransformFn a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TemplatingEngine, TransformFn a) -> TransformFn a
forall a b. (a, b) -> b
snd ((TemplatingEngine, TransformFn a) -> TransformFn a)
-> (Compose ((,) TemplatingEngine) TransformFn a
    -> (TemplatingEngine, TransformFn a))
-> Compose ((,) TemplatingEngine) TransformFn a
-> TransformFn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose ((,) TemplatingEngine) TransformFn a
-> (TemplatingEngine, TransformFn a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (Maybe (Compose ((,) TemplatingEngine) TransformFn a)
 -> Maybe (TransformFn a))
-> (OptionalTuple1 TemplatingEngine TransformFn a
    -> Maybe (Compose ((,) TemplatingEngine) TransformFn a))
-> OptionalTuple1 TemplatingEngine TransformFn a
-> Maybe (TransformFn a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionalTuple1 TemplatingEngine TransformFn a
-> Maybe (Compose ((,) TemplatingEngine) TransformFn a)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional) ValidationFields
requestFields'}

-- | Validate all 'TransformFn a' fields in the 'RequestTransform'.
validateRequestTransform ::
  (MonadError QErr m) =>
  RequestTransform ->
  m RequestTransform
validateRequestTransform :: forall (m :: * -> *).
MonadError QErr m =>
RequestTransform -> m RequestTransform
validateRequestTransform RequestTransform
reqTransform =
  Either QErr RequestTransform -> m RequestTransform
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr RequestTransform -> m RequestTransform)
-> Either QErr RequestTransform -> m RequestTransform
forall a b. (a -> b) -> a -> b
$ (TransformErrorBundle -> QErr)
-> Either TransformErrorBundle RequestTransform
-> Either QErr RequestTransform
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft TransformErrorBundle -> QErr
mkRequestQErr (Either TransformErrorBundle RequestTransform
 -> Either QErr RequestTransform)
-> Either TransformErrorBundle RequestTransform
-> Either QErr RequestTransform
forall a b. (a -> b) -> a -> b
$ Validation TransformErrorBundle RequestTransform
-> Either TransformErrorBundle RequestTransform
forall e a. Validation e a -> Either e a
toEither (Validation TransformErrorBundle RequestTransform
 -> Either TransformErrorBundle RequestTransform)
-> Validation TransformErrorBundle RequestTransform
-> Either TransformErrorBundle RequestTransform
forall a b. (a -> b) -> a -> b
$ (ValidationFields
 -> Validation TransformErrorBundle ValidationFields)
-> RequestTransform
-> Validation TransformErrorBundle RequestTransform
Lens' RequestTransform ValidationFields
transformFns (forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *)
       (f :: k -> *) (g :: k -> *) (e :: * -> *).
(TraversableB b, ConstraintsB b, AllB c b, Applicative e) =>
(forall (a :: k). c a => f a -> e (g a)) -> b f -> e (b g)
forall (c :: * -> Constraint) (b :: (* -> *) -> *) (f :: * -> *)
       (g :: * -> *) (e :: * -> *).
(TraversableB b, ConstraintsB b, AllB c b, Applicative e) =>
(forall a. c a => f a -> e (g a)) -> b f -> e (b g)
btraverseC @Transform OptionalTuple1 TemplatingEngine TransformFn a
-> Validation
     TransformErrorBundle
     (OptionalTuple1 TemplatingEngine TransformFn a)
forall a.
Transform a =>
OptionalTuple1 TemplatingEngine TransformFn a
-> Validation
     TransformErrorBundle
     (OptionalTuple1 TemplatingEngine TransformFn a)
validate') RequestTransform
reqTransform
  where
    validate' ::
      (Transform a) =>
      OptionalTuple1 TemplatingEngine TransformFn a ->
      Validation TransformErrorBundle (OptionalTuple1 TemplatingEngine TransformFn a)
    validate' :: forall a.
Transform a =>
OptionalTuple1 TemplatingEngine TransformFn a
-> Validation
     TransformErrorBundle
     (OptionalTuple1 TemplatingEngine TransformFn a)
validate' = \case
      fn :: OptionalTuple1 TemplatingEngine TransformFn a
fn@(WithOptional (Just (Compose (TemplatingEngine
engine, TransformFn a
transformFn)))) ->
        OptionalTuple1 TemplatingEngine TransformFn a
fn OptionalTuple1 TemplatingEngine TransformFn a
-> Validation TransformErrorBundle ()
-> Validation
     TransformErrorBundle
     (OptionalTuple1 TemplatingEngine TransformFn a)
forall a b.
a
-> Validation TransformErrorBundle b
-> Validation TransformErrorBundle a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TemplatingEngine
-> TransformFn a -> Validation TransformErrorBundle ()
forall a.
Transform a =>
TemplatingEngine
-> TransformFn a -> Validation TransformErrorBundle ()
validate TemplatingEngine
engine TransformFn a
transformFn
      OptionalTuple1 TemplatingEngine TransformFn a
fn -> OptionalTuple1 TemplatingEngine TransformFn a
-> Validation
     TransformErrorBundle
     (OptionalTuple1 TemplatingEngine TransformFn a)
forall a. a -> Validation TransformErrorBundle a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OptionalTuple1 TemplatingEngine TransformFn a
fn

    mkRequestQErr :: TransformErrorBundle -> QErr
    mkRequestQErr :: TransformErrorBundle -> QErr
mkRequestQErr TransformErrorBundle
errBundle = (Code -> Text -> QErr
err400 Code
ValidationFailed Text
errMsg) {qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal Value
internalErr}
      where
        internalErr :: Value
internalErr = TransformErrorBundle -> Value
forall a. ToJSON a => a -> Value
J.toJSON TransformErrorBundle
errBundle
        errMsg :: Text
errMsg = Text
"request transform validation failed"

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

-- | Used to annotate that a 'RequestTransform', or some record
-- containing a 'RequestTransform' has not yet been validated.
newtype Unvalidated a = Unvalidated {forall a. Unvalidated a -> a
_unUnvalidate :: a}
  deriving newtype (Value -> Parser [Unvalidated a]
Value -> Parser (Unvalidated a)
(Value -> Parser (Unvalidated a))
-> (Value -> Parser [Unvalidated a]) -> FromJSON (Unvalidated a)
forall a. FromJSON a => Value -> Parser [Unvalidated a]
forall a. FromJSON a => Value -> Parser (Unvalidated a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Unvalidated a)
parseJSON :: Value -> Parser (Unvalidated a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Unvalidated a]
parseJSONList :: Value -> Parser [Unvalidated a]
FromJSON, [Unvalidated a] -> Value
[Unvalidated a] -> Encoding
Unvalidated a -> Value
Unvalidated a -> Encoding
(Unvalidated a -> Value)
-> (Unvalidated a -> Encoding)
-> ([Unvalidated a] -> Value)
-> ([Unvalidated a] -> Encoding)
-> ToJSON (Unvalidated a)
forall a. ToJSON a => [Unvalidated a] -> Value
forall a. ToJSON a => [Unvalidated a] -> Encoding
forall a. ToJSON a => Unvalidated a -> Value
forall a. ToJSON a => Unvalidated a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => Unvalidated a -> Value
toJSON :: Unvalidated a -> Value
$ctoEncoding :: forall a. ToJSON a => Unvalidated a -> Encoding
toEncoding :: Unvalidated a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [Unvalidated a] -> Value
toJSONList :: [Unvalidated a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [Unvalidated a] -> Encoding
toEncodingList :: [Unvalidated a] -> Encoding
ToJSON)

-- | A lens for focusing through 'Unvalidated' in 'validateTransforms'.
unUnvalidate :: Lens' (Unvalidated a) a
unUnvalidate :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Unvalidated a -> f (Unvalidated a)
unUnvalidate = (Unvalidated a -> a)
-> (Unvalidated a -> a -> Unvalidated a)
-> Lens (Unvalidated a) (Unvalidated a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Unvalidated a -> a
forall a. Unvalidated a -> a
_unUnvalidate (\Unvalidated a
_ a
a -> a -> Unvalidated a
forall a. a -> Unvalidated a
Unvalidated a
a)

-- | Used to annotate that a higher kinded type containing a
-- 'RequestTransform' has not yet been validated.
--
-- This is needed specifically for 'CreateEventTriggerQuery' and any
-- other type that is paramterized by a 'BackendType'.
newtype Unvalidated1 (f :: k -> Type) (a :: k) = Unvalidated1 {forall k (f :: k -> *) (a :: k). Unvalidated1 f a -> f a
_unUnvalidate1 :: f a}
  deriving newtype (Value -> Parser [Unvalidated1 f a]
Value -> Parser (Unvalidated1 f a)
(Value -> Parser (Unvalidated1 f a))
-> (Value -> Parser [Unvalidated1 f a])
-> FromJSON (Unvalidated1 f a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall k (f :: k -> *) (a :: k).
FromJSON (f a) =>
Value -> Parser [Unvalidated1 f a]
forall k (f :: k -> *) (a :: k).
FromJSON (f a) =>
Value -> Parser (Unvalidated1 f a)
$cparseJSON :: forall k (f :: k -> *) (a :: k).
FromJSON (f a) =>
Value -> Parser (Unvalidated1 f a)
parseJSON :: Value -> Parser (Unvalidated1 f a)
$cparseJSONList :: forall k (f :: k -> *) (a :: k).
FromJSON (f a) =>
Value -> Parser [Unvalidated1 f a]
parseJSONList :: Value -> Parser [Unvalidated1 f a]
FromJSON, [Unvalidated1 f a] -> Value
[Unvalidated1 f a] -> Encoding
Unvalidated1 f a -> Value
Unvalidated1 f a -> Encoding
(Unvalidated1 f a -> Value)
-> (Unvalidated1 f a -> Encoding)
-> ([Unvalidated1 f a] -> Value)
-> ([Unvalidated1 f a] -> Encoding)
-> ToJSON (Unvalidated1 f a)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
[Unvalidated1 f a] -> Value
forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
[Unvalidated1 f a] -> Encoding
forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
Unvalidated1 f a -> Value
forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
Unvalidated1 f a -> Encoding
$ctoJSON :: forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
Unvalidated1 f a -> Value
toJSON :: Unvalidated1 f a -> Value
$ctoEncoding :: forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
Unvalidated1 f a -> Encoding
toEncoding :: Unvalidated1 f a -> Encoding
$ctoJSONList :: forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
[Unvalidated1 f a] -> Value
toJSONList :: [Unvalidated1 f a] -> Value
$ctoEncodingList :: forall k (f :: k -> *) (a :: k).
ToJSON (f a) =>
[Unvalidated1 f a] -> Encoding
toEncodingList :: [Unvalidated1 f a] -> Encoding
ToJSON)

-- | A lens for focusing through 'Unvalidated1' in 'validateTransforms'.
unUnvalidate1 :: Lens' (Unvalidated1 f a) (f a)
unUnvalidate1 :: forall {k} (f :: k -> *) (a :: k) (f :: * -> *).
Functor f =>
(f a -> f (f a)) -> Unvalidated1 f a -> f (Unvalidated1 f a)
unUnvalidate1 = (Unvalidated1 f a -> f a)
-> (Unvalidated1 f a -> f a -> Unvalidated1 f a)
-> Lens (Unvalidated1 f a) (Unvalidated1 f a) (f a) (f a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Unvalidated1 f a -> f a
forall k (f :: k -> *) (a :: k). Unvalidated1 f a -> f a
_unUnvalidate1 (\Unvalidated1 f a
_ f a
a -> f a -> Unvalidated1 f a
forall k (f :: k -> *) (a :: k). f a -> Unvalidated1 f a
Unvalidated1 f a
a)

-- | Used to focus into a records in 'RQLMetadataV1' and validate any
-- 'RequestTransform' terms present.
validateTransforms ::
  (MonadError QErr m) =>
  LensLike m api api RequestTransform RequestTransform ->
  LensLike m api api MetadataResponseTransform MetadataResponseTransform ->
  (api -> m EncJSON) ->
  api ->
  m EncJSON
validateTransforms :: forall (m :: * -> *) api.
MonadError QErr m =>
LensLike m api api RequestTransform RequestTransform
-> LensLike
     m api api MetadataResponseTransform MetadataResponseTransform
-> (api -> m EncJSON)
-> api
-> m EncJSON
validateTransforms LensLike m api api RequestTransform RequestTransform
focusRequestTransform LensLike
  m api api MetadataResponseTransform MetadataResponseTransform
focusResponseTransform api -> m EncJSON
f api
q =
  (api -> m api
validateResponseTransformTemplate api
q) m api -> (api -> m api) -> m api
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= api -> m api
validateRequestTransformTemplate m api -> (api -> m EncJSON) -> m EncJSON
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= api -> m EncJSON
f
  where
    validateRequestTransformTemplate :: api -> m api
validateRequestTransformTemplate = LensLike m api api RequestTransform RequestTransform
-> LensLike m api api RequestTransform RequestTransform
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike m api api RequestTransform RequestTransform
focusRequestTransform RequestTransform -> m RequestTransform
forall (m :: * -> *).
MonadError QErr m =>
RequestTransform -> m RequestTransform
validateRequestTransform
    validateResponseTransformTemplate :: api -> m api
validateResponseTransformTemplate = LensLike
  m api api MetadataResponseTransform MetadataResponseTransform
-> LensLike
     m api api MetadataResponseTransform MetadataResponseTransform
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  m api api MetadataResponseTransform MetadataResponseTransform
focusResponseTransform MetadataResponseTransform -> m MetadataResponseTransform
forall (m :: * -> *).
MonadError QErr m =>
MetadataResponseTransform -> m MetadataResponseTransform
validateResponseTransform

validateResponseTransform :: (MonadError QErr m) => MetadataResponseTransform -> m MetadataResponseTransform
validateResponseTransform :: forall (m :: * -> *).
MonadError QErr m =>
MetadataResponseTransform -> m MetadataResponseTransform
validateResponseTransform mrt :: MetadataResponseTransform
mrt@MetadataResponseTransform {Maybe BodyTransformFn
TemplatingEngine
Version
mrtVersion :: Version
mrtBodyTransform :: Maybe BodyTransformFn
mrtTemplatingEngine :: TemplatingEngine
mrtVersion :: MetadataResponseTransform -> Version
mrtBodyTransform :: MetadataResponseTransform -> Maybe BodyTransformFn
mrtTemplatingEngine :: MetadataResponseTransform -> TemplatingEngine
..} =
  case Maybe BodyTransformFn
mrtBodyTransform of
    Just BodyTransformFn
bodyTransform -> Either QErr MetadataResponseTransform
-> m MetadataResponseTransform
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr MetadataResponseTransform
 -> m MetadataResponseTransform)
-> Either QErr MetadataResponseTransform
-> m MetadataResponseTransform
forall a b. (a -> b) -> a -> b
$ (TransformErrorBundle -> QErr)
-> Either TransformErrorBundle MetadataResponseTransform
-> Either QErr MetadataResponseTransform
forall e1 e2 a. (e1 -> e2) -> Either e1 a -> Either e2 a
mapLeft TransformErrorBundle -> QErr
mkResponseQErr (Either TransformErrorBundle MetadataResponseTransform
 -> Either QErr MetadataResponseTransform)
-> Either TransformErrorBundle MetadataResponseTransform
-> Either QErr MetadataResponseTransform
forall a b. (a -> b) -> a -> b
$ Validation TransformErrorBundle MetadataResponseTransform
-> Either TransformErrorBundle MetadataResponseTransform
forall e a. Validation e a -> Either e a
toEither (Validation TransformErrorBundle MetadataResponseTransform
 -> Either TransformErrorBundle MetadataResponseTransform)
-> Validation TransformErrorBundle MetadataResponseTransform
-> Either TransformErrorBundle MetadataResponseTransform
forall a b. (a -> b) -> a -> b
$ MetadataResponseTransform
mrt MetadataResponseTransform
-> Validation TransformErrorBundle ()
-> Validation TransformErrorBundle MetadataResponseTransform
forall a b.
a
-> Validation TransformErrorBundle b
-> Validation TransformErrorBundle a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TemplatingEngine
-> BodyTransformFn -> Validation TransformErrorBundle ()
validateBodyTransformFn TemplatingEngine
mrtTemplatingEngine BodyTransformFn
bodyTransform
    Maybe BodyTransformFn
Nothing -> MetadataResponseTransform -> m MetadataResponseTransform
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataResponseTransform
mrt
  where
    mkResponseQErr :: TransformErrorBundle -> QErr
    mkResponseQErr :: TransformErrorBundle -> QErr
mkResponseQErr TransformErrorBundle
errBundle = (Code -> Text -> QErr
err400 Code
ValidationFailed Text
errMsg) {qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal Value
internalErr}
      where
        internalErr :: Value
internalErr = TransformErrorBundle -> Value
forall a. ToJSON a => a -> Value
J.toJSON TransformErrorBundle
errBundle
        errMsg :: Text
errMsg = Text
"response transform validation failed"