{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use maybe" #-}

-- | Webhook Transformations are data transformations used to modify
-- HTTP Requests/Responses before requests are executed and after
-- responses are received.
--
-- Transformations are supplied by users as part of the Metadata for a
-- particular Action or EventTrigger as a 'RequestTransform'
-- record. Per-field Transformations are stored as data
-- (defunctionalized), often in the form of a Kriti template, and then
-- converted into actual functions (reified) at runtime by the
-- 'Transform' typeclass.
--
-- We take a Higher Kinded Data (HKD) approach to representing the
-- transformations. 'RequestFields' is an HKD which can represent the
-- actual request data as 'RequestFields Identity' or the
-- defunctionalized transforms as 'RequestFields (WithOptional
-- TransformFn)'.
--
-- We can then traverse over the entire 'RequestFields' HKD to reify
-- all the fields at once and apply them to our actual request
-- data.
--
-- NOTE: We don't literally use 'traverse' or the HKD equivalent
-- 'btraverse', but you can think of this operation morally as a
-- traversal. See 'applyRequestTransform' for implementation details.
module Hasura.RQL.DDL.Webhook.Transform
  ( -- * Request Transformation
    RequestFields (..),
    RequestTransform (..),
    RequestTransformFns,
    applyRequestTransform,

    -- * Request Transformation Context
    RequestTransformCtx (..),
    RequestContext,
    mkRequestContext,
    mkReqTransformCtx,
    TransformErrorBundle (..),

    -- * Optional Functor
    WithOptional (..),
    withOptional,

    -- * Old Style Response Transforms
    MetadataResponseTransform (..),
    ResponseTransform (..),
    ResponseTransformCtx (..),
    applyResponseTransform,
    buildRespTransformCtx,
    mkResponseTransform,
  )
where

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

import Control.Lens (Lens', lens, preview, set, traverseOf, view)
import Data.Aeson.Extended qualified as J
import Data.ByteString.Lazy qualified as BL
import Data.CaseInsensitive qualified as CI
import Data.Functor.Barbie qualified as B
import Data.Text.Encoding qualified as TE
import Data.Validation qualified as V
import Hasura.Prelude hiding (first)
import Hasura.RQL.DDL.Webhook.Transform.Body (Body (..), BodyTransformFn)
import Hasura.RQL.DDL.Webhook.Transform.Body qualified as Body
import Hasura.RQL.DDL.Webhook.Transform.Class
import Hasura.RQL.DDL.Webhook.Transform.Headers
import Hasura.RQL.DDL.Webhook.Transform.Method
import Hasura.RQL.DDL.Webhook.Transform.QueryParams
import Hasura.RQL.DDL.Webhook.Transform.Request
import Hasura.RQL.DDL.Webhook.Transform.Response
import Hasura.RQL.DDL.Webhook.Transform.Url
import Hasura.RQL.Types.Webhook.Transform (MetadataResponseTransform (..), RequestContext, RequestData, RequestFields (..), RequestTransform (..), RequestTransformFns)
import Hasura.RQL.Types.Webhook.Transform.WithOptional (WithOptional (..), withOptional)
import Hasura.Session (SessionVariables)
import Network.HTTP.Client.Transformable qualified as HTTP

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

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

-- | A 'Lens\'' for viewing a 'HTTP.Request' as our 'RequestData' HKD; it does
-- so by wrapping each of the matching request fields in a corresponding
-- 'TransformFn'.
--
-- XXX: This function makes internal usage of 'TE.decodeUtf8', which throws an
-- impure exception when the supplied 'ByteString' cannot be decoded into valid
-- UTF8 text!
requestL :: Lens' HTTP.Request RequestData
requestL :: Lens' Request RequestData
requestL = (Request -> RequestData)
-> (Request -> RequestData -> Request) -> Lens' Request RequestData
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> RequestData
getter Request -> RequestData -> Request
setter
  where
    getter :: HTTP.Request -> RequestData
    getter :: Request -> RequestData
getter Request
req =
      RequestFields
        { method :: Identity Method
method = CI Text -> Identity Method
forall a b. Coercible a b => a -> b
coerce (CI Text -> Identity Method) -> CI Text -> Identity Method
forall a b. (a -> b) -> a -> b
$ Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> Text -> CI Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Getting ByteString Request ByteString -> Request -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Request ByteString
Lens' Request ByteString
HTTP.method Request
req,
          url :: Identity Url
url = Text -> Identity Url
forall a b. Coercible a b => a -> b
coerce (Text -> Identity Url) -> Text -> Identity Url
forall a b. (a -> b) -> a -> b
$ Getting Text Request Text -> Request -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Request Text
Lens' Request Text
HTTP.url Request
req,
          body :: Identity Body
body = Body -> Identity Body
forall a b. Coercible a b => a -> b
coerce (Body -> Identity Body) -> Body -> Identity Body
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Body
JSONBody (Maybe Value -> Body) -> Maybe Value -> Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decode (ByteString -> Maybe Value) -> Maybe ByteString -> Maybe Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting (First ByteString) Request ByteString
-> Request -> Maybe ByteString
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((RequestBody -> Const (First ByteString) RequestBody)
-> Request -> Const (First ByteString) Request
Lens' Request RequestBody
HTTP.body ((RequestBody -> Const (First ByteString) RequestBody)
 -> Request -> Const (First ByteString) Request)
-> ((ByteString -> Const (First ByteString) ByteString)
    -> RequestBody -> Const (First ByteString) RequestBody)
-> Getting (First ByteString) Request ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> RequestBody -> Const (First ByteString) RequestBody
Prism' RequestBody ByteString
HTTP._RequestBodyLBS) Request
req,
          queryParams :: Identity QueryParams
queryParams = Query -> Identity QueryParams
forall a b. Coercible a b => a -> b
coerce (Query -> Identity QueryParams) -> Query -> Identity QueryParams
forall a b. (a -> b) -> a -> b
$ Getting Query Request Query -> Request -> Query
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Query Request Query
Lens' Request Query
HTTP.queryParams Request
req,
          requestHeaders :: Identity Headers
requestHeaders = [Header] -> Identity Headers
forall a b. Coercible a b => a -> b
coerce ([Header] -> Identity Headers) -> [Header] -> Identity Headers
forall a b. (a -> b) -> a -> b
$ Getting [Header] Request [Header] -> Request -> [Header]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Header] Request [Header]
Lens' Request [Header]
HTTP.headers Request
req
        }

    serializeBody :: Body -> HTTP.RequestBody
    serializeBody :: Body -> RequestBody
