Webhook Transforms: Move RequestCtx into a type family

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5975
GitOrigin-RevId: 08ad528b2600379deb4cef9d39968126c7c745d8

server/graphql-engine.cabal

@@ -784,8 +784,11 @@ library
                      , Hasura.RQL.DDL.Webhook.Transform.Headers
                      , Hasura.RQL.DDL.Webhook.Transform.Method
                      , Hasura.RQL.DDL.Webhook.Transform.QueryParams
+                     , Hasura.RQL.DDL.Webhook.Transform.Response
+                     , Hasura.RQL.DDL.Webhook.Transform.Request
                      , Hasura.RQL.DDL.Webhook.Transform.Validation
                      , Hasura.RQL.DDL.Webhook.Transform.Url
+                     , Hasura.RQL.DDL.Webhook.Transform.WithOptional
                      , Hasura.RQL.DDL.SourceKinds
                      , Hasura.RQL.DDL.Schema
                      , Hasura.RQL.DDL.Schema.Cache

server/src-lib/Hasura/Eventing/HTTP.hs

@@ -63,8 +63,7 @@ import Hasura.HTTP (HttpException (..), addDefaultHeaders)
 import Hasura.Logging
 import Hasura.Prelude
 import Hasura.RQL.DDL.Headers
-import Hasura.RQL.DDL.Webhook.Transform
+import Hasura.RQL.DDL.Webhook.Transform qualified as Transform
-import Hasura.RQL.DDL.Webhook.Transform.Class (mkReqTransformCtx)
 import Hasura.RQL.Types.Common (ResolvedWebhook (..))
 import Hasura.RQL.Types.EventTrigger
 import Hasura.RQL.Types.Eventing
@@ -143,7 +142,7 @@ data RequestDetails = RequestDetails
     _rdOriginalSize :: Int64,
     _rdTransformedRequest :: Maybe HTTP.Request,
     _rdTransformedSize :: Maybe Int64,
-    _rdReqTransformCtx :: Maybe RequestTransformCtx,
+    _rdReqTransformCtx :: Maybe Transform.RequestContext,
     _rdSessionVars :: Maybe SessionVariables
   }
 
@@ -276,7 +275,7 @@ runHTTP manager req = do
 
 data TransformableRequestError a
   = HTTPError J.Value (HTTPErr a)
-  | TransformationError J.Value TransformErrorBundle
+  | TransformationError J.Value Transform.TransformErrorBundle
   deriving (Show)
 
 mkRequest ::
@@ -287,7 +286,7 @@ mkRequest ::
   -- log the request size. As the logging happens outside the function, we pass
   -- it the final request body, instead of 'Value'
   LBS.ByteString ->
-  Maybe RequestTransform ->
+  Maybe Transform.RequestTransform ->
   ResolvedWebhook ->
   m RequestDetails
 mkRequest headers timeout payload mRequestTransform (ResolvedWebhook webhook) =
@@ -309,13 +308,14 @@ mkRequest headers timeout payload mRequestTransform (ResolvedWebhook webhook) =
            in case mRequestTransform of
                 Nothing ->
                   pure $ RequestDetails req (LBS.length payload) Nothing Nothing Nothing sessionVars
-                Just RequestTransform {..} ->
+                Just Transform.RequestTransform {..} ->
-                  let reqTransformCtx = mkReqTransformCtx webhook sessionVars templateEngine
+                  let reqTransformCtx = Transform.mkReqTransformCtx webhook sessionVars templateEngine
-                   in case applyRequestTransform reqTransformCtx requestFields req of
+                      requestContext = fmap Transform.mkRequestContext reqTransformCtx
+                   in case Transform.applyRequestTransform requestContext requestFields req of
                         Left err -> throwError $ TransformationError body err
                         Right transformedReq ->
                           let transformedReqSize = HTTP.getReqSize transformedReq
-                           in pure $ RequestDetails req (LBS.length payload) (Just transformedReq) (Just transformedReqSize) (Just $ reqTransformCtx req) sessionVars
+                           in pure $ RequestDetails req (LBS.length payload) (Just transformedReq) (Just transformedReqSize) (Just $ requestContext req) sessionVars
 
 invokeRequest ::
   ( MonadReader r m,
@@ -326,7 +326,7 @@ invokeRequest ::
     MonadTrace m
   ) =>
   RequestDetails ->
-  Maybe ResponseTransform ->
+  Maybe Transform.ResponseTransform ->
   Maybe SessionVariables ->
   ((Either (HTTPErr a) (HTTPResp a)) -> RequestDetails -> m ()) ->
   m (HTTPResp a)
@@ -343,9 +343,9 @@ invokeRequest reqDetails@RequestDetails {..} respTransform' sessionVars logger =
     Nothing -> pure resp
     Just respTransform -> do
       let respBody = SB.toLBS $ hrsBody resp
-          engine = respTransformTemplateEngine respTransform
+          engine = Transform.respTransformTemplateEngine respTransform
-          respTransformCtx = buildRespTransformCtx _rdReqTransformCtx sessionVars engine respBody
+          respTransformCtx = Transform.buildRespTransformCtx _rdReqTransformCtx sessionVars engine respBody
-       in case applyResponseTransform respTransform respTransformCtx of
+       in case Transform.applyResponseTransform respTransform respTransformCtx of
             Left err -> do
               -- Log The Response Transformation Error
               logger' :: Logger Hasura <- asks getter

server/src-lib/Hasura/GraphQL/Execute/Action.hs

@@ -60,7 +60,6 @@ import Hasura.Name qualified as Name
 import Hasura.Prelude
 import Hasura.RQL.DDL.Headers
 import Hasura.RQL.DDL.Webhook.Transform
-import Hasura.RQL.DDL.Webhook.Transform.Class (mkReqTransformCtx)
 import Hasura.RQL.IR.Action qualified as IR
 import Hasura.RQL.IR.BoolExp
 import Hasura.RQL.IR.Select qualified as RS
@@ -557,7 +556,7 @@ callWebhook
     (transformedReq, transformedReqSize, reqTransformCtx) <- case metadataRequestTransform of
       Nothing -> pure (Nothing, Nothing, Nothing)
       Just RequestTransform {..} ->
-        let reqTransformCtx = mkReqTransformCtx webhookUrl sessionVars templateEngine
+        let reqTransformCtx = fmap mkRequestContext $ mkReqTransformCtx webhookUrl sessionVars templateEngine
          in case applyRequestTransform reqTransformCtx requestFields req of
               Left err -> do
                 -- Log The Transformation Error

server/src-lib/Hasura/RQL/DDL/Metadata.hs

@@ -60,7 +60,6 @@ import Hasura.RQL.DDL.ScheduledTrigger
 import Hasura.RQL.DDL.Schema
 import Hasura.RQL.DDL.Schema.Source
 import Hasura.RQL.DDL.Webhook.Transform
-import Hasura.RQL.DDL.Webhook.Transform.Class (mkReqTransformCtx)
 import Hasura.RQL.Types.Allowlist
 import Hasura.RQL.Types.ApiLimit
 import Hasura.RQL.Types.Backend