serializeBody = \case
      JSONBody Maybe Value
body -> ByteString -> RequestBody
HTTP.RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
forall a. Monoid a => a
mempty (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Value -> ByteString) -> Maybe Value -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode Maybe Value
body
      RawBody ByteString
"" -> RequestBody
forall a. Monoid a => a
mempty
      RawBody ByteString
bs -> ByteString -> RequestBody
HTTP.RequestBodyLBS ByteString
bs

    setter :: HTTP.Request -> RequestData -> HTTP.Request
    setter :: Request -> RequestData -> Request
setter Request
req RequestFields {Identity Url
Identity QueryParams
Identity Method
Identity Headers
Identity Body
method :: forall (f :: * -> *). RequestFields f -> f Method
url :: forall (f :: * -> *). RequestFields f -> f Url
body :: forall (f :: * -> *). RequestFields f -> f Body
queryParams :: forall (f :: * -> *). RequestFields f -> f QueryParams
requestHeaders :: forall (f :: * -> *). RequestFields f -> f Headers
method :: Identity Method
url :: Identity Url
body :: Identity Body
queryParams :: Identity QueryParams
requestHeaders :: Identity Headers
..} =
      Request
req
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request ByteString ByteString
-> ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request ByteString ByteString
Lens' Request ByteString
HTTP.method (Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> Text) -> CI Text -> Text
forall a b. (a -> b) -> a -> b
$ Identity Method -> CI Text
forall a b. Coercible a b => a -> b
coerce Identity Method
method)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request RequestBody RequestBody
-> RequestBody -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request RequestBody RequestBody
Lens' Request RequestBody
HTTP.body (Body -> RequestBody
serializeBody (Body -> RequestBody) -> Body -> RequestBody
forall a b. (a -> b) -> a -> b
$ Identity Body -> Body
forall a b. Coercible a b => a -> b
coerce Identity Body
body)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request Text Text -> Text -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request Text Text
Lens' Request Text
HTTP.url (Identity Url -> Text
forall a b. Coercible a b => a -> b
coerce Identity Url
url)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request Query Query -> Query -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request Query Query
Lens' Request Query
HTTP.queryParams (QueryParams -> Query
unQueryParams (QueryParams -> Query) -> QueryParams -> Query
forall a b. (a -> b) -> a -> b
$ Identity QueryParams -> QueryParams
forall a b. Coercible a b => a -> b
coerce Identity QueryParams
queryParams)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request [Header] [Header]
-> [Header] -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request [Header] [Header]
Lens' Request [Header]
HTTP.headers (Identity Headers -> [Header]
forall a b. Coercible a b => a -> b
coerce Identity Headers
requestHeaders)

-- | Transform an 'HTTP.Request' with a 'RequestTransform'.
--
-- Note: we pass in the request url explicitly for use in the
-- 'ReqTransformCtx'. We do this so that we can ensure that the url
-- is syntactically identical to what the use submits. If we use the
-- parsed request from the 'HTTP.Request' term then it is possible
-- that the url is semantically equivalent but syntactically
-- different. An example of this is the presence or lack of a trailing
-- slash on the URL path. This important when performing string
-- interpolation on the request url.
applyRequestTransform ::
  forall m.
  (MonadError TransformErrorBundle m) =>
  (HTTP.Request -> RequestContext) ->
  RequestTransformFns ->
  HTTP.Request ->
  m HTTP.Request
applyRequestTransform :: forall (m :: * -> *).
MonadError TransformErrorBundle m =>
(Request -> RequestContext)
-> RequestTransformFns -> Request -> m Request
applyRequestTransform Request -> RequestContext
mkCtx RequestTransformFns
transformations Request
request =
  LensLike m Request Request RequestData RequestData
-> LensLike m Request Request RequestData RequestData
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf
    LensLike m Request Request RequestData RequestData
Lens' Request RequestData
requestL
    (RequestContext -> RequestData -> m RequestData
transformReqData (Request -> RequestContext
mkCtx Request
request))
    Request
request
  where
    -- Apply all of the provided request transformation functions to the
    -- request data extracted from the given 'HTTP.Request'.
    transformReqData :: RequestContext -> RequestData -> m RequestData
transformReqData RequestContext
transformCtx RequestData
reqData =
      RequestFields m -> m RequestData
forall (e :: * -> *) (b :: (* -> *) -> *).
(Applicative e, TraversableB b) =>
b e -> e (b Identity)
B.bsequence'
        (RequestFields m -> m RequestData)
-> RequestFields m -> m RequestData
forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *)
       (f :: k -> *) (g :: k -> *) (h :: k -> *) (i :: k -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall (a :: k). c a => f a -> g a -> h a -> i a)
-> b f -> b g -> b h -> b i
forall (c :: * -> Constraint) (b :: (* -> *) -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *) (i :: * -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall a. c a => f a -> g a -> h a -> i a)
-> b f -> b g -> b h -> b i
B.bzipWith3C @Transform
          TransformCtx a -> WithOptional TransformFn a -> Identity a -> m a
forall a.
Transform a =>
TransformCtx a -> WithOptional TransformFn a -> Identity a -> m a
forall {f :: * -> *} {a}.
(Transform a, MonadError TransformErrorBundle f) =>
TransformCtx a -> WithOptional TransformFn a -> Identity a -> f a
transformField
          RequestContext
transformCtx
          RequestTransformFns
transformations
          RequestData
reqData
    -- Apply a transformation to some request data, if it exists; otherwise
    -- return the original request data.
    transformField :: TransformCtx a -> WithOptional TransformFn a -> Identity a -> f a
transformField TransformCtx a
ctx (WithOptional Maybe (TransformFn a)
maybeFn) (Identity a
a) =
      case Maybe (TransformFn a)
maybeFn of
        Maybe (TransformFn a)
Nothing -> a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        Just TransformFn a
fn -> TransformFn a -> TransformCtx a -> a -> f a
forall a (m :: * -> *).
(Transform a, MonadError TransformErrorBundle m) =>
TransformFn a -> TransformCtx a -> a -> m a
forall (m :: * -> *).
MonadError TransformErrorBundle m =>
TransformFn a -> TransformCtx a -> a -> m a
transform TransformFn a
fn TransformCtx a
ctx a
a

-------------------------------------------------------------------------------
-- TODO(SOLOMON): Rewrite with HKD

-- | A set of data transformation functions generated from a
-- 'MetadataResponseTransform'. 'Nothing' means use the original
-- response value.
data ResponseTransform = ResponseTransform
  { ResponseTransform
-> Maybe
     (ResponseTransformCtx -> Either TransformErrorBundle Value)
respTransformBody :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle J.Value),
    ResponseTransform -> TemplatingEngine