@@ -682,7 +681,7 @@ runTestWebhookTransform (TestWebhookTransform env headers urlE payload rt _ sv)
     let req = initReq & HTTP.body .~ pure (J.encode payload) & HTTP.headers .~ headers'
         reqTransform = requestFields rt
         engine = templateEngine rt
-        reqTransformCtx = mkReqTransformCtx url sv engine
+        reqTransformCtx = fmap mkRequestContext $ mkReqTransformCtx url sv engine
     hoistEither $ first (RequestTransformationError req) $ applyRequestTransform reqTransformCtx reqTransform req
 
   case result of

server/src-lib/Hasura/RQL/DDL/Webhook/Transform.hs

@@ -34,6 +34,9 @@ module Hasura.RQL.DDL.Webhook.Transform
 
     -- * Request Transformation Context
     RequestTransformCtx (..),
+    RequestContext,
+    mkRequestContext,
+    mkReqTransformCtx,
     TransformErrorBundle (..),
 
     -- * Optional Functor
@@ -54,12 +57,10 @@ where
 
 import Control.Lens (Lens', lens, set, traverseOf, view)
 import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson.Extended qualified as J
+import Data.Aeson.Extended ((.!=), (.:?), (.=), (.=?))
-import Data.Aeson.Kriti.Functions qualified as KFunc
+import Data.Aeson.Extended qualified as Aeson
-import Data.Bifunctor (first)
 import Data.ByteString.Lazy qualified as BL
 import Data.CaseInsensitive qualified as CI
-import Data.Coerce (Coercible)
 import Data.Functor.Barbie (AllBF, ApplicativeB, ConstraintsB, FunctorB, TraversableB)
 import Data.Functor.Barbie qualified as B
 import Data.Text.Encoding qualified as TE
@@ -69,10 +70,13 @@ import Hasura.Prelude hiding (first)
 import Hasura.RQL.DDL.Webhook.Transform.Body (Body (..), BodyTransformFn, TransformFn (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 (Headers (..), HeadersTransformFn (..), TransformFn (HeadersTransformFn_))
+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.DDL.Webhook.Transform.WithOptional (WithOptional (..), withOptional)
 import Hasura.Session (SessionVariables)
 import Network.HTTP.Client.Transformable qualified as HTTP
 
@@ -93,17 +97,17 @@ data RequestTransform = RequestTransform
   deriving anyclass (NFData, Cacheable)
 
 instance FromJSON RequestTransform where
-  parseJSON = J.withObject "RequestTransform" \o -> do
+  parseJSON = Aeson.withObject "RequestTransform" \o -> do
-    version <- o J..:? "version" J..!= V1
+    version <- o .:? "version" .!= V1
-    method <- o J..:? "method"
+    method <- o .:? "method"
-    url <- o J..:? "url"
+    url <- o .:? "url"
     body <- case version of
       V1 -> do
-        template :: Maybe Template <- o J..:? "body"
+        template :: Maybe Template <- o .:? "body"
         pure $ fmap Body.ModifyAsJSON template
-      V2 -> o J..:? "body"
+      V2 -> o .:? "body"
-    queryParams <- o J..:? "query_params"
+    queryParams <- o .:? "query_params"
-    headers <- o J..:? "request_headers"
+    headers <- o .:? "request_headers"
     let requestFields =
           RequestFields
             { method = withOptional @MethodTransformFn method,
@@ -112,7 +116,7 @@ instance FromJSON RequestTransform where
               queryParams = withOptional @QueryParamsTransformFn queryParams,
               requestHeaders = withOptional @HeadersTransformFn headers
             }
-    templateEngine <- o J..:? "template_engine" J..!= Kriti
+    templateEngine <- o .:? "template_engine" .!= Kriti
     pure $ RequestTransform {..}
 
 instance ToJSON RequestTransform where
@@ -121,24 +125,24 @@ instance ToJSON RequestTransform where
         body' = case version of
           V1 -> case (getOptional body) of
             Just (BodyTransformFn_ (Body.ModifyAsJSON template)) ->
-              Just ("body", J.toJSON template)
+              Just ("body", Aeson.toJSON template)
             _ -> Nothing
-          V2 -> "body" J..=? getOptional body
+          V2 -> "body" .=? getOptional body
-     in J.object $
+     in Aeson.object $
-          [ "version" J..= version,
+          [ "version" .= version,
-            "template_engine" J..= templateEngine
+            "template_engine" .= templateEngine
           ]
             <> catMaybes
-              [ "method" J..=? getOptional method,
+              [ "method" .=? getOptional method,
-                "url" J..=? getOptional url,
+                "url" .=? getOptional url,
-                "query_params" J..=? getOptional queryParams,
+                "query_params" .=? getOptional queryParams,
-                "request_headers" J..=? getOptional requestHeaders,
+                "request_headers" .=? getOptional requestHeaders,
                 body'
               ]
 
 -------------------------------------------------------------------------------
 
--- | Defunctionalized Webhook Transformation
+-- | Defunctionalized Webhook Request Transformation
 --
 -- We represent a defunctionalized request transformation by parameterizing
 -- our HKD with 'WithOptional'@ @'TransformFn', which marks each of the fields
@@ -184,12 +188,12 @@ deriving anyclass instance
 -- NOTE: It is likely that we can derive these instances. Possibly if
 -- we move the aeson instances onto the *Transform types.
 instance FromJSON RequestTransformFns where
-  parseJSON = J.withObject "RequestTransformFns" $ \o -> do
+  parseJSON = Aeson.withObject "RequestTransformFns" $ \o -> do
-    method <- o J..:? "method"
+    method <- o .:? "method"
-    url <- o J..:? "url"
+    url <- o .:? "url"
-    body <- o J..:? "body"
+    body <- o .:? "body"
-    queryParams <- o J..:? "query_params"
+    queryParams <- o .:? "query_params"
-    headers <- o J..:? "request_headers"
+    headers <- o .:? "request_headers"
     pure $
       RequestFields
         { method = withOptional @MethodTransformFn method,
@@ -201,14 +205,37 @@ instance FromJSON RequestTransformFns where
 
 instance ToJSON RequestTransformFns where
   toJSON RequestFields {..} =
-    J.object . catMaybes $
+    Aeson.object . catMaybes $
-      [ "method" J..=? getOptional method,
+      [ "method" .=? getOptional method,
-        "url" J..=? getOptional url,
+        "url" .=? getOptional url,
-        "body" J..=? getOptional body,
+        "body" .=? getOptional body,
-        "query_params" J..=? getOptional queryParams,
+        "query_params" .=? getOptional queryParams,
-        "request_headers" J..=? getOptional requestHeaders
+        "request_headers" .=? getOptional requestHeaders
       ]
 
+type RequestContext = RequestFields TransformCtx
+
+instance ToJSON RequestContext where
+  toJSON RequestFields {..} =
+    Aeson.object
+      [ "method" .= coerce @_ @RequestTransformCtx method,
+        "url" .= coerce @_ @RequestTransformCtx url,
+        "body" .= coerce @_ @RequestTransformCtx body,
+        "query_params" .= coerce @_ @RequestTransformCtx queryParams,
+        "request_headers" .= coerce @_ @RequestTransformCtx requestHeaders
+      ]
+
+mkRequestContext :: RequestTransformCtx -> RequestContext
+mkRequestContext ctx =
+  -- NOTE: Type Applications are here for documentation purposes.
+  RequestFields
+    { method = coerce @RequestTransformCtx @(TransformCtx Method) ctx,
+      url = coerce @RequestTransformCtx @(TransformCtx Url) ctx,
+      body = coerce @RequestTransformCtx @(TransformCtx Body) ctx,
+      queryParams = coerce @RequestTransformCtx @(TransformCtx QueryParams) ctx,
+      requestHeaders = coerce @RequestTransformCtx @(TransformCtx Headers) ctx
+    }
+
 -------------------------------------------------------------------------------
 
 -- TODO(SOLOMON): Add lens law unit tests
@@ -228,14 +255,14 @@ requestL = lens getter setter
       RequestFields
         { method = coerce $ CI.mk $ TE.decodeUtf8 $ view HTTP.method req,
           url = coerce $ view HTTP.url req,
-          body = coerce $ JSONBody $ J.decode =<< view HTTP.body req,
+          body = coerce $ JSONBody $ Aeson.decode =<< view HTTP.body req,
           queryParams = coerce $ view HTTP.queryParams req,
           requestHeaders = coerce $ view HTTP.headers req
         }
 
     serializeBody :: Body -> Maybe BL.ByteString
     serializeBody = \case
-      JSONBody body -> fmap J.encode body
+      JSONBody body -> fmap Aeson.encode body
       RawBody "" -> Nothing
       RawBody bs -> Just bs
 
@@ -260,7 +287,7 @@ requestL = lens getter setter
 applyRequestTransform ::
   forall m.
   MonadError TransformErrorBundle m =>
-  (HTTP.Request -> RequestTransformCtx) ->
+  (HTTP.Request -> RequestContext) ->
   RequestTransformFns ->
   HTTP.Request ->
   m HTTP.Request
@@ -272,10 +299,11 @@ applyRequestTransform mkCtx transformations request =
   where
     -- Apply all of the provided request transformation functions to the
     -- request data extracted from the given 'HTTP.Request'.
-    transformReqData ctx reqData =
+    transformReqData transformCtx reqData =
       B.bsequence' $
-        B.bzipWithC @Transform
+        B.bzipWith3C @Transform
-          (transformField ctx)
+          transformField
+          transformCtx
           transformations
           reqData
     -- Apply a transformation to some request data, if it exists; otherwise
@@ -285,44 +313,6 @@ applyRequestTransform mkCtx transformations request =
         Nothing -> pure a
         Just fn -> transform fn ctx a
 
--------------------------------------------------------------------------------
-
--- | Enrich a 'Functor' @f@ with optionality; this is primarily useful when
--- one wants to annotate fields as optional when using the Higher-Kinded Data
--- pattern.
---
--- 'WithOptional'@ f@ is equivalent to @Compose Maybe f@.
-newtype WithOptional f result = WithOptional
-  { getOptional :: Maybe (f result)
-  }
-  deriving stock (Eq, Functor, Foldable, Generic, Show)
-  deriving newtype (FromJSON, ToJSON)
-
-deriving newtype instance
-  (Cacheable (f result)) =>
-  Cacheable (WithOptional f result)
-
-deriving newtype instance
-  (NFData (f result)) =>
-  NFData (WithOptional f result)
-
--- | 'WithOptional' smart constructor for the special case of optional values
--- that are representationally equivalent to some "wrapper" type.
---
--- For example:
--- @
--- withOptional \@HeaderTransformsAction headers == WithOptional $ fmap HeadersTransform headers
--- @
---
--- In other words: this function observes the isomorphism between @'Maybe' a@
--- and  @'WithOptional' f b@ if an isomorphism exists between @a@ and @f b@.
-withOptional ::
-  forall a b f.
-  Coercible a (f b) =>
-  Maybe a ->
-  WithOptional f b
-withOptional = coerce
-
 -------------------------------------------------------------------------------
 -- TODO(SOLOMON): Rewrite with HKD
 
@@ -330,7 +320,7 @@ withOptional = coerce
 -- 'MetadataResponseTransform'. 'Nothing' means use the original
 -- response value.
 data ResponseTransform = ResponseTransform
-  { respTransformBody :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle J.Value),
+  { respTransformBody :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle Aeson.Value),
     respTransformTemplateEngine :: TemplatingEngine
   }
 
@@ -342,39 +332,39 @@ data MetadataResponseTransform = MetadataResponseTransform
   deriving stock (Show, Eq, Generic)
   deriving anyclass (NFData, Cacheable)
 
-instance J.FromJSON MetadataResponseTransform where
+instance FromJSON MetadataResponseTransform where
-  parseJSON = J.withObject "MetadataResponseTransform" $ \o -> do
+  parseJSON = Aeson.withObject "MetadataResponseTransform" $ \o -> do
-    mrtVersion <- o J..:? "version" J..!= V1
+    mrtVersion <- o .:? "version" .!= V1
     mrtBodyTransform <- case mrtVersion of
       V1 -> do
-        template :: (Maybe Template) <- o J..:? "body"
+        template :: (Maybe Template) <- o .:? "body"
         pure $ fmap Body.ModifyAsJSON template
-      V2 -> o J..:? "body"
+      V2 -> o .:? "body"
-    templateEngine <- o J..:? "template_engine"
+    templateEngine <- o .:? "template_engine"
     let mrtTemplatingEngine = fromMaybe Kriti templateEngine
     pure $ MetadataResponseTransform {..}
 
-instance J.ToJSON MetadataResponseTransform where
+instance ToJSON MetadataResponseTransform where
   toJSON MetadataResponseTransform {..} =
     let body = case mrtVersion of
           V1 -> case mrtBodyTransform of
-            Just (Body.ModifyAsJSON template) -> Just ("body", J.toJSON template)
+            Just (Body.ModifyAsJSON template) -> Just ("body", Aeson.toJSON template)
             _ -> Nothing
-          V2 -> "body" J..=? mrtBodyTransform
+          V2 -> "body" .=? mrtBodyTransform
-     in J.object $
+     in Aeson.object $
-          [ "template_engine" J..= mrtTemplatingEngine,
+          [ "template_engine" .= mrtTemplatingEngine,
-            "version" J..= mrtVersion
+            "version" .= mrtVersion
           ]
-            <> catMaybes [body]
+            <> maybeToList body
 
--- | A helper function for constructing the 'RespTransformCtx'
+-- | A helper function for constructing the 'ResponseTransformCtx'
-buildRespTransformCtx :: Maybe RequestTransformCtx -> Maybe SessionVariables -> TemplatingEngine -> BL.ByteString -> ResponseTransformCtx
+buildRespTransformCtx :: Maybe RequestContext -> Maybe SessionVariables -> TemplatingEngine -> BL.ByteString -> ResponseTransformCtx
-buildRespTransformCtx reqCtx sessionVars engine respBody =
+buildRespTransformCtx requestContext sessionVars engine respBody =
   ResponseTransformCtx
-    { responseTransformBody = fromMaybe J.Null $ J.decode @J.Value respBody,
+    { responseTransformBody = fromMaybe Aeson.Null $ Aeson.decode @Aeson.Value respBody,
-      responseTransformReqCtx = J.toJSON reqCtx,
+      responseTransformReqCtx = Aeson.toJSON requestContext,
-      responseTransformEngine = engine,
+      responseSessionVariables = sessionVars,
-      responseTransformFunctions = KFunc.sessionFunctions sessionVars
+      responseTransformEngine = engine
     }
 
 -- | Construct a Template Transformation function for Responses
@@ -383,32 +373,27 @@ buildRespTransformCtx reqCtx sessionVars engine respBody =
 -- impure exception when the supplied 'ByteString' cannot be decoded into valid
 -- UTF8 text!
 mkRespTemplateTransform ::
-  TemplatingEngine ->
   BodyTransformFn ->
   ResponseTransformCtx ->
-  Either TransformErrorBundle J.Value
+  Either TransformErrorBundle Aeson.Value
-mkRespTemplateTransform _ Body.Remove _ = pure J.Null
+mkRespTemplateTransform Body.Remove _ = pure Aeson.Null
-mkRespTemplateTransform engine (Body.ModifyAsJSON (Template template)) ResponseTransformCtx {..} =
+mkRespTemplateTransform (Body.ModifyAsJSON template) context =
-  let context = [("$body", responseTransformBody), ("$request", responseTransformReqCtx)]
+  runResponseTemplateTransform template context
-   in case engine of
+mkRespTemplateTransform (Body.ModifyAsFormURLEncoded formTemplates) context = do
-        Kriti -> first (TransformErrorBundle . pure . J.toJSON) $ KFunc.runKriti template context
+  result <-
-mkRespTemplateTransform engine (Body.ModifyAsFormURLEncoded formTemplates) context =
+    liftEither . V.toEither . for formTemplates $
-  case engine of
+      runUnescapedResponseTemplateTransform' context
-    Kriti -> do
+  pure . Aeson.String . TE.decodeUtf8 . BL.toStrict $ Body.foldFormEncoded result
-      result <-
-        liftEither . V.toEither . for formTemplates $
-          runUnescapedResponseTemplateTransform' context
-      pure . J.String . TE.decodeUtf8 . BL.toStrict $ Body.foldFormEncoded result
 
 mkResponseTransform :: MetadataResponseTransform -> ResponseTransform
 mkResponseTransform MetadataResponseTransform {..} =
-  let bodyTransform = mkRespTemplateTransform mrtTemplatingEngine <$> mrtBodyTransform
+  let bodyTransform = mkRespTemplateTransform <$> mrtBodyTransform
    in ResponseTransform bodyTransform 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 then we will need additional
+-- 'Response'. If we want to transform other fields then we will need
--- 'apply' functions.
+-- additional 'apply' functions.
 applyResponseTransform ::
   ResponseTransform ->
   ResponseTransformCtx ->
@@ -418,5 +403,5 @@ applyResponseTransform ResponseTransform {..} ctx@ResponseTransformCtx {..} =
       bodyFunc body =
         case respTransformBody of
           Nothing -> pure body
-          Just f -> J.encode <$> f ctx
+          Just f -> Aeson.encode <$> f ctx
-   in bodyFunc (J.encode responseTransformBody)
+   in bodyFunc (Aeson.encode responseTransformBody)

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/Body.hs

@@ -5,6 +5,7 @@ module Hasura.RQL.DDL.Webhook.Transform.Body
   ( -- * Body Transformations
     Body (..),
     TransformFn (..),
+    TransformCtx (..),
     BodyTransformFn (..),
     foldFormEncoded,
   )
@@ -25,12 +26,14 @@ import Data.Validation qualified as V
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class
-  ( RequestTransformCtx (..),
+  ( Template (..),
-    Template (..),
     TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
     UnescapedTemplate,
+  )
+import Hasura.RQL.DDL.Webhook.Transform.Request
+  ( RequestTransformCtx,
     runRequestTemplateTransform,
     runUnescapedRequestTemplateTransform',
     validateRequestTemplateTransform',
@@ -53,9 +56,11 @@ instance Transform Body where
     deriving stock (Eq, Generic, Show)
     deriving newtype (Cacheable, NFData, FromJSON, ToJSON)
 
+  newtype TransformCtx Body = TransformCtx RequestTransformCtx
+
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'applyBodyTransformFn' is defined separately.
-  transform (BodyTransformFn_ fn) = applyBodyTransformFn fn
+  transform (BodyTransformFn_ fn) (TransformCtx reqCtx) = applyBodyTransformFn fn reqCtx
 
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'validateBodyTransformFn' is defined

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/Class.hs

@@ -12,53 +12,30 @@ module Hasura.RQL.DDL.Webhook.Transform.Class
     TransformErrorBundle (..),
     throwErrorBundle,
 
-    -- ** Request Transformation Context
-    RequestTransformCtx (..),
-    ResponseTransformCtx (..),
-    mkReqTransformCtx,
-
     -- * Templating
     TemplatingEngine (..),
     Template (..),
-    Version (..),
-    runRequestTemplateTransform,
-    validateRequestTemplateTransform,
-    validateRequestTemplateTransform',
 
     -- * Unescaped
     UnescapedTemplate (..),
     wrapUnescapedTemplate,
-    runUnescapedRequestTemplateTransform,
+    encodeScalar,
-    runUnescapedRequestTemplateTransform',
-    runUnescapedResponseTemplateTransform,
-    runUnescapedResponseTemplateTransform',
-    validateRequestUnescapedTemplateTransform,
-    validateRequestUnescapedTemplateTransform',
   )
 where
 
 -------------------------------------------------------------------------------
 
-import Control.Arrow (left)
-import Control.Lens (bimap, view)
 import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
 import Data.Aeson qualified as J
-import Data.Aeson.Kriti.Functions as KFunc
 import Data.ByteString (ByteString)
 import Data.ByteString.Builder (toLazyByteString)
 import Data.ByteString.Builder.Scientific (scientificBuilder)
 import Data.ByteString.Lazy qualified as LBS
-import Data.HashMap.Strict qualified as M
 import Data.Kind (Constraint, Type)
 import Data.Text.Encoding (encodeUtf8)
-import Data.Text.Encoding qualified as TE
+import Data.Validation (Validation)
-import Data.Validation (Validation, fromEither)
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
-import Hasura.Session (SessionVariables)
-import Kriti.Error qualified as Kriti (CustomFunctionError (..), serialize)
-import Kriti.Parser qualified as Kriti (parser)
-import Network.HTTP.Client.Transformable qualified as HTTP
 
 -------------------------------------------------------------------------------
 
@@ -73,6 +50,8 @@ class Transform a where
   -- the transformation.
   data TransformFn a :: Type
 
+  data TransformCtx a :: Type
+
   -- | 'transform' is a function which takes 'TransformFn' of @a@ and reifies
   -- it into a function of the form:
   --
@@ -82,7 +61,7 @@ class Transform a where
   transform ::
     MonadError TransformErrorBundle m =>
     TransformFn a ->
-    RequestTransformCtx ->
+    TransformCtx a ->
     a ->
     m a
 
@@ -121,69 +100,6 @@ throwErrorBundle msg val = do
 
 -------------------------------------------------------------------------------
 
--- | Common context that is made available to all request transformations.
-data RequestTransformCtx = RequestTransformCtx
-  { rtcBaseUrl :: Maybe J.Value,
-    rtcBody :: J.Value,
-    rtcSessionVariables :: J.Value,
-    rtcQueryParams :: Maybe J.Value,
-    rtcEngine :: TemplatingEngine,
-    rtcFunctions :: M.HashMap Text (J.Value -> Either Kriti.CustomFunctionError J.Value)
-  }
-
-instance ToJSON RequestTransformCtx where
-  toJSON RequestTransformCtx {..} =
-    let required =
-          [ "body" J..= rtcBody,
-            "session_variables" J..= rtcSessionVariables
-          ]
-        optional =
-          [ ("base_url" J..=) <$> rtcBaseUrl,
-            ("query_params" J..=) <$> rtcQueryParams
-          ]
-     in J.object (required <> catMaybes optional)
-
--- | A smart constructor for constructing the 'RequestTransformCtx'
---
--- 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!
-mkReqTransformCtx ::
-  Text ->
-  Maybe SessionVariables ->
-  TemplatingEngine ->
-  HTTP.Request ->
-  RequestTransformCtx
-mkReqTransformCtx url sessionVars rtcEngine reqData =
-  let rtcBaseUrl = Just $ J.toJSON url
-      rtcBody =
-        let mBody = view HTTP.body reqData >>= J.decode @J.Value
-         in fromMaybe J.Null mBody
-      rtcSessionVariables = J.toJSON sessionVars
-      rtcQueryParams =
-        let queryParams =
-              view HTTP.queryParams reqData & fmap \(key, val) ->
-                (TE.decodeUtf8 key, fmap TE.decodeUtf8 val)
-         in Just $ J.toJSON queryParams
-   in RequestTransformCtx
-        { rtcBaseUrl,
-          rtcBody,
-          rtcSessionVariables,
-          rtcQueryParams,
-          rtcEngine,
-          rtcFunctions = KFunc.sessionFunctions sessionVars
-        }
-
--- | Common context that is made available to all response transformations.
-data ResponseTransformCtx = ResponseTransformCtx
-  { responseTransformBody :: J.Value,
-    responseTransformReqCtx :: J.Value,
-    responseTransformFunctions :: M.HashMap Text (J.Value -> Either Kriti.CustomFunctionError J.Value),
-    responseTransformEngine :: TemplatingEngine
-  }
-
--------------------------------------------------------------------------------
-
 -- | Available templating engines.
 data TemplatingEngine
   = Kriti
@@ -226,86 +142,6 @@ instance J.FromJSON Template where
 instance J.ToJSON Template where
   toJSON = J.String . coerce
 
--- | A helper function for executing transformations from a 'Template'
--- and a 'RequestTransformCtx'.
---
--- NOTE: This and all related funtions are hard-coded to Kriti at the
--- moment. When we add additional template engines this function will
--- need to take a 'TemplatingEngine' parameter.
-runRequestTemplateTransform ::
-  Template ->
-  RequestTransformCtx ->
-  Either TransformErrorBundle J.Value
-runRequestTemplateTransform template RequestTransformCtx {rtcEngine = Kriti, ..} =
-  let context =
-        [ ("$body", rtcBody),
-          ("$session_variables", rtcSessionVariables)
-        ]
-          <> catMaybes
-            [ ("$query_params",) <$> rtcQueryParams,
-              ("$base_url",) <$> rtcBaseUrl
-            ]
-      eResult = KFunc.runKritiWith (unTemplate $ template) context rtcFunctions
-   in eResult & left \kritiErr ->
-        let renderedErr = J.toJSON kritiErr
-         in TransformErrorBundle [renderedErr]
-
--- TODO: Should this live in 'Hasura.RQL.DDL.Webhook.Transform.Validation'?
-validateRequestTemplateTransform ::
-  TemplatingEngine ->
-  Template ->
-  Either TransformErrorBundle ()
-validateRequestTemplateTransform Kriti (Template template) =
-  bimap packBundle (const ()) $ Kriti.parser $ TE.encodeUtf8 template
-  where
-    packBundle = TransformErrorBundle . pure . J.toJSON . Kriti.serialize
-
-validateRequestTemplateTransform' ::
-  TemplatingEngine ->
-  Template ->
-  Validation TransformErrorBundle ()
-validateRequestTemplateTransform' engine =
-  fromEither . validateRequestTemplateTransform engine
-
--- | A helper function for executing transformations from a 'Template'
--- and a 'ResponseTransformCtx'.
---
--- NOTE: This and all related funtions are hard-coded to Kriti at the
--- moment. When we add additional template engines this function will
--- need to take a 'TemplatingEngine' parameter.
-runResponseTemplateTransform ::
-  Template ->
-  ResponseTransformCtx ->
-  Either TransformErrorBundle J.Value
-runResponseTemplateTransform template ResponseTransformCtx {responseTransformEngine = Kriti, ..} =
-  let context = [("$body", responseTransformBody), ("$request", responseTransformReqCtx)]
-      eResult = KFunc.runKritiWith (unTemplate $ template) context responseTransformFunctions
-   in eResult & left \kritiErr ->
-        let renderedErr = J.toJSON kritiErr
-         in TransformErrorBundle [renderedErr]
-
--------------------------------------------------------------------------------
-
--- | 'RequestTransform' Versioning
-data Version
-  = V1
-  | V2
-  deriving stock (Eq, Generic, Show)
-  deriving anyclass (Cacheable, Hashable, NFData)
-
-instance J.FromJSON Version where
-  parseJSON v = do
-    version :: Int <- J.parseJSON v
-    case version of
-      1 -> pure V1
-      2 -> pure V2
-      i -> fail $ "expected 1 or 2, encountered " ++ show i
-
-instance J.ToJSON Version where
-  toJSON = \case
-    V1 -> J.toJSON @Int 1
-    V2 -> J.toJSON @Int 2
-
 -------------------------------------------------------------------------------
 
 -- | Validated textual transformation template /for string
@@ -330,66 +166,6 @@ instance J.ToJSON UnescapedTemplate where
 wrapUnescapedTemplate :: UnescapedTemplate -> Template
 wrapUnescapedTemplate (UnescapedTemplate txt) = Template $ "\"" <> txt <> "\""
 
--- | A helper function for executing Kriti transformations from a
--- 'UnescapedTemplate' and a 'RequestTrasformCtx'.
---
--- The difference from 'runRequestTemplateTransform' is that this
--- function will wrap the template text in double quotes before
--- running Kriti.
-runUnescapedRequestTemplateTransform ::
-  RequestTransformCtx ->
-  UnescapedTemplate ->
-  Either TransformErrorBundle ByteString
-runUnescapedRequestTemplateTransform context unescapedTemplate = do
-  result <-
-    runRequestTemplateTransform
-      (wrapUnescapedTemplate unescapedTemplate)
-      context
-  encodeScalar result
-
--- | Run a Kriti transformation with an unescaped template in
--- 'Validation' instead of 'Either'.
-runUnescapedRequestTemplateTransform' ::
-  RequestTransformCtx ->
-  UnescapedTemplate ->
-  Validation TransformErrorBundle ByteString
-runUnescapedRequestTemplateTransform' context unescapedTemplate =
-  fromEither $
-    runUnescapedRequestTemplateTransform context unescapedTemplate
-
--- TODO: Should this live in 'Hasura.RQL.DDL.Webhook.Transform.Validation'?
-validateRequestUnescapedTemplateTransform ::
-  TemplatingEngine ->
-  UnescapedTemplate ->
-  Either TransformErrorBundle ()
-validateRequestUnescapedTemplateTransform engine =
-  validateRequestTemplateTransform engine . wrapUnescapedTemplate
-
-validateRequestUnescapedTemplateTransform' ::
-  TemplatingEngine ->
-  UnescapedTemplate ->
-  Validation TransformErrorBundle ()
-validateRequestUnescapedTemplateTransform' engine =
-  fromEither . validateRequestUnescapedTemplateTransform engine
-
--- | Run an 'UnescapedTemplate' with a 'ResponseTransformCtx'.
-runUnescapedResponseTemplateTransform ::
-  ResponseTransformCtx ->
-  UnescapedTemplate ->
-  Either TransformErrorBundle ByteString
-runUnescapedResponseTemplateTransform context unescapedTemplate = do
-  result <- runResponseTemplateTransform (wrapUnescapedTemplate unescapedTemplate) context
-  encodeScalar result
-
--- | Run an 'UnescapedTemplate' with a 'ResponseTransformCtx' in 'Validation'.
-runUnescapedResponseTemplateTransform' ::
-  ResponseTransformCtx ->
-  UnescapedTemplate ->
-  Validation TransformErrorBundle ByteString
-runUnescapedResponseTemplateTransform' context unescapedTemplate =
-  fromEither $
-    runUnescapedResponseTemplateTransform context unescapedTemplate
-
 -------------------------------------------------------------------------------
 -- Utility functions.
 

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/Headers.hs

@@ -6,6 +6,7 @@ module Hasura.RQL.DDL.Webhook.Transform.Headers
   ( -- * Header Transformations
     Headers (..),
     TransformFn (..),
+    TransformCtx (..),
     HeadersTransformFn (..),
     AddReplaceOrRemoveFields (..),
   )
@@ -23,11 +24,13 @@ import Data.Validation qualified as V
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class
-  ( RequestTransformCtx (..),
+  ( TemplatingEngine,
-    TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
     UnescapedTemplate (..),
+  )
+import Hasura.RQL.DDL.Webhook.Transform.Request
+  ( RequestTransformCtx,
     runUnescapedRequestTemplateTransform',
     validateRequestUnescapedTemplateTransform',
   )
@@ -49,10 +52,12 @@ instance Transform Headers where
     deriving stock (Eq, Generic, Show)
     deriving newtype (Cacheable, NFData, FromJSON, ToJSON)
 
+  newtype TransformCtx Headers = TransformCtx RequestTransformCtx
+
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'applyHeadersTransformFn' is defined
   -- separately.
-  transform (HeadersTransformFn_ fn) = applyHeadersTransformFn fn
+  transform (HeadersTransformFn_ fn) (TransformCtx reqCtx) = applyHeadersTransformFn fn reqCtx
 
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'validateHeadersTransformFn' is defined

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/Method.hs

@@ -4,6 +4,7 @@ module Hasura.RQL.DDL.Webhook.Transform.Method
   ( -- * Method transformations
     Method (..),
     TransformFn (..),
+    TransformCtx (..),
     MethodTransformFn (..),
   )
 where
@@ -18,11 +19,11 @@ import Data.Validation
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class
-  ( RequestTransformCtx (..),
+  ( TemplatingEngine,
-    TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
   )
+import Hasura.RQL.DDL.Webhook.Transform.Request (RequestTransformCtx)
 
 -------------------------------------------------------------------------------
 
@@ -49,10 +50,12 @@ instance Transform Method where
     deriving stock (Eq, Generic, Show)
     deriving newtype (Cacheable, NFData, FromJSON, ToJSON)
 
+  newtype TransformCtx Method = TransformCtx RequestTransformCtx
+
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'applyMethodTransformFn' is defined
   -- separately.
-  transform (MethodTransformFn_ fn) = applyMethodTransformFn fn
+  transform (MethodTransformFn_ fn) (TransformCtx reqCtx) = applyMethodTransformFn fn reqCtx
 
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'validateMethodTransformFn' is defined

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/QueryParams.hs

@@ -4,6 +4,7 @@ module Hasura.RQL.DDL.Webhook.Transform.QueryParams
   ( -- * Query transformations
     QueryParams (..),
     TransformFn (..),
+    TransformCtx (..),
     QueryParamsTransformFn (..),
   )
 where
@@ -18,11 +19,13 @@ import Data.Validation qualified as V
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class
-  ( RequestTransformCtx (..),
+  ( TemplatingEngine,
-    TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
     UnescapedTemplate (..),
+  )
+import Hasura.RQL.DDL.Webhook.Transform.Request
+  ( RequestTransformCtx,
     runUnescapedRequestTemplateTransform',
     validateRequestUnescapedTemplateTransform',
   )
@@ -45,10 +48,12 @@ instance Transform QueryParams where
     deriving stock (Show, Eq, Generic)
     deriving newtype (NFData, Cacheable, FromJSON, ToJSON)
 
+  newtype TransformCtx QueryParams = TransformCtx RequestTransformCtx
+
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'applyQueryParamsTransformFn' is defined
   -- separately.
-  transform (QueryParamsTransformFn_ fn) = applyQueryParamsTransformFn fn
+  transform (QueryParamsTransformFn_ fn) (TransformCtx reqCtx) = applyQueryParamsTransformFn fn reqCtx
 
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'validateQueryParamsTransformFn' is defined

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/Request.hs

@@ -0,0 +1,200 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+-- | Types and subroutines related to constructing transformations on
+-- HTTP requests.
+module Hasura.RQL.DDL.Webhook.Transform.Request
+  ( -- ** Request Transformation Context
+    RequestTransformCtx (..),
+    mkReqTransformCtx,
+
+    -- * Templating
+    TemplatingEngine (..),
+    Template (..),
+    Version (..),
+    runRequestTemplateTransform,
+    validateRequestTemplateTransform,
+    validateRequestTemplateTransform',
+
+    -- * Unescaped
+    runUnescapedRequestTemplateTransform,
+    runUnescapedRequestTemplateTransform',
+    validateRequestUnescapedTemplateTransform,
+    validateRequestUnescapedTemplateTransform',
+  )
+where
+
+-------------------------------------------------------------------------------
+
+import Control.Arrow (left)
+import Control.Lens qualified as Lens
+import Data.Aeson (FromJSON, ToJSON, (.=))
+import Data.Aeson qualified as Aeson
+import Data.Aeson.Kriti.Functions qualified as KFunc
+import Data.Bifunctor
+import Data.ByteString (ByteString)
+import Data.Text.Encoding qualified as TE
+import Data.Validation (Validation, fromEither)
+import Hasura.Incremental (Cacheable)
+import Hasura.Prelude
+import Hasura.RQL.DDL.Webhook.Transform.Class (Template (..), TemplatingEngine (..), TransformErrorBundle (..), UnescapedTemplate, encodeScalar, wrapUnescapedTemplate)
+import Hasura.Session (SessionVariables)
+import Kriti.Error qualified as Kriti
+import Kriti.Parser qualified as Kriti
+import Network.HTTP.Client.Transformable qualified as HTTP
+
+-------------------------------------------------------------------------------
+
+-- | Common context that is made available to all request transformations.
+data RequestTransformCtx = RequestTransformCtx
+  { rtcBaseUrl :: Maybe Aeson.Value,
+    rtcBody :: Aeson.Value,
+    rtcSessionVariables :: Maybe SessionVariables,
+    rtcQueryParams :: Maybe Aeson.Value,
+    rtcEngine :: TemplatingEngine
+  }
+
+instance ToJSON RequestTransformCtx where
+  toJSON RequestTransformCtx {..} =
+    let required =
+          [ "body" .= rtcBody,
+            "session_variables" .= rtcSessionVariables
+          ]
+        optional =
+          [ ("base_url" .=) <$> rtcBaseUrl,
+            ("query_params" .=) <$> rtcQueryParams
+          ]
+     in Aeson.object (required <> catMaybes optional)
+
+-- | A smart constructor for constructing the 'RequestTransformCtx'
+--
+-- 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!
+mkReqTransformCtx ::
+  Text ->
+  Maybe SessionVariables ->
+  TemplatingEngine ->
+  HTTP.Request ->
+  RequestTransformCtx
+mkReqTransformCtx url sessionVars rtcEngine reqData =
+  let rtcBaseUrl = Just $ Aeson.toJSON url
+      rtcBody =
+        let mBody = Lens.view HTTP.body reqData >>= Aeson.decode @Aeson.Value
+         in fromMaybe Aeson.Null mBody
+      rtcSessionVariables = sessionVars
+      rtcQueryParams =
+        let queryParams =
+              Lens.view HTTP.queryParams reqData & fmap \(key, val) ->
+                (TE.decodeUtf8 key, fmap TE.decodeUtf8 val)
+         in Just $ Aeson.toJSON queryParams
+   in RequestTransformCtx {..}
+
+-------------------------------------------------------------------------------
+
+-- | A helper function for executing transformations from a 'Template'
+-- and a 'RequestTransformCtx'.
+--
+-- NOTE: This and all related funtions are hard-coded to Kriti at the
+-- moment. When we add additional template engines this function will
+-- need to take a 'TemplatingEngine' parameter.
+runRequestTemplateTransform ::
+  Template ->
+  RequestTransformCtx ->
+  Either TransformErrorBundle Aeson.Value
+runRequestTemplateTransform template RequestTransformCtx {rtcEngine = Kriti, ..} =
+  let context =
+        [ ("$body", rtcBody),
+          ("$session_variables", Aeson.toJSON rtcSessionVariables)
+        ]
+          <> catMaybes
+            [ ("$query_params",) <$> rtcQueryParams,
+              ("$base_url",) <$> rtcBaseUrl
+            ]
+      kritiFuncs = KFunc.sessionFunctions rtcSessionVariables
+      eResult = KFunc.runKritiWith (unTemplate $ template) context kritiFuncs
+   in eResult & left \kritiErr ->
+        let renderedErr = Aeson.toJSON kritiErr
+         in TransformErrorBundle [renderedErr]
+
+-- TODO: Should this live in 'Hasura.RQL.DDL.Webhook.Transform.Validation'?
+validateRequestTemplateTransform ::
+  TemplatingEngine ->
+  Template ->
+  Either TransformErrorBundle ()
+validateRequestTemplateTransform Kriti (Template template) =
+  bimap packBundle (const ()) $ Kriti.parser $ TE.encodeUtf8 template
+  where
+    packBundle = TransformErrorBundle . pure . Aeson.toJSON . Kriti.serialize
+
+validateRequestTemplateTransform' ::
+  TemplatingEngine ->
+  Template ->
+  Validation TransformErrorBundle ()
+validateRequestTemplateTransform' engine =
+  fromEither . validateRequestTemplateTransform engine
+
+-------------------------------------------------------------------------------
+
+-- | 'RequestTransform' Versioning
+data Version
+  = V1
+  | V2
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass (Cacheable, Hashable, NFData)
+
+instance FromJSON Version where
+  parseJSON v = do
+    version :: Int <- Aeson.parseJSON v
+    case version of
+      1 -> pure V1
+      2 -> pure V2
+      i -> fail $ "expected 1 or 2, encountered " ++ show i
+
+instance ToJSON Version where
+  toJSON = \case
+    V1 -> Aeson.toJSON @Int 1
+    V2 -> Aeson.toJSON @Int 2
+
+-------------------------------------------------------------------------------
+
+-- | A helper function for executing Kriti transformations from a
+-- 'UnescapedTemplate' and a 'RequestTrasformCtx'.
+--
+-- The difference from 'runRequestTemplateTransform' is that this
+-- function will wrap the template text in double quotes before
+-- running Kriti.
+runUnescapedRequestTemplateTransform ::
+  RequestTransformCtx ->
+  UnescapedTemplate ->
+  Either TransformErrorBundle ByteString
+runUnescapedRequestTemplateTransform context unescapedTemplate = do
+  result <-
+    runRequestTemplateTransform
+      (wrapUnescapedTemplate unescapedTemplate)
+      context
+  encodeScalar result
+
+-- | Run a Kriti transformation with an unescaped template in
+-- 'Validation' instead of 'Either'.
+runUnescapedRequestTemplateTransform' ::
+  RequestTransformCtx ->
+  UnescapedTemplate ->
+  Validation TransformErrorBundle ByteString
+runUnescapedRequestTemplateTransform' context unescapedTemplate =
+  fromEither $
+    runUnescapedRequestTemplateTransform context unescapedTemplate
+
+-- TODO: Should this live in 'Hasura.RQL.DDL.Webhook.Transform.Validation'?
+validateRequestUnescapedTemplateTransform ::
+  TemplatingEngine ->
+  UnescapedTemplate ->
+  Either TransformErrorBundle ()
+validateRequestUnescapedTemplateTransform engine =
+  validateRequestTemplateTransform engine . wrapUnescapedTemplate
+
+validateRequestUnescapedTemplateTransform' ::
+  TemplatingEngine ->
+  UnescapedTemplate ->
+  Validation TransformErrorBundle ()
+validateRequestUnescapedTemplateTransform' engine =
+  fromEither . validateRequestUnescapedTemplateTransform engine

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/Response.hs

@@ -0,0 +1,79 @@
+-- | Types and subroutines related to constructing transformations on
+-- HTTP responses.
+module Hasura.RQL.DDL.Webhook.Transform.Response
+  ( -- ** Request Transformation Context
+    ResponseTransformCtx (..),
+    runResponseTemplateTransform,
+
+    -- * Unescaped
+    runUnescapedResponseTemplateTransform,
+    runUnescapedResponseTemplateTransform',
+  )
+where
+
+-------------------------------------------------------------------------------
+
+import Control.Arrow (left)
+import Data.Aeson qualified as Aeson
+import Data.Aeson.Kriti.Functions as KFunc
+import Data.ByteString (ByteString)
+import Data.Validation (Validation, fromEither)
+import Hasura.Prelude
+import Hasura.RQL.DDL.Webhook.Transform.Class
+  ( Template (..),
+    TemplatingEngine (Kriti),
+    TransformErrorBundle (..),
+    UnescapedTemplate,
+    encodeScalar,
+    wrapUnescapedTemplate,
+  )
+import Hasura.Session (SessionVariables)
+
+-------------------------------------------------------------------------------
+
+-- | Common context that is made available to all response transformations.
+data ResponseTransformCtx = ResponseTransformCtx
+  { responseTransformBody :: Aeson.Value,
+    -- NOTE: This is a @Nothing@ if you have a Response Transform but no Request Transform:
+    responseTransformReqCtx :: Aeson.Value,
+    responseSessionVariables :: Maybe SessionVariables,
+    responseTransformEngine :: TemplatingEngine
+  }
+
+-------------------------------------------------------------------------------
+
+-- | A helper function for executing transformations from a 'Template'
+-- and a 'ResponseTransformCtx'.
+--
+-- NOTE: This and all related funtions are hard-coded to Kriti at the
+-- moment. When we add additional template engines this function will
+-- need to take a 'TemplatingEngine' parameter.
+runResponseTemplateTransform ::
+  Template ->
+  ResponseTransformCtx ->
+  Either TransformErrorBundle Aeson.Value
+runResponseTemplateTransform template ResponseTransformCtx {responseTransformEngine = Kriti, ..} =
+  let context = [("$body", responseTransformBody), ("$request", Aeson.toJSON responseTransformReqCtx)]
+      customFunctions = KFunc.sessionFunctions responseSessionVariables
+      eResult = KFunc.runKritiWith (unTemplate $ template) context customFunctions
+   in eResult & left \kritiErr ->
+        let renderedErr = Aeson.toJSON kritiErr
+         in TransformErrorBundle [renderedErr]
+
+-- | Run an 'UnescapedTemplate' with a 'ResponseTransformCtx'.
+runUnescapedResponseTemplateTransform ::
+  ResponseTransformCtx ->
+  UnescapedTemplate ->
+  Either TransformErrorBundle ByteString
+runUnescapedResponseTemplateTransform context unescapedTemplate = do
+  result <- runResponseTemplateTransform (wrapUnescapedTemplate unescapedTemplate) context
+  encodeScalar result
+
+-- | Run an 'UnescapedTemplate' with a 'ResponseTransformCtx' in 'Validation'.
+runUnescapedResponseTemplateTransform' ::
+  ResponseTransformCtx ->
+  UnescapedTemplate ->
+  Validation TransformErrorBundle ByteString
+runUnescapedResponseTemplateTransform' context unescapedTemplate =
+  fromEither $
+    runUnescapedResponseTemplateTransform context unescapedTemplate

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/Url.hs

@@ -2,6 +2,7 @@ module Hasura.RQL.DDL.Webhook.Transform.Url
   ( -- * Url Transformations
     Url (..),
     TransformFn (..),
+    TransformCtx (..),
     UrlTransformFn (..),
   )
 where
@@ -15,16 +16,18 @@ import Data.Validation
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class
-  ( RequestTransformCtx (..),
+  ( TemplatingEngine,
-    TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
     UnescapedTemplate (..),
-    runRequestTemplateTransform,
     throwErrorBundle,
-    validateRequestUnescapedTemplateTransform',
     wrapUnescapedTemplate,
   )
+import Hasura.RQL.DDL.Webhook.Transform.Request
+  ( RequestTransformCtx,
+    runRequestTemplateTransform,
+    validateRequestUnescapedTemplateTransform',
+  )
 import Network.URI (parseURI)
 
 -------------------------------------------------------------------------------
@@ -44,9 +47,11 @@ instance Transform Url where
     deriving stock (Eq, Generic, Show)
     deriving newtype (Cacheable, NFData, FromJSON, ToJSON)
 
+  newtype TransformCtx Url = TransformCtx RequestTransformCtx
+
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'applyUrlTransformFn' is defined separately.
-  transform (UrlTransformFn_ fn) = applyUrlTransformFn fn
+  transform (UrlTransformFn_ fn) (TransformCtx reqCtx) = applyUrlTransformFn fn reqCtx
 
   -- NOTE: GHC does not let us attach Haddock documentation to typeclass
   -- method implementations, so 'validateUrlTransformFn' is defined separately.

server/src-lib/Hasura/RQL/DDL/Webhook/Transform/WithOptional.hs

@@ -0,0 +1,51 @@
+-- | The 'WithOptional' Functor and associated operations.
+module Hasura.RQL.DDL.Webhook.Transform.WithOptional
+  ( WithOptional (..),
+    withOptional,
+  )
+where
+
+-------------------------------------------------------------------------------
+
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Coerce (Coercible)
+import Hasura.Incremental (Cacheable)
+import Hasura.Prelude
+
+-------------------------------------------------------------------------------
+
+-- | Enrich a 'Functor' @f@ with optionality; this is primarily useful when
+-- one wants to annotate fields as optional when using the Higher-Kinded Data
+-- pattern.
+--
+-- 'WithOptional'@ f@ is equivalent to @Compose Maybe f@.
+newtype WithOptional f result = WithOptional
+  { getOptional :: Maybe (f result)
+  }
+  deriving stock (Eq, Functor, Foldable, Generic, Show)
+  deriving newtype (FromJSON, ToJSON)
+
+deriving newtype instance
+  (Cacheable (f result)) =>
+  Cacheable (WithOptional f result)
+
+deriving newtype instance
+  (NFData (f result)) =>
+  NFData (WithOptional f result)
+
+-- | 'WithOptional' smart constructor for the special case of optional values
+-- that are representationally equivalent to some "wrapper" type.
+--
+-- For example:
+-- @
+-- withOptional \@HeaderTransformsAction headers == WithOptional $ fmap HeadersTransform headers
+-- @
+--
+-- In other words: this function observes the isomorphism between @'Maybe' a@
+-- and  @'WithOptional' f b@ if an isomorphism exists between @a@ and @f b@.
+withOptional ::
+  forall a b f.
+  Coercible a (f b) =>
+  Maybe a ->
+  WithOptional f b
+withOptional = coerce