respTransformTemplateEngine :: TemplatingEngine
  }

-- | A helper function for constructing the 'ResponseTransformCtx'
buildRespTransformCtx :: Maybe RequestContext -> Maybe SessionVariables -> TemplatingEngine -> BL.ByteString -> Int -> ResponseTransformCtx
buildRespTransformCtx :: Maybe RequestContext
-> Maybe SessionVariables
-> TemplatingEngine
-> ByteString
-> Int
-> ResponseTransformCtx
buildRespTransformCtx Maybe RequestContext
requestContext Maybe SessionVariables
sessionVars TemplatingEngine
engine ByteString
respBody Int
respStatusCode =
  ResponseTransformCtx
    { responseTransformBody :: Value
responseTransformBody = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
J.Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Maybe a
J.decode @J.Value ByteString
respBody,
      responseTransformReqCtx :: Value
responseTransformReqCtx = Maybe RequestContext -> Value
forall a. ToJSON a => a -> Value
J.toJSON Maybe RequestContext
requestContext,
      responseSessionVariables :: Maybe SessionVariables
responseSessionVariables = Maybe SessionVariables
sessionVars,
      responseTransformEngine :: TemplatingEngine
responseTransformEngine = TemplatingEngine
engine,
      responseStatusCode :: Int
responseStatusCode = Int
respStatusCode
    }

-- | Construct a Template Transformation function for Responses
--
-- XXX: This function makes internal usage of 'TE.decodeUtf8', which throws an
-- impure exception when the supplied 'ByteString' cannot be decoded into valid
-- UTF8 text!
mkRespTemplateTransform ::
  BodyTransformFn ->
  ResponseTransformCtx ->
  Either TransformErrorBundle J.Value
mkRespTemplateTransform :: BodyTransformFn
-> ResponseTransformCtx -> Either TransformErrorBundle Value
mkRespTemplateTransform BodyTransformFn
Body.Remove ResponseTransformCtx
_ = Value -> Either TransformErrorBundle Value
forall a. a -> Either TransformErrorBundle a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
J.Null
mkRespTemplateTransform (Body.ModifyAsJSON Template
template) ResponseTransformCtx
context =
  Template
-> ResponseTransformCtx -> Either TransformErrorBundle Value
runResponseTemplateTransform Template
template ResponseTransformCtx
context
mkRespTemplateTransform (Body.ModifyAsFormURLEncoded HashMap Text UnescapedTemplate
formTemplates) ResponseTransformCtx
context = do
  HashMap Text ByteString
result <-
    Either TransformErrorBundle (HashMap Text ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
      (Either TransformErrorBundle (HashMap Text ByteString)
 -> Either TransformErrorBundle (HashMap Text ByteString))
-> ((UnescapedTemplate
     -> Validation TransformErrorBundle ByteString)
    -> Either TransformErrorBundle (HashMap Text ByteString))
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation TransformErrorBundle (HashMap Text ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall e a. Validation e a -> Either e a
V.toEither
      (Validation TransformErrorBundle (HashMap Text ByteString)
 -> Either TransformErrorBundle (HashMap Text ByteString))
-> ((UnescapedTemplate
     -> Validation TransformErrorBundle ByteString)
    -> Validation TransformErrorBundle (HashMap Text ByteString))
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text UnescapedTemplate
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Validation TransformErrorBundle (HashMap Text ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashMap Text UnescapedTemplate
formTemplates
      ((UnescapedTemplate -> Validation TransformErrorBundle ByteString)
 -> Either TransformErrorBundle (HashMap Text ByteString))
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall a b. (a -> b) -> a -> b
$ ResponseTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedResponseTemplateTransform' ResponseTransformCtx
context
  Value -> Either TransformErrorBundle Value
forall a. a -> Either TransformErrorBundle a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either TransformErrorBundle Value)
-> (ByteString -> Value)
-> ByteString
-> Either TransformErrorBundle Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
J.String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> Either TransformErrorBundle Value)
-> ByteString -> Either TransformErrorBundle Value
forall a b. (a -> b) -> a -> b
$ HashMap Text ByteString -> ByteString
Body.foldFormEncoded HashMap Text ByteString
result

mkResponseTransform :: MetadataResponseTransform -> ResponseTransform
mkResponseTransform :: MetadataResponseTransform -> ResponseTransform
mkResponseTransform MetadataResponseTransform {Maybe BodyTransformFn
TemplatingEngine
Version
mrtVersion :: Version
mrtBodyTransform :: Maybe BodyTransformFn
mrtTemplatingEngine :: TemplatingEngine
mrtVersion :: MetadataResponseTransform -> Version
mrtBodyTransform :: MetadataResponseTransform -> Maybe BodyTransformFn
mrtTemplatingEngine :: MetadataResponseTransform -> TemplatingEngine
..} =
  let bodyTransform :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
bodyTransform = BodyTransformFn
-> ResponseTransformCtx -> Either TransformErrorBundle Value
mkRespTemplateTransform (BodyTransformFn
 -> ResponseTransformCtx -> Either TransformErrorBundle Value)
-> Maybe BodyTransformFn
-> Maybe
     (ResponseTransformCtx -> Either TransformErrorBundle Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BodyTransformFn
mrtBodyTransform
   in Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
-> TemplatingEngine -> ResponseTransform
ResponseTransform Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
bodyTransform TemplatingEngine
mrtTemplatingEngine

-- | At the moment we only transform the body of
-- Responses. 'http-client' does not export the constructors for
-- 'Response'. If we want to transform other fields then we will need
-- additional 'apply' functions.
applyResponseTransform ::
  ResponseTransform ->
  ResponseTransformCtx ->
  Either TransformErrorBundle BL.ByteString
applyResponseTransform :: ResponseTransform
-> ResponseTransformCtx -> Either TransformErrorBundle ByteString
applyResponseTransform ResponseTransform {Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
TemplatingEngine
respTransformBody :: ResponseTransform
-> Maybe
     (ResponseTransformCtx -> Either TransformErrorBundle Value)
respTransformTemplateEngine :: ResponseTransform -> TemplatingEngine
respTransformBody :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
respTransformTemplateEngine :: TemplatingEngine
..} ctx :: ResponseTransformCtx
ctx@ResponseTransformCtx {Int
Maybe SessionVariables
Value
TemplatingEngine
responseTransformBody :: ResponseTransformCtx -> Value
responseTransformReqCtx :: ResponseTransformCtx -> Value
responseSessionVariables :: ResponseTransformCtx -> Maybe SessionVariables
responseTransformEngine :: ResponseTransformCtx -> TemplatingEngine
responseStatusCode :: ResponseTransformCtx -> Int
responseTransformBody :: Value
responseTransformReqCtx :: Value
responseSessionVariables :: Maybe SessionVariables
responseTransformEngine :: TemplatingEngine
responseStatusCode :: Int
..} =
  let bodyFunc :: BL.ByteString -> Either TransformErrorBundle BL.ByteString
      bodyFunc :: ByteString -> Either TransformErrorBundle ByteString
bodyFunc ByteString
body =
        case Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
respTransformBody of
          Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
Nothing -> ByteString -> Either TransformErrorBundle ByteString
forall a. a -> Either TransformErrorBundle a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
body
          Just ResponseTransformCtx -> Either TransformErrorBundle Value
f -> Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode (Value -> ByteString)
-> Either TransformErrorBundle Value
-> Either TransformErrorBundle ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponseTransformCtx -> Either TransformErrorBundle Value
f ResponseTransformCtx
ctx
   in ByteString -> Either TransformErrorBundle ByteString
bodyFunc (Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode Value
responseTransformBody)

mkRequestContext :: RequestTransformCtx -> RequestContext
mkRequestContext :: RequestTransformCtx -> RequestContext
mkRequestContext RequestTransformCtx
ctx =
  -- NOTE: Type Applications are here for documentation purposes.
  RequestFields
    { method :: TransformCtx Method
method = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @RequestTransformCtx @(TransformCtx Method) RequestTransformCtx
ctx,
      url :: TransformCtx Url
url = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @RequestTransformCtx @(TransformCtx Url) RequestTransformCtx
ctx,
      body :: TransformCtx Body
body = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @RequestTransformCtx @(TransformCtx Body) RequestTransformCtx
ctx,
      queryParams :: TransformCtx QueryParams
queryParams = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @RequestTransformCtx @(TransformCtx QueryParams) RequestTransformCtx
ctx,
      requestHeaders :: TransformCtx Headers
requestHeaders = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @RequestTransformCtx @(TransformCtx Headers) RequestTransformCtx
ctx
    }