Remove RQL.Types -> RQL.DDL dependencies

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8913
GitOrigin-RevId: 32b62ff7c1083161c96af98c3a4ec1a2e01af9ab

server/graphql-engine.cabal

@@ -842,6 +842,17 @@ library
                      , Hasura.RQL.Types.SourceCustomization
                      , Hasura.RQL.Types.Subscription
                      , Hasura.RQL.Types.Table
+
+                     , Hasura.RQL.Types.Webhook.Transform
+                     , Hasura.RQL.Types.Webhook.Transform.Body
+                     , Hasura.RQL.Types.Webhook.Transform.Class
+                     , Hasura.RQL.Types.Webhook.Transform.Headers
+                     , Hasura.RQL.Types.Webhook.Transform.Method
+                     , Hasura.RQL.Types.Webhook.Transform.QueryParams
+                     , Hasura.RQL.Types.Webhook.Transform.Request
+                     , Hasura.RQL.Types.Webhook.Transform.Url
+                     , Hasura.RQL.Types.Webhook.Transform.WithOptional
+
                      , Hasura.RQL.DDL.Action
                      , Hasura.RQL.DDL.ApiLimit
                      , Hasura.RQL.DDL.ComputedField
@@ -875,7 +886,6 @@ library
                      , 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/RQL/DDL/Webhook/Transform.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
@@ -58,21 +57,15 @@ where
 
 -------------------------------------------------------------------------------
 
-import Autodocodec (HasCodec, dimapCodec, disjointEitherCodec, optionalField', optionalFieldWithDefault')
-import Autodocodec qualified as AC
-import Autodocodec.Extended (optionalVersionField, versionField)
 import Control.Lens (Lens', lens, preview, set, traverseOf, view)
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson.Extended ((.!=), (.:?), (.=), (.=?))
 import Data.Aeson.Extended qualified as J
 import Data.ByteString.Lazy qualified as BL
 import Data.CaseInsensitive qualified as CI
-import Data.Functor.Barbie (AllBF, ApplicativeB, ConstraintsB, FunctorB, TraversableB)
 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, TransformFn (BodyTransformFn_))
+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
@@ -81,204 +74,13 @@ 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, withOptionalField')
+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
 
 -------------------------------------------------------------------------------
 
--- | 'RequestTransform' is the metadata representation of a request
--- transformation. It consists of a record of higher kinded data (HKD)
--- along with some regular data. We seperate the HKD data into its own
--- record field called 'requestFields' which we nest inside our
--- non-HKD record. The actual transformation operations are contained
--- in the HKD.
-data RequestTransform = RequestTransform
-  { version :: Version,
-    requestFields :: RequestFields (WithOptional TransformFn),
-    templateEngine :: TemplatingEngine
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-
-instance HasCodec RequestTransform where
-  codec =
-    dimapCodec
-      (either id id)
-      (\rt -> case version rt of V1 -> Left rt; V2 -> Right rt)
-      $ disjointEitherCodec transformV1 transformV2
-    where
-      transformV1 =
-        AC.object "RequestTransformV1" $
-          RequestTransform
-            <$> (V1 <$ optionalVersionField 1)
-            <*> requestFieldsCodec bodyV1 AC..= requestFields
-            <*> transformCommon
-
-      transformV2 =
-        AC.object "RequestTransformV2" $
-          RequestTransform
-            <$> (V2 <$ versionField 2)
-            <*> requestFieldsCodec bodyV2 AC..= requestFields
-            <*> transformCommon
-
-      transformCommon = optionalFieldWithDefault' "template_engine" Kriti AC..= templateEngine
-
-      requestFieldsCodec bodyCodec =
-        RequestFields
-          <$> withOptionalField' @MethodTransformFn "method" AC..= method
-          <*> withOptionalField' @UrlTransformFn "url" AC..= url
-          <*> bodyCodec AC..= body
-          <*> withOptionalField' @QueryParamsTransformFn "query_params" AC..= queryParams
-          <*> withOptionalField' @HeadersTransformFn "request_headers" AC..= requestHeaders
-
-      bodyV1 = dimapCodec dec enc $ optionalField' @Template "body"
-        where
-          dec template = withOptional $ fmap Body.ModifyAsJSON template
-          enc body = case getOptional body of
-            Just (BodyTransformFn_ (Body.ModifyAsJSON template)) -> Just template
-            _ -> Nothing
-
-      bodyV2 = withOptionalField' @BodyTransformFn "body"
-
-instance FromJSON RequestTransform where
-  parseJSON = J.withObject "RequestTransform" \o -> do
-    version <- o .:? "version" .!= V1
-    method <- o .:? "method"
-    url <- o .:? "url"
-    body <- case version of
-      V1 -> do
-        template :: Maybe Template <- o .:? "body"
-        pure $ fmap Body.ModifyAsJSON template
-      V2 -> o .:? "body"
-    queryParams <- o .:? "query_params"
-    headers <- o .:? "request_headers"
-    let requestFields =
-          RequestFields
-            { method = withOptional @MethodTransformFn method,
-              url = withOptional @UrlTransformFn url,
-              body = withOptional @BodyTransformFn body,
-              queryParams = withOptional @QueryParamsTransformFn queryParams,
-              requestHeaders = withOptional @HeadersTransformFn headers
-            }
-    templateEngine <- o .:? "template_engine" .!= Kriti
-    pure $ RequestTransform {..}
-
-instance ToJSON RequestTransform where
-  toJSON RequestTransform {..} =
-    let RequestFields {..} = requestFields
-        body' = case version of
-          V1 -> case (getOptional body) of
-            Just (BodyTransformFn_ (Body.ModifyAsJSON template)) ->
-              Just ("body", J.toJSON template)
-            _ -> Nothing
-          V2 -> "body" .=? getOptional body
-     in J.object $
-          [ "version" .= version,
-            "template_engine" .= templateEngine
-          ]
-            <> catMaybes
-              [ "method" .=? getOptional method,
-                "url" .=? getOptional url,
-                "query_params" .=? getOptional queryParams,
-                "request_headers" .=? getOptional requestHeaders,
-                body'
-              ]
-
--------------------------------------------------------------------------------
-
--- | Defunctionalized Webhook Request Transformation
---
--- We represent a defunctionalized request transformation by parameterizing
--- our HKD with 'WithOptional'@ @'TransformFn', which marks each of the fields
--- as optional and supplies the appropriate transformation function to them if
--- if they are provided.
-type RequestTransformFns = RequestFields (WithOptional TransformFn)
-
--- | Actual Request Data
---
--- We represent the actual request data by parameterizing our HKD with
--- 'Identity', which allows us to trivially unwrap the fields (which should
--- exist after any transformations have been applied).
-type RequestData = RequestFields Identity
-
--- | This is our HKD type. It is a record with fields for each
--- component of an 'HTTP.Request' we wish to transform.
-data RequestFields f = RequestFields
-  { method :: f Method,
-    url :: f Url,
-    body :: f Body,
-    queryParams :: f QueryParams,
-    requestHeaders :: f Headers
-  }
-  deriving stock (Generic)
-  deriving anyclass (FunctorB, ApplicativeB, TraversableB, ConstraintsB)
-
-deriving stock instance
-  AllBF Show f RequestFields =>
-  Show (RequestFields f)
-
-deriving stock instance
-  AllBF Eq f RequestFields =>
-  Eq (RequestFields f)
-
-deriving anyclass instance
-  AllBF NFData f RequestFields =>
-  NFData (RequestFields f)
-
--- 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
-    method <- o .:? "method"
-    url <- o .:? "url"
-    body <- o .:? "body"
-    queryParams <- o .:? "query_params"
-    headers <- o .:? "request_headers"
-    pure $
-      RequestFields
-        { method = withOptional @MethodTransformFn method,
-          url = withOptional @UrlTransformFn url,
-          body = withOptional @BodyTransformFn body,
-          queryParams = withOptional @QueryParamsTransformFn queryParams,
-          requestHeaders = withOptional @HeadersTransformFn headers
-        }
-
-instance ToJSON RequestTransformFns where
-  toJSON RequestFields {..} =
-    J.object . catMaybes $
-      [ "method" .=? getOptional method,
-        "url" .=? getOptional url,
-        "body" .=? getOptional body,
-        "query_params" .=? getOptional queryParams,
-        "request_headers" .=? getOptional requestHeaders
-      ]
-
-type RequestContext = RequestFields TransformCtx
-
-instance ToJSON RequestContext where
-  toJSON RequestFields {..} =
-    J.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
 
 -- | A 'Lens\'' for viewing a 'HTTP.Request' as our 'RequestData' HKD; it does
@@ -366,70 +168,6 @@ data ResponseTransform = ResponseTransform
     respTransformTemplateEngine :: TemplatingEngine
   }
 
-data MetadataResponseTransform = MetadataResponseTransform
-  { mrtVersion :: Version,
-    mrtBodyTransform :: Maybe BodyTransformFn,
-    mrtTemplatingEngine :: TemplatingEngine
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-
-instance HasCodec MetadataResponseTransform where
-  codec =
-    dimapCodec
-      (either id id)
-      (\rt -> case mrtVersion rt of V1 -> Left rt; V2 -> Right rt)
-      $ disjointEitherCodec transformV1 transformV2
-    where
-      transformV1 =
-        AC.object "ResponseTransformV1" $
-          MetadataResponseTransform
-            <$> (V1 <$ optionalVersionField 1)
-            <*> bodyV1 AC..= mrtBodyTransform
-            <*> transformCommon
-
-      transformV2 =
-        AC.object "ResponseTransformV2" $
-          MetadataResponseTransform
-            <$> (V2 <$ versionField 2)
-            <*> bodyV2 AC..= mrtBodyTransform
-            <*> transformCommon
-
-      transformCommon = optionalFieldWithDefault' "template_engine" Kriti AC..= mrtTemplatingEngine
-
-      bodyV1 =
-        dimapCodec
-          (fmap Body.ModifyAsJSON)
-          (\case Just (Body.ModifyAsJSON template) -> Just template; _ -> Nothing)
-          $ optionalField' @Template "body"
-
-      bodyV2 = optionalField' @BodyTransformFn "body"
-
-instance FromJSON MetadataResponseTransform where
-  parseJSON = J.withObject "MetadataResponseTransform" $ \o -> do
-    mrtVersion <- o .:? "version" .!= V1
-    mrtBodyTransform <- case mrtVersion of
-      V1 -> do
-        template :: (Maybe Template) <- o .:? "body"
-        pure $ fmap Body.ModifyAsJSON template
-      V2 -> o .:? "body"
-    templateEngine <- o .:? "template_engine"
-    let mrtTemplatingEngine = fromMaybe Kriti templateEngine
-    pure $ MetadataResponseTransform {..}
-
-instance ToJSON MetadataResponseTransform where
-  toJSON MetadataResponseTransform {..} =
-    let body = case mrtVersion of
-          V1 -> case mrtBodyTransform of
-            Just (Body.ModifyAsJSON template) -> Just ("body", J.toJSON template)
-            _ -> Nothing
-          V2 -> "body" .=? mrtBodyTransform
-     in J.object $
-          [ "template_engine" .= mrtTemplatingEngine,
-            "version" .= mrtVersion
-          ]
-            <> maybeToList body
-
 -- | A helper function for constructing the 'ResponseTransformCtx'
 buildRespTransformCtx :: Maybe RequestContext -> Maybe SessionVariables -> TemplatingEngine -> BL.ByteString -> ResponseTransformCtx
 buildRespTransformCtx requestContext sessionVars engine respBody =
@@ -478,3 +216,14 @@ applyResponseTransform ResponseTransform {..} ctx@ResponseTransformCtx {..} =
           Nothing -> pure body
           Just f -> J.encode <$> f ctx
    in bodyFunc (J.encode responseTransformBody)
+
+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
+    }

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

@@ -1,5 +1,5 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Hasura.RQL.DDL.Webhook.Transform.Body
   ( -- * Body Transformations
@@ -14,10 +14,6 @@ where
 
 -------------------------------------------------------------------------------
 
-import Autodocodec (HasCodec, codec, dimapCodec, disjointEitherCodec, object, requiredField', (.=))
-import Autodocodec.Extended (discriminatorField)
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson qualified as J
 import Data.ByteString (ByteString)
 import Data.ByteString.Lazy qualified as LBS
 import Data.HashMap.Internal.Strict qualified as M
@@ -28,11 +24,9 @@ import Data.Validation (Validation)
 import Data.Validation qualified as V
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class
-  ( Template (..),
-    TemplatingEngine,
+  ( TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
-    UnescapedTemplate,
   )
 import Hasura.RQL.DDL.Webhook.Transform.Request
   ( RequestTransformCtx,
@@ -41,25 +35,12 @@ import Hasura.RQL.DDL.Webhook.Transform.Request
     validateRequestTemplateTransform',
     validateRequestUnescapedTemplateTransform',
   )
+import Hasura.RQL.Types.Webhook.Transform.Body (Body (..), BodyTransformFn (..), TransformCtx (..), TransformFn (..))
 import Network.URI.Extended qualified as URI
 
 -------------------------------------------------------------------------------
 
--- | HTTP message body being transformed.
-data Body
-  = JSONBody (Maybe J.Value)
-  | RawBody LBS.ByteString
-  deriving stock (Eq, Show)
-
 instance Transform Body where
-  -- NOTE: GHC does not let us attach Haddock documentation to data family
-  -- instances, so 'BodyTransformFn' is defined separately from this wrapper.
-  newtype TransformFn Body = BodyTransformFn_ BodyTransformFn
-    deriving stock (Eq, Generic, Show)
-    deriving newtype (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) (TransformCtx reqCtx) = applyBodyTransformFn fn reqCtx
@@ -69,18 +50,6 @@ instance Transform Body where
   -- separately.
   validate engine (BodyTransformFn_ fn) = validateBodyTransformFn engine fn
 
--- | The transformations which can be applied to an HTTP message body.
-data BodyTransformFn
-  = -- | Remove the HTTP message body.
-    Remove
-  | -- | Modify the JSON message body by applying a 'Template' transformation.
-    ModifyAsJSON Template
-  | -- | Modify the JSON message body by applying 'UnescapedTemplate'
-    -- transformations to each field with a matching 'Text' key.
-    ModifyAsFormURLEncoded (M.HashMap Text UnescapedTemplate)
-  deriving stock (Eq, Generic, Show)
-  deriving anyclass (NFData)
-
 -- | Provide an implementation for the transformations defined by
 -- 'BodyTransformFn'.
 --
@@ -154,60 +123,3 @@ escapeURIBS =
     . URI.escapeURIString URI.isUnescapedInURIComponent
     . T.unpack
     . TE.decodeUtf8
-
-instance HasCodec BodyTransformFn where
-  codec =
-    dimapCodec dec enc $
-      disjointEitherCodec removeCodec $
-        disjointEitherCodec modifyAsJSONCodec modifyAsFormURLEncodecCodec
-    where
-      removeCodec = object "BodyTransformFn_Remove" $ discriminatorField "action" "remove"
-
-      modifyAsJSONCodec =
-        dimapCodec snd ((),) $
-          object "BodyTransformFn_ModifyAsJSON" $
-            (,)
-              <$> discriminatorField "action" "transform" .= fst
-              <*> requiredField' @Template "template" .= snd
-
-      modifyAsFormURLEncodecCodec =
-        dimapCodec snd ((),) $
-          object "BodyTransformFn_ModifyAsFormURLEncoded" $
-            (,)
-              <$> discriminatorField "action" "x_www_form_urlencoded" .= fst
-              <*> requiredField' @(M.HashMap Text UnescapedTemplate) "form_template" .= snd
-
-      dec (Left _) = Remove
-      dec (Right (Left template)) = ModifyAsJSON template
-      dec (Right (Right hashMap)) = ModifyAsFormURLEncoded hashMap
-
-      enc Remove = Left ()
-      enc (ModifyAsJSON template) = Right $ Left template
-      enc (ModifyAsFormURLEncoded hashMap) = Right $ Right hashMap
-
-instance FromJSON BodyTransformFn where
-  parseJSON = J.withObject "BodyTransformFn" \o -> do
-    action <- o J..: "action"
-    case (action :: Text) of
-      "remove" -> pure Remove
-      "transform" -> do
-        template <- o J..: "template"
-        pure $ ModifyAsJSON template
-      "x_www_form_urlencoded" -> do
-        formTemplates <- o J..: "form_template"
-        pure $ ModifyAsFormURLEncoded formTemplates
-      _ -> fail "invalid transform action"
-
-instance ToJSON BodyTransformFn where
-  toJSON = \case
-    Remove -> J.object ["action" J..= ("remove" :: Text)]
-    ModifyAsJSON a ->
-      J.object
-        [ "action" J..= ("transform" :: Text),
-          "template" J..= J.toJSON a
-        ]
-    ModifyAsFormURLEncoded formTemplates ->
-      J.object
-        [ "action" J..= ("x_www_form_urlencoded" :: Text),
-          "form_template" J..= J.toJSON formTemplates
-        ]

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -25,32 +24,19 @@ where
 
 -------------------------------------------------------------------------------
 
-import Autodocodec (HasCodec (codec), dimapCodec, stringConstCodec)
-import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
 import Data.Aeson qualified as J
 import Data.ByteString (ByteString)
 import Data.ByteString.Builder.Extra (toLazyByteStringWith, untrimmedStrategy)
 import Data.ByteString.Builder.Scientific (scientificBuilder)
 import Data.ByteString.Lazy qualified as LBS
-import Data.Kind (Type)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Validation (Validation)
 import Hasura.Prelude
-
--------------------------------------------------------------------------------
+import Hasura.RQL.Types.Webhook.Transform.Class (Template (..), TemplatingEngine (..), TransformCtx, TransformErrorBundle (..), TransformFn, UnescapedTemplate (..))
 
 -- | 'Transform' describes how to reify a defunctionalized transformation for
 -- a particular request field.
 class Transform a where
-  -- | The associated type 'TransformFn a' is the defunctionalized version
-  -- of some transformation that should be applied to a given request field.
-  --
-  -- In most cases it is some variation on a piece of template text describing
-  -- 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:
   --
@@ -72,14 +58,6 @@ class Transform a where
 
 -------------------------------------------------------------------------------
 
--- | We use collect all transformation failures as a '[J.Value]'.
-newtype TransformErrorBundle = TransformErrorBundle
-  { tebMessages :: [J.Value]
-  }
-  deriving stock (Eq, Generic, Show)
-  deriving newtype (Monoid, Semigroup, FromJSON, ToJSON)
-  deriving anyclass (NFData)
-
 -- | A helper function for serializing transformation errors to JSON.
 throwErrorBundle ::
   MonadError TransformErrorBundle m =>
@@ -99,77 +77,6 @@ throwErrorBundle msg val = do
 
 -------------------------------------------------------------------------------
 
--- | Available templating engines.
-data TemplatingEngine
-  = Kriti
-  deriving stock (Bounded, Enum, Eq, Generic, Show)
-  deriving anyclass (NFData)
-
-instance HasCodec TemplatingEngine where
-  codec = stringConstCodec [(Kriti, "Kriti")]
-
--- XXX(jkachmar): We need roundtrip tests for these instances.
-instance FromJSON TemplatingEngine where
-  parseJSON =
-    J.genericParseJSON
-      J.defaultOptions
-        { J.tagSingleConstructors = True
-        }
-
--- XXX(jkachmar): We need roundtrip tests for these instances.
-instance ToJSON TemplatingEngine where
-  toJSON =
-    J.genericToJSON
-      J.defaultOptions
-        { J.tagSingleConstructors = True
-        }
-
-  toEncoding =
-    J.genericToEncoding
-      J.defaultOptions
-        { J.tagSingleConstructors = True
-        }
-
--- | Textual transformation template.
-newtype Template = Template
-  { unTemplate :: Text
-  }
-  deriving stock (Eq, Generic, Ord, Show)
-  deriving newtype (Hashable, FromJSONKey, ToJSONKey)
-  deriving anyclass (NFData)
-
-instance HasCodec Template where
-  codec = dimapCodec Template unTemplate codec
-
-instance J.FromJSON Template where
-  parseJSON = J.withText "Template" (pure . Template)
-
-instance J.ToJSON Template where
-  toJSON = J.String . coerce
-
--------------------------------------------------------------------------------
-
--- | Validated textual transformation template /for string
--- interpolation only/.
---
--- This is necessary due to Kriti not distinguishing between string
--- literals and string templates.
-newtype UnescapedTemplate = UnescapedTemplate
-  { getUnescapedTemplate :: Text
-  }
-  deriving stock (Eq, Generic, Ord, Show)
-  deriving newtype (Hashable, FromJSONKey, ToJSONKey)
-  deriving anyclass (NFData)
-
-instance HasCodec UnescapedTemplate where
-  codec = dimapCodec UnescapedTemplate getUnescapedTemplate codec
-
-instance J.FromJSON UnescapedTemplate where
-  parseJSON = J.withText "Template" (pure . UnescapedTemplate)
-
-instance J.ToJSON UnescapedTemplate where
-  toJSON = J.String . coerce
-
 -- | Wrap an 'UnescapedTemplate' with escaped double quotes.
 wrapUnescapedTemplate :: UnescapedTemplate -> Template
 wrapUnescapedTemplate (UnescapedTemplate txt) = Template $ "\"" <> txt <> "\""

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

@@ -1,6 +1,6 @@
 {-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Hasura.RQL.DDL.Webhook.Transform.Headers
   ( -- * Header Transformations
@@ -14,12 +14,7 @@ where
 
 -------------------------------------------------------------------------------
 
-import Autodocodec
-import Autodocodec.Extended (caseInsensitiveHashMapCodec, caseInsensitiveTextCodec)
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson qualified as J
 import Data.CaseInsensitive qualified as CI
-import Data.HashMap.Strict qualified as HashMap
 import Data.Text.Encoding qualified as TE
 import Data.Validation (Validation)
 import Data.Validation qualified as V
@@ -28,33 +23,17 @@ import Hasura.RQL.DDL.Webhook.Transform.Class
   ( TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
-    UnescapedTemplate (..),
   )
 import Hasura.RQL.DDL.Webhook.Transform.Request
   ( RequestTransformCtx,
     runUnescapedRequestTemplateTransform',
     validateRequestUnescapedTemplateTransform',
   )
-import Network.HTTP.Types qualified as HTTP.Types
+import Hasura.RQL.Types.Webhook.Transform.Headers (AddReplaceOrRemoveFields (..), Headers (..), HeadersTransformFn (..), TransformCtx (..), TransformFn (..))
 
 -------------------------------------------------------------------------------
 
--- | The actual header data we are transforming..
---
--- This newtype is necessary because otherwise we end up with an
--- orphan instance.
-newtype Headers = Headers [HTTP.Types.Header]
-
 instance Transform Headers where
-  -- NOTE: GHC does not let us attach Haddock documentation to data family
-  -- instances, so 'HeadersTransformFn' is defined separately from this
-  -- wrapper.
-  newtype TransformFn Headers = HeadersTransformFn_ HeadersTransformFn
-    deriving stock (Eq, Generic, Show)
-    deriving newtype (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.
@@ -66,30 +45,6 @@ instance Transform Headers where
   validate engine (HeadersTransformFn_ fn) =
     validateHeadersTransformFn engine fn
 
--- | The defunctionalized transformation on 'Headers'
-newtype HeadersTransformFn
-  = -- | Add or replace matching 'HTTP.Types.Header's.
-    AddReplaceOrRemove AddReplaceOrRemoveFields
-  deriving stock (Eq, Generic, Show)
-  deriving newtype (NFData, FromJSON, ToJSON)
-
-instance HasCodec HeadersTransformFn where
-  codec = dimapCodec AddReplaceOrRemove coerce codec
-
--- | The user can supply a set of header keys to be filtered from the
--- request and a set of headers to be added to the request.
-data AddReplaceOrRemoveFields = AddReplaceOrRemoveFields
-  { -- | A list of key-value pairs for 'HTTP.Types.Header's which
-    -- should be added (if they don't exist) or replaced (if they do) within
-    -- the HTTP message.
-    addOrReplaceHeaders :: [(CI.CI Text, UnescapedTemplate)],
-    -- | A list of 'HTTP.Type.Header' keys which should be removed from the
-    -- HTTP message.
-    removeHeaders :: [CI.CI Text]
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData)
-
 -- | Provide an implementation for the transformations defined by
 -- 'HeadersTransformFn'.
 --
@@ -136,41 +91,3 @@ validateHeadersTransformFn engine = \case
   AddReplaceOrRemove fields -> do
     let templates = fields & addOrReplaceHeaders & map snd
     traverse_ (validateRequestUnescapedTemplateTransform' engine) templates
-
-instance HasCodec AddReplaceOrRemoveFields where
-  codec =
-    object "AddReplaceOrRemoveFields" $
-      AddReplaceOrRemoveFields
-        <$> optionalFieldWithDefaultWith' "add_headers" addCodec mempty .= addOrReplaceHeaders
-        <*> optionalFieldWithDefaultWith' "remove_headers" removeCodec mempty .= removeHeaders
-    where
-      addCodec = dimapCodec HashMap.toList HashMap.fromList $ caseInsensitiveHashMapCodec codec
-      removeCodec = listCodec caseInsensitiveTextCodec
-
-instance FromJSON AddReplaceOrRemoveFields where
-  parseJSON = J.withObject "AddReplaceRemoveFields" $ \o -> do
-    addOrReplaceHeadersTxt <- o J..:? "add_headers" J..!= mempty
-    let addOrReplaceHeaders = HashMap.toList $ mapKeys CI.mk addOrReplaceHeadersTxt
-
-    removeHeadersTxt <- o J..:? "remove_headers" J..!= mempty
-    -- NOTE: Ensure that the FromJSON instance is used for deserialization.
-    let removeHeaders = coerce @[HeaderKey] removeHeadersTxt
-
-    pure AddReplaceOrRemoveFields {addOrReplaceHeaders, removeHeaders}
-
-instance ToJSON AddReplaceOrRemoveFields where
-  toJSON AddReplaceOrRemoveFields {..} =
-    J.object
-      [ "add_headers" J..= HashMap.fromList (fmap (first CI.original) addOrReplaceHeaders),
-        "remove_headers" J..= fmap CI.original removeHeaders
-      ]
-
--- | This newtype exists solely to anchor a `FromJSON` instance and is
--- eliminated in the `TransformHeaders` `FromJSON` instance.
-newtype HeaderKey = HeaderKey {unHeaderKey :: CI.CI Text}
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData)
-
-instance FromJSON HeaderKey where
-  parseJSON = J.withText "HeaderKey" \txt -> case CI.mk txt of
-    key -> pure $ HeaderKey key

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

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Hasura.RQL.DDL.Webhook.Transform.Method
   ( -- * Method transformations
@@ -11,12 +11,6 @@ where
 
 -------------------------------------------------------------------------------
 
-import Autodocodec (HasCodec (codec), dimapCodec)
-import Autodocodec.Extended (caseInsensitiveTextCodec)
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson qualified as J
-import Data.CaseInsensitive qualified as CI
-import Data.Text qualified as T
 import Data.Validation
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class
@@ -25,37 +19,11 @@ import Hasura.RQL.DDL.Webhook.Transform.Class
     TransformErrorBundle (..),
   )
 import Hasura.RQL.DDL.Webhook.Transform.Request (RequestTransformCtx)
+import Hasura.RQL.Types.Webhook.Transform.Method (Method (..), MethodTransformFn (..), TransformCtx (..), TransformFn (..))
 
 -------------------------------------------------------------------------------
 
--- | The actual request method we are transforming.
---
--- This newtype is necessary because otherwise we end up with an
--- orphan instance.
-newtype Method = Method (CI.CI T.Text)
-  deriving stock (Generic)
-  deriving newtype (Show, Eq)
-  deriving anyclass (NFData)
-
-instance HasCodec Method where
-  codec = dimapCodec Method coerce caseInsensitiveTextCodec
-
-instance J.ToJSON Method where
-  toJSON = J.String . CI.original . coerce
-
-instance J.FromJSON Method where
-  parseJSON = J.withText "Method" (pure . coerce . CI.mk)
-
 instance Transform Method where
-  -- NOTE: GHC does not let us attach Haddock documentation to data family
-  -- instances, so 'MethodTransformFn' is defined separately from this
-  -- wrapper.
-  newtype TransformFn Method = MethodTransformFn_ MethodTransformFn
-    deriving stock (Eq, Generic, Show)
-    deriving newtype (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.
@@ -66,16 +34,6 @@ instance Transform Method where
   -- separately.
   validate engine (MethodTransformFn_ fn) = validateMethodTransformFn engine fn
 
--- | The defunctionalized transformation on 'Method'.
-newtype MethodTransformFn
-  = -- | Replace the HTTP existing 'Method' with a new one.
-    Replace Method
-  deriving stock (Eq, Generic, Show)
-  deriving newtype (NFData, FromJSON, ToJSON)
-
-instance HasCodec MethodTransformFn where
-  codec = dimapCodec Replace coerce codec
-
 -- | Provide an implementation for the transformations defined by
 -- 'MethodTransformFn'.
 --

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

@@ -1,5 +1,5 @@
 {-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Hasura.RQL.DDL.Webhook.Transform.QueryParams
   ( -- * Query transformations
@@ -12,10 +12,6 @@ where
 
 -------------------------------------------------------------------------------
 
-import Autodocodec (HasCodec (codec), dimapCodec, disjointEitherCodec, hashMapCodec)
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Aeson qualified as J
-import Data.HashMap.Strict qualified as HashMap
 import Data.Validation (Validation)
 import Data.Validation qualified as V
 import Hasura.Prelude
@@ -23,35 +19,18 @@ import Hasura.RQL.DDL.Webhook.Transform.Class
   ( TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
-    UnescapedTemplate (..),
   )
 import Hasura.RQL.DDL.Webhook.Transform.Request
   ( RequestTransformCtx,
     runUnescapedRequestTemplateTransform',
     validateRequestUnescapedTemplateTransform',
   )
-import Network.HTTP.Client.Transformable qualified as HTTP
+import Hasura.RQL.Types.Webhook.Transform.QueryParams (QueryParams (..), QueryParamsTransformFn (..), TransformCtx (..), TransformFn (..))
 import Network.HTTP.Types.URI (parseQuery)
 
 -------------------------------------------------------------------------------
 
--- | The actual query params we are transforming.
---
--- This newtype is necessary because otherwise we end up with an
--- orphan instance.
-newtype QueryParams = QueryParams {unQueryParams :: HTTP.Query}
-
 instance Transform QueryParams where
-  -- NOTE: GHC does not let us attach Haddock documentation to data family
-  -- instances, so 'QueryParamsTransformFn' is defined separately from this
-  -- wrapper.
-  newtype TransformFn QueryParams
-    = QueryParamsTransformFn_ QueryParamsTransformFn
-    deriving stock (Show, Eq, Generic)
-    deriving newtype (NFData, 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.
@@ -63,13 +42,6 @@ instance Transform QueryParams where
   validate engine (QueryParamsTransformFn_ fn) =
     validateQueryParamsTransformFn engine fn
 
--- | The defunctionalized transformation 'QueryParams'
-data QueryParamsTransformFn
-  = AddOrReplace [(UnescapedTemplate, Maybe UnescapedTemplate)]
-  | ParamTemplate UnescapedTemplate
-  deriving (NFData)
-  deriving stock (Eq, Generic, Show)
-
 -- | Provide an implementation for the transformations defined by
 -- 'QueryParamsTransformFn'.
 --
@@ -123,24 +95,3 @@ validateQueryParamsTransformFn engine = \case
     validateRequestUnescapedTemplateTransform' engine template
     pure ()
 {-# ANN validateQueryParamsTransformFn ("HLint: ignore Redundant pure" :: String) #-}
-
-instance HasCodec QueryParamsTransformFn where
-  codec = dimapCodec dec enc $ disjointEitherCodec addOrReplaceCodec templateCodec
-    where
-      addOrReplaceCodec = hashMapCodec (codec @(Maybe UnescapedTemplate))
-      templateCodec = codec @UnescapedTemplate
-
-      dec (Left qps) = AddOrReplace $ HashMap.toList qps
-      dec (Right template) = ParamTemplate template
-
-      enc (AddOrReplace addOrReplace) = Left $ HashMap.fromList addOrReplace
-      enc (ParamTemplate template) = Right template
-
-instance J.ToJSON QueryParamsTransformFn where
-  toJSON (AddOrReplace addOrReplace) = J.toJSON $ HashMap.fromList addOrReplace
-  toJSON (ParamTemplate template) = J.toJSON template
-
-instance J.FromJSON QueryParamsTransformFn where
-  parseJSON xs@(J.Object _) = AddOrReplace . HashMap.toList <$> J.parseJSON xs
-  parseJSON xs@(J.String _) = ParamTemplate <$> J.parseJSON xs
-  parseJSON _ = fail "Invalid query parameter"

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

@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
 -- | Types and subroutines related to constructing transformations on
 -- HTTP requests.
 module Hasura.RQL.DDL.Webhook.Transform.Request
@@ -27,7 +25,6 @@ where
 
 import Control.Arrow (left)
 import Control.Lens qualified as Lens
-import Data.Aeson (FromJSON, ToJSON, (.=))
 import Data.Aeson qualified as J
 import Data.Aeson.Kriti.Functions qualified as KFunc
 import Data.Bifunctor
@@ -36,34 +33,12 @@ import Data.Text.Encoding qualified as TE
 import Data.Validation (Validation, fromEither)
 import Hasura.Prelude
 import Hasura.RQL.DDL.Webhook.Transform.Class (Template (..), TemplatingEngine (..), TransformErrorBundle (..), UnescapedTemplate, encodeScalar, wrapUnescapedTemplate)
+import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx (..), Version (..))
 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 J.Value,
-    rtcBody :: J.Value,
-    rtcSessionVariables :: Maybe SessionVariables,
-    rtcQueryParams :: Maybe J.Value,
-    rtcEngine :: TemplatingEngine
-  }
-
-instance ToJSON RequestTransformCtx where
-  toJSON RequestTransformCtx {..} =
-    let required =
-          [ "body" .= rtcBody,
-            "session_variables" .= rtcSessionVariables
-          ]
-        optional =
-          [ ("base_url" .=) <$> rtcBaseUrl,
-            ("query_params" .=) <$> 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
@@ -134,28 +109,6 @@ validateRequestTemplateTransform' engine =
 
 -------------------------------------------------------------------------------
 
--- | 'RequestTransform' Versioning
-data Version
-  = V1
-  | V2
-  deriving stock (Eq, Generic, Show)
-  deriving anyclass (Hashable, NFData)
-
-instance 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 ToJSON Version where
-  toJSON = \case
-    V1 -> J.toJSON @Int 1
-    V2 -> J.toJSON @Int 2
-
--------------------------------------------------------------------------------
-
 -- | A helper function for executing Kriti transformations from a
 -- 'UnescapedTemplate' and a 'RequestTrasformCtx'.
 --

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

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Hasura.RQL.DDL.Webhook.Transform.Url
   ( -- * Url Transformations
     Url (..),
@@ -9,8 +11,6 @@ where
 
 -------------------------------------------------------------------------------
 
-import Autodocodec (HasCodec (codec), dimapCodec)
-import Data.Aeson (FromJSON, ToJSON)
 import Data.Aeson qualified as J
 import Data.Text qualified as T
 import Data.Validation
@@ -19,7 +19,6 @@ import Hasura.RQL.DDL.Webhook.Transform.Class
   ( TemplatingEngine,
     Transform (..),
     TransformErrorBundle (..),
-    UnescapedTemplate (..),
     throwErrorBundle,
     wrapUnescapedTemplate,
   )
@@ -28,27 +27,12 @@ import Hasura.RQL.DDL.Webhook.Transform.Request
     runRequestTemplateTransform,
     validateRequestUnescapedTemplateTransform',
   )
+import Hasura.RQL.Types.Webhook.Transform.Url (TransformCtx (..), TransformFn (..), Url (..), UrlTransformFn (..))
 import Network.URI (parseURI)
 
 -------------------------------------------------------------------------------
 
--- | The actual URL string we are transforming.
---
--- This newtype is necessary because otherwise we end up with an
--- orphan instance.
-newtype Url = Url {unUrl :: Text}
-  deriving stock (Eq, Show)
-
 instance Transform Url where
-  -- NOTE: GHC does not let us attach Haddock documentation to data family
-  -- instances, so 'UrlTransformFn' is defined separately from this
-  -- wrapper.
-  newtype TransformFn Url = UrlTransformFn_ UrlTransformFn
-    deriving stock (Eq, Generic, Show)
-    deriving newtype (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) (TransformCtx reqCtx) = applyUrlTransformFn fn reqCtx
@@ -57,15 +41,6 @@ instance Transform Url where
   -- method implementations, so 'validateUrlTransformFn' is defined separately.
   validate engine (UrlTransformFn_ fn) = validateUrlTransformFn engine fn
 
--- | The defunctionalized transformation function on 'Url'
-newtype UrlTransformFn
-  = Modify UnescapedTemplate
-  deriving stock (Eq, Generic, Show)
-  deriving newtype (NFData, FromJSON, ToJSON)
-
-instance HasCodec UrlTransformFn where
-  codec = dimapCodec Modify coerce codec
-
 -- | Provide an implementation for the transformations defined by
 -- 'UrlTransformFn'.
 --

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

@@ -28,6 +28,7 @@ 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
 
 -------------------------------------------------------------------------------
 

server/src-lib/Hasura/RQL/Types/Action.hs

@@ -71,13 +71,13 @@ import Database.PG.Query qualified as PG
 import Database.PG.Query.PTI qualified as PTI
 import Hasura.Base.Error
 import Hasura.Prelude
-import Hasura.RQL.DDL.Webhook.Transform (MetadataResponseTransform, RequestTransform)
 import Hasura.RQL.Types.Common
 import Hasura.RQL.Types.CustomTypes
 import Hasura.RQL.Types.Eventing (EventId (..))
 import Hasura.RQL.Types.Headers (HeaderConf)
 import Hasura.RQL.Types.Roles (RoleName)
 import Hasura.RQL.Types.Session (SessionVariables)
+import Hasura.RQL.Types.Webhook.Transform (MetadataResponseTransform, RequestTransform)
 import Language.GraphQL.Draft.Syntax qualified as G
 import Network.HTTP.Types qualified as HTTP
 import PostgreSQL.Binary.Encoding qualified as PE

server/src-lib/Hasura/RQL/Types/EventTrigger.hs

@@ -60,13 +60,13 @@ import Data.Text.NonEmpty
 import Data.Time.Clock qualified as Time
 import Database.PG.Query qualified as PG
 import Hasura.Prelude
-import Hasura.RQL.DDL.Webhook.Transform (MetadataResponseTransform, RequestTransform)
 import Hasura.RQL.Types.Backend
 import Hasura.RQL.Types.BackendTag (backendPrefix)
 import Hasura.RQL.Types.BackendType
 import Hasura.RQL.Types.Common (EnvRecord, InputWebhook, ResolvedWebhook, SourceName (..), TriggerOnReplication (..))
 import Hasura.RQL.Types.Eventing
 import Hasura.RQL.Types.Headers (HeaderConf (..))
+import Hasura.RQL.Types.Webhook.Transform (MetadataResponseTransform, RequestTransform)
 import System.Cron (CronSchedule)
 import Text.Regex.TDFA qualified as TDFA
 

server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs

@@ -59,10 +59,10 @@ import Data.Time.Clock.Units
 import Data.Time.Format.ISO8601
 import Database.PG.Query qualified as PG
 import Hasura.Prelude
-import Hasura.RQL.DDL.Webhook.Transform (MetadataResponseTransform, RequestTransform)
 import Hasura.RQL.Types.Common (InputWebhook (..))
 import Hasura.RQL.Types.EventTrigger
 import Hasura.RQL.Types.Eventing
+import Hasura.RQL.Types.Webhook.Transform (MetadataResponseTransform, RequestTransform)
 import PostgreSQL.Binary.Decoding qualified as PD
 import Refined (NonNegative, Refined, refineTH)
 import System.Cron.Types

server/src-lib/Hasura/RQL/Types/SchemaCache.hs

@@ -131,7 +131,6 @@ import Hasura.Function.Cache
 import Hasura.GraphQL.Context (GQLContext, RoleContext)
 import Hasura.LogicalModel.Types (LogicalModelName)
 import Hasura.Prelude
-import Hasura.RQL.DDL.Webhook.Transform
 import Hasura.RQL.IR.BoolExp
 import Hasura.RQL.Types.Action
 import Hasura.RQL.Types.Allowlist
@@ -157,6 +156,7 @@ import Hasura.RQL.Types.SchemaCacheTypes
 import Hasura.RQL.Types.Session (UserInfoM)
 import Hasura.RQL.Types.Source
 import Hasura.RQL.Types.Table
+import Hasura.RQL.Types.Webhook.Transform
 import Hasura.RemoteSchema.Metadata
 import Hasura.RemoteSchema.SchemaCache.Types
 import Hasura.SQL.AnyBackend qualified as AB

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

@@ -0,0 +1,279 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Hasura.RQL.Types.Webhook.Transform
+  ( MetadataResponseTransform (..),
+    RequestTransform (..),
+    RequestTransformFns,
+    RequestContext,
+    RequestData,
+    RequestFields (..),
+  )
+where
+
+import Autodocodec (HasCodec, dimapCodec, disjointEitherCodec, optionalField', optionalFieldWithDefault')
+import Autodocodec qualified as AC
+import Autodocodec.Extended (optionalVersionField, versionField)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson qualified as J
+import Data.Aeson.Extended ((.!=), (.:?), (.=), (.=?))
+import Data.Functor.Barbie (AllBF, ApplicativeB, ConstraintsB, FunctorB, TraversableB)
+import Data.Functor.Barbie qualified as B
+import Hasura.Prelude
+import Hasura.RQL.Types.Webhook.Transform.Body (Body, BodyTransformFn, TransformCtx (..), TransformFn (..))
+import Hasura.RQL.Types.Webhook.Transform.Body qualified as Body
+import Hasura.RQL.Types.Webhook.Transform.Class (Template, TemplatingEngine (..))
+import Hasura.RQL.Types.Webhook.Transform.Headers (Headers, HeadersTransformFn, TransformCtx (..), TransformFn (..))
+import Hasura.RQL.Types.Webhook.Transform.Method (Method, MethodTransformFn, TransformCtx (..), TransformFn (..))
+import Hasura.RQL.Types.Webhook.Transform.QueryParams (QueryParams, QueryParamsTransformFn, TransformCtx (..), TransformFn (..))
+import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx, Version (..))
+import Hasura.RQL.Types.Webhook.Transform.Url (TransformCtx (..), TransformFn (..), Url, UrlTransformFn (..))
+import Hasura.RQL.Types.Webhook.Transform.WithOptional (WithOptional (..), withOptional, withOptionalField')
+
+-------------------------------------------------------------------------------
+-- TODO(SOLOMON): Rewrite with HKD
+
+data MetadataResponseTransform = MetadataResponseTransform
+  { mrtVersion :: Version,
+    mrtBodyTransform :: Maybe BodyTransformFn,
+    mrtTemplatingEngine :: TemplatingEngine
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NFData)
+
+instance HasCodec MetadataResponseTransform where
+  codec =
+    dimapCodec
+      (either id id)
+      (\rt -> case mrtVersion rt of V1 -> Left rt; V2 -> Right rt)
+      $ disjointEitherCodec transformV1 transformV2
+    where
+      transformV1 =
+        AC.object "ResponseTransformV1" $
+          MetadataResponseTransform
+            <$> (V1 <$ optionalVersionField 1)
+            <*> bodyV1 AC..= mrtBodyTransform
+            <*> transformCommon
+
+      transformV2 =
+        AC.object "ResponseTransformV2" $
+          MetadataResponseTransform
+            <$> (V2 <$ versionField 2)
+            <*> bodyV2 AC..= mrtBodyTransform
+            <*> transformCommon
+
+      transformCommon = optionalFieldWithDefault' "template_engine" Kriti AC..= mrtTemplatingEngine
+
+      bodyV1 =
+        dimapCodec
+          (fmap Body.ModifyAsJSON)
+          (\case Just (Body.ModifyAsJSON template) -> Just template; _ -> Nothing)
+          $ optionalField' @Template "body"
+
+      bodyV2 = optionalField' @BodyTransformFn "body"
+
+instance FromJSON MetadataResponseTransform where
+  parseJSON = J.withObject "MetadataResponseTransform" $ \o -> do
+    mrtVersion <- o .:? "version" .!= V1
+    mrtBodyTransform <- case mrtVersion of
+      V1 -> do
+        template :: (Maybe Template) <- o .:? "body"
+        pure $ fmap Body.ModifyAsJSON template
+      V2 -> o .:? "body"
+    templateEngine <- o .:? "template_engine"
+    let mrtTemplatingEngine = fromMaybe Kriti templateEngine
+    pure $ MetadataResponseTransform {..}
+
+instance ToJSON MetadataResponseTransform where
+  toJSON MetadataResponseTransform {..} =
+    let body = case mrtVersion of
+          V1 -> case mrtBodyTransform of
+            Just (Body.ModifyAsJSON template) -> Just ("body", J.toJSON template)
+            _ -> Nothing
+          V2 -> "body" .=? mrtBodyTransform
+     in J.object $
+          [ "template_engine" .= mrtTemplatingEngine,
+            "version" .= mrtVersion
+          ]
+            <> maybeToList body
+
+-------------------------------------------------------------------------------
+
+-- | 'RequestTransform' is the metadata representation of a request
+-- transformation. It consists of a record of higher kinded data (HKD)
+-- along with some regular data. We seperate the HKD data into its own
+-- record field called 'requestFields' which we nest inside our
+-- non-HKD record. The actual transformation operations are contained
+-- in the HKD.
+data RequestTransform = RequestTransform
+  { version :: Version,
+    requestFields :: RequestFields (WithOptional TransformFn),
+    templateEngine :: TemplatingEngine
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NFData)
+
+instance HasCodec RequestTransform where
+  codec =
+    dimapCodec
+      (either id id)
+      (\rt -> case version rt of V1 -> Left rt; V2 -> Right rt)
+      $ disjointEitherCodec transformV1 transformV2
+    where
+      transformV1 =
+        AC.object "RequestTransformV1" $
+          RequestTransform
+            <$> (V1 <$ optionalVersionField 1)
+            <*> requestFieldsCodec bodyV1 AC..= requestFields
+            <*> transformCommon
+
+      transformV2 =
+        AC.object "RequestTransformV2" $
+          RequestTransform
+            <$> (V2 <$ versionField 2)
+            <*> requestFieldsCodec bodyV2 AC..= requestFields
+            <*> transformCommon
+
+      transformCommon = optionalFieldWithDefault' "template_engine" Kriti AC..= templateEngine
+
+      requestFieldsCodec bodyCodec =
+        RequestFields
+          <$> withOptionalField' @MethodTransformFn "method" AC..= method
+          <*> withOptionalField' @UrlTransformFn "url" AC..= url
+          <*> bodyCodec AC..= body
+          <*> withOptionalField' @QueryParamsTransformFn "query_params" AC..= queryParams
+          <*> withOptionalField' @HeadersTransformFn "request_headers" AC..= requestHeaders
+
+      bodyV1 = dimapCodec dec enc $ optionalField' @Template "body"
+        where
+          dec template = withOptional $ fmap Body.ModifyAsJSON template
+          enc body = case getOptional body of
+            Just (BodyTransformFn_ (Body.ModifyAsJSON template)) -> Just template
+            _ -> Nothing
+
+      bodyV2 = withOptionalField' @BodyTransformFn "body"
+
+instance FromJSON RequestTransform where
+  parseJSON = J.withObject "RequestTransform" \o -> do
+    version <- o .:? "version" .!= V1
+    method <- o .:? "method"
+    url <- o .:? "url"
+    body <- case version of
+      V1 -> do
+        template :: Maybe Template <- o .:? "body"
+        pure $ fmap Body.ModifyAsJSON template
+      V2 -> o .:? "body"
+    queryParams <- o .:? "query_params"
+    headers <- o .:? "request_headers"
+    let requestFields =
+          RequestFields
+            { method = withOptional @MethodTransformFn method,
+              url = withOptional @UrlTransformFn url,
+              body = withOptional @BodyTransformFn body,
+              queryParams = withOptional @QueryParamsTransformFn queryParams,
+              requestHeaders = withOptional @HeadersTransformFn headers
+            }
+    templateEngine <- o .:? "template_engine" .!= Kriti
+    pure $ RequestTransform {..}
+
+instance ToJSON RequestTransform where
+  toJSON RequestTransform {..} =
+    let RequestFields {..} = requestFields
+        body' = case version of
+          V1 -> case (getOptional body) of
+            Just (BodyTransformFn_ (Body.ModifyAsJSON template)) ->
+              Just ("body", J.toJSON template)
+            _ -> Nothing
+          V2 -> "body" .=? getOptional body
+     in J.object $
+          [ "version" .= version,
+            "template_engine" .= templateEngine
+          ]
+            <> catMaybes
+              [ "method" .=? getOptional method,
+                "url" .=? getOptional url,
+                "query_params" .=? getOptional queryParams,
+                "request_headers" .=? getOptional requestHeaders,
+                body'
+              ]
+
+-------------------------------------------------------------------------------
+
+-- | Defunctionalized Webhook Request Transformation
+--
+-- We represent a defunctionalized request transformation by parameterizing
+-- our HKD with 'WithOptional'@ @'TransformFn', which marks each of the fields
+-- as optional and supplies the appropriate transformation function to them if
+-- if they are provided.
+type RequestTransformFns = RequestFields (WithOptional TransformFn)
+
+-- | Actual Request Data
+--
+-- We represent the actual request data by parameterizing our HKD with
+-- 'Identity', which allows us to trivially unwrap the fields (which should
+-- exist after any transformations have been applied).
+type RequestData = RequestFields Identity
+
+-- | This is our HKD type. It is a record with fields for each
+-- component of an 'HTTP.Request' we wish to transform.
+data RequestFields f = RequestFields
+  { method :: f Method,
+    url :: f Url,
+    body :: f Body,
+    queryParams :: f QueryParams,
+    requestHeaders :: f Headers
+  }
+  deriving stock (Generic)
+  deriving anyclass (FunctorB, ApplicativeB, TraversableB, ConstraintsB)
+
+deriving stock instance
+  AllBF Show f RequestFields =>
+  Show (RequestFields f)
+
+deriving stock instance
+  AllBF Eq f RequestFields =>
+  Eq (RequestFields f)
+
+deriving anyclass instance
+  AllBF NFData f RequestFields =>
+  NFData (RequestFields f)
+
+-- 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
+    method <- o .:? "method"
+    url <- o .:? "url"
+    body <- o .:? "body"
+    queryParams <- o .:? "query_params"
+    headers <- o .:? "request_headers"
+    pure $
+      RequestFields
+        { method = withOptional @MethodTransformFn method,
+          url = withOptional @UrlTransformFn url,
+          body = withOptional @BodyTransformFn body,
+          queryParams = withOptional @QueryParamsTransformFn queryParams,
+          requestHeaders = withOptional @HeadersTransformFn headers
+        }
+
+instance ToJSON RequestTransformFns where
+  toJSON RequestFields {..} =
+    J.object . catMaybes $
+      [ "method" .=? getOptional method,
+        "url" .=? getOptional url,
+        "body" .=? getOptional body,
+        "query_params" .=? getOptional queryParams,
+        "request_headers" .=? getOptional requestHeaders
+      ]
+
+type RequestContext = RequestFields TransformCtx
+
+instance ToJSON RequestContext where
+  toJSON RequestFields {..} =
+    J.object
+      [ "method" .= coerce @_ @RequestTransformCtx method,
+        "url" .= coerce @_ @RequestTransformCtx url,
+        "body" .= coerce @_ @RequestTransformCtx body,
+        "query_params" .= coerce @_ @RequestTransformCtx queryParams,
+        "request_headers" .= coerce @_ @RequestTransformCtx requestHeaders
+      ]

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

@@ -0,0 +1,102 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Hasura.RQL.Types.Webhook.Transform.Body
+  ( Body (..),
+    BodyTransformFn (..),
+    TransformFn (..),
+    TransformCtx (..),
+  )
+where
+
+import Autodocodec (HasCodec, codec, dimapCodec, disjointEitherCodec, object, requiredField', (.=))
+import Autodocodec.Extended (discriminatorField)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson qualified as J
+import Data.ByteString.Lazy qualified as LBS
+import Data.HashMap.Internal.Strict qualified as M
+import Hasura.Prelude
+import Hasura.RQL.Types.Webhook.Transform.Class (Template (..), TransformCtx, TransformFn, UnescapedTemplate (..))
+import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx (..))
+
+-- | HTTP message body being transformed.
+data Body
+  = JSONBody (Maybe J.Value)
+  | RawBody LBS.ByteString
+  deriving stock (Eq, Show)
+
+-- | The transformations which can be applied to an HTTP message body.
+data BodyTransformFn
+  = -- | Remove the HTTP message body.
+    Remove
+  | -- | Modify the JSON message body by applying a 'Template' transformation.
+    ModifyAsJSON Template
+  | -- | Modify the JSON message body by applying 'UnescapedTemplate'
+    -- transformations to each field with a matching 'Text' key.
+    ModifyAsFormURLEncoded (M.HashMap Text UnescapedTemplate)
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass (NFData)
+
+instance FromJSON BodyTransformFn where
+  parseJSON = J.withObject "BodyTransformFn" \o -> do
+    action <- o J..: "action"
+    case (action :: Text) of
+      "remove" -> pure Remove
+      "transform" -> do
+        template <- o J..: "template"
+        pure $ ModifyAsJSON template
+      "x_www_form_urlencoded" -> do
+        formTemplates <- o J..: "form_template"
+        pure $ ModifyAsFormURLEncoded formTemplates
+      _ -> fail "invalid transform action"
+
+instance ToJSON BodyTransformFn where
+  toJSON = \case
+    Remove -> J.object ["action" J..= ("remove" :: Text)]
+    ModifyAsJSON a ->
+      J.object
+        [ "action" J..= ("transform" :: Text),
+          "template" J..= J.toJSON a
+        ]
+    ModifyAsFormURLEncoded formTemplates ->
+      J.object
+        [ "action" J..= ("x_www_form_urlencoded" :: Text),
+          "form_template" J..= J.toJSON formTemplates
+        ]
+
+-- NOTE: GHC does not let us attach Haddock documentation to data family
+-- instances, so 'BodyTransformFn' is defined separately from this wrapper.
+newtype instance TransformFn Body = BodyTransformFn_ BodyTransformFn
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+newtype instance TransformCtx Body = TransformCtx RequestTransformCtx
+
+instance HasCodec BodyTransformFn where
+  codec =
+    dimapCodec dec enc $
+      disjointEitherCodec removeCodec $
+        disjointEitherCodec modifyAsJSONCodec modifyAsFormURLEncodecCodec
+    where
+      removeCodec = object "BodyTransformFn_Remove" $ discriminatorField "action" "remove"
+
+      modifyAsJSONCodec =
+        dimapCodec snd ((),) $
+          object "BodyTransformFn_ModifyAsJSON" $
+            (,)
+              <$> discriminatorField "action" "transform" .= fst
+              <*> requiredField' @Template "template" .= snd
+
+      modifyAsFormURLEncodecCodec =
+        dimapCodec snd ((),) $
+          object "BodyTransformFn_ModifyAsFormURLEncoded" $
+            (,)
+              <$> discriminatorField "action" "x_www_form_urlencoded" .= fst
+              <*> requiredField' @(M.HashMap Text UnescapedTemplate) "form_template" .= snd
+
+      dec (Left _) = Remove
+      dec (Right (Left template)) = ModifyAsJSON template
+      dec (Right (Right hashMap)) = ModifyAsFormURLEncoded hashMap
+
+      enc Remove = Left ()
+      enc (ModifyAsJSON template) = Right $ Left template
+      enc (ModifyAsFormURLEncoded hashMap) = Right $ Right hashMap

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

@@ -0,0 +1,108 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedLists #-}
+
+module Hasura.RQL.Types.Webhook.Transform.Class
+  ( Template (..),
+    TemplatingEngine (..),
+    TransformFn,
+    TransformCtx,
+    TransformErrorBundle (..),
+    UnescapedTemplate (..),
+  )
+where
+
+import Autodocodec (HasCodec (codec), dimapCodec, stringConstCodec)
+import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
+import Data.Aeson qualified as J
+import Data.Kind (Type)
+import Hasura.Prelude
+
+-- | Textual transformation template.
+newtype Template = Template
+  { unTemplate :: Text
+  }
+  deriving stock (Eq, Generic, Ord, Show)
+  deriving newtype (Hashable, FromJSONKey, ToJSONKey)
+  deriving anyclass (NFData)
+
+instance HasCodec Template where
+  codec = dimapCodec Template unTemplate codec
+
+instance J.FromJSON Template where
+  parseJSON = J.withText "Template" (pure . Template)
+
+instance J.ToJSON Template where
+  toJSON = J.String . coerce
+
+-- | Validated textual transformation template /for string
+-- interpolation only/.
+--
+-- This is necessary due to Kriti not distinguishing between string
+-- literals and string templates.
+newtype UnescapedTemplate = UnescapedTemplate
+  { getUnescapedTemplate :: Text
+  }
+  deriving stock (Eq, Generic, Ord, Show)
+  deriving newtype (Hashable, FromJSONKey, ToJSONKey)
+  deriving anyclass (NFData)
+
+instance HasCodec UnescapedTemplate where
+  codec = dimapCodec UnescapedTemplate getUnescapedTemplate codec
+
+instance J.FromJSON UnescapedTemplate where
+  parseJSON = J.withText "Template" (pure . UnescapedTemplate)
+
+instance J.ToJSON UnescapedTemplate where
+  toJSON = J.String . coerce
+
+-------------------------------------------------------------------------------
+
+-- | Available templating engines.
+data TemplatingEngine
+  = Kriti
+  deriving stock (Bounded, Enum, Eq, Generic, Show)
+  deriving anyclass (NFData)
+
+instance HasCodec TemplatingEngine where
+  codec = stringConstCodec [(Kriti, "Kriti")]
+
+-- XXX(jkachmar): We need roundtrip tests for these instances.
+instance FromJSON TemplatingEngine where
+  parseJSON =
+    J.genericParseJSON
+      J.defaultOptions
+        { J.tagSingleConstructors = True
+        }
+
+-- XXX(jkachmar): We need roundtrip tests for these instances.
+instance ToJSON TemplatingEngine where
+  toJSON =
+    J.genericToJSON
+      J.defaultOptions
+        { J.tagSingleConstructors = True
+        }
+
+  toEncoding =
+    J.genericToEncoding
+      J.defaultOptions
+        { J.tagSingleConstructors = True
+        }
+
+-- | The associated type 'TransformFn a' is the defunctionalized version
+-- of some transformation that should be applied to a given request field.
+--
+-- In most cases it is some variation on a piece of template text describing
+-- the transformation.
+data family TransformFn a :: Type
+
+data family TransformCtx a :: Type
+
+-------------------------------------------------------------------------------
+
+-- | We use collect all transformation failures as a '[J.Value]'.
+newtype TransformErrorBundle = TransformErrorBundle
+  { tebMessages :: [J.Value]
+  }
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (Monoid, Semigroup, FromJSON, ToJSON)
+  deriving anyclass (NFData)

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

@@ -0,0 +1,98 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Hasura.RQL.Types.Webhook.Transform.Headers
+  ( AddReplaceOrRemoveFields (..),
+    Headers (..),
+    HeadersTransformFn (..),
+    TransformCtx (..),
+    TransformFn (..),
+  )
+where
+
+import Autodocodec
+import Autodocodec.Extended (caseInsensitiveHashMapCodec, caseInsensitiveTextCodec)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson qualified as J
+import Data.CaseInsensitive qualified as CI
+import Data.HashMap.Strict qualified as HashMap
+import Hasura.Prelude
+import Hasura.RQL.Types.Webhook.Transform.Class (TransformCtx, TransformFn, UnescapedTemplate (..))
+import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx)
+import Network.HTTP.Types qualified as HTTP.Types
+
+-- | The actual header data we are transforming..
+--
+-- This newtype is necessary because otherwise we end up with an
+-- orphan instance.
+newtype Headers = Headers [HTTP.Types.Header]
+
+-- | The defunctionalized transformation on 'Headers'
+newtype HeadersTransformFn
+  = -- | Add or replace matching 'HTTP.Types.Header's.
+    AddReplaceOrRemove AddReplaceOrRemoveFields
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+instance HasCodec HeadersTransformFn where
+  codec = dimapCodec AddReplaceOrRemove coerce codec
+
+-- | The user can supply a set of header keys to be filtered from the
+-- request and a set of headers to be added to the request.
+data AddReplaceOrRemoveFields = AddReplaceOrRemoveFields
+  { -- | A list of key-value pairs for 'HTTP.Types.Header's which
+    -- should be added (if they don't exist) or replaced (if they do) within
+    -- the HTTP message.
+    addOrReplaceHeaders :: [(CI.CI Text, UnescapedTemplate)],
+    -- | A list of 'HTTP.Type.Header' keys which should be removed from the
+    -- HTTP message.
+    removeHeaders :: [CI.CI Text]
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData)
+
+instance HasCodec AddReplaceOrRemoveFields where
+  codec =
+    object "AddReplaceOrRemoveFields" $
+      AddReplaceOrRemoveFields
+        <$> optionalFieldWithDefaultWith' "add_headers" addCodec mempty .= addOrReplaceHeaders
+        <*> optionalFieldWithDefaultWith' "remove_headers" removeCodec mempty .= removeHeaders
+    where
+      addCodec = dimapCodec HashMap.toList HashMap.fromList $ caseInsensitiveHashMapCodec codec
+      removeCodec = listCodec caseInsensitiveTextCodec
+
+instance FromJSON AddReplaceOrRemoveFields where
+  parseJSON = J.withObject "AddReplaceRemoveFields" $ \o -> do
+    addOrReplaceHeadersTxt <- o J..:? "add_headers" J..!= mempty
+    let addOrReplaceHeaders = HashMap.toList $ mapKeys CI.mk addOrReplaceHeadersTxt
+
+    removeHeadersTxt <- o J..:? "remove_headers" J..!= mempty
+    -- NOTE: Ensure that the FromJSON instance is used for deserialization.
+    let removeHeaders = coerce @[HeaderKey] removeHeadersTxt
+
+    pure AddReplaceOrRemoveFields {addOrReplaceHeaders, removeHeaders}
+
+instance ToJSON AddReplaceOrRemoveFields where
+  toJSON AddReplaceOrRemoveFields {..} =
+    J.object
+      [ "add_headers" J..= HashMap.fromList (fmap (first CI.original) addOrReplaceHeaders),
+        "remove_headers" J..= fmap CI.original removeHeaders
+      ]
+
+-- | This newtype exists solely to anchor a `FromJSON` instance and is
+-- eliminated in the `TransformHeaders` `FromJSON` instance.
+newtype HeaderKey = HeaderKey {unHeaderKey :: CI.CI Text}
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData)
+
+instance FromJSON HeaderKey where
+  parseJSON = J.withText "HeaderKey" \txt -> case CI.mk txt of
+    key -> pure $ HeaderKey key
+
+-- NOTE: GHC does not let us attach Haddock documentation to data family
+-- instances, so 'HeadersTransformFn' is defined separately from this
+-- wrapper.
+newtype instance TransformFn Headers = HeadersTransformFn_ HeadersTransformFn
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+newtype instance TransformCtx Headers = TransformCtx RequestTransformCtx

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

@@ -0,0 +1,57 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Hasura.RQL.Types.Webhook.Transform.Method
+  ( Method (..),
+    MethodTransformFn (..),
+    TransformCtx (..),
+    TransformFn (..),
+  )
+where
+
+import Autodocodec (HasCodec (codec), dimapCodec)
+import Autodocodec.Extended (caseInsensitiveTextCodec)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson qualified as J
+import Data.CaseInsensitive qualified as CI
+import Data.Text qualified as T
+import Hasura.Prelude
+import Hasura.RQL.Types.Webhook.Transform.Class (TransformCtx, TransformFn)
+import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx)
+
+-- | The actual request method we are transforming.
+--
+-- This newtype is necessary because otherwise we end up with an
+-- orphan instance.
+newtype Method = Method (CI.CI T.Text)
+  deriving stock (Generic)
+  deriving newtype (Show, Eq)
+  deriving anyclass (NFData)
+
+instance HasCodec Method where
+  codec = dimapCodec Method coerce caseInsensitiveTextCodec
+
+instance J.ToJSON Method where
+  toJSON = J.String . CI.original . coerce
+
+instance J.FromJSON Method where
+  parseJSON = J.withText "Method" (pure . coerce . CI.mk)
+
+-- | The defunctionalized transformation on 'Method'.
+newtype MethodTransformFn
+  = -- | Replace the HTTP existing 'Method' with a new one.
+    Replace Method
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+instance HasCodec MethodTransformFn where
+  codec = dimapCodec Replace coerce codec
+
+-- NOTE: GHC does not let us attach Haddock documentation to data family
+-- instances, so 'MethodTransformFn' is defined separately from this
+-- wrapper.
+newtype instance TransformFn Method = MethodTransformFn_ MethodTransformFn
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+newtype instance TransformCtx Method = TransformCtx RequestTransformCtx

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

@@ -0,0 +1,62 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Hasura.RQL.Types.Webhook.Transform.QueryParams
+  ( QueryParams (..),
+    QueryParamsTransformFn (..),
+    TransformCtx (..),
+    TransformFn (..),
+  )
+where
+
+import Autodocodec (HasCodec (codec), dimapCodec, disjointEitherCodec, hashMapCodec)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson qualified as J
+import Data.HashMap.Strict qualified as HashMap
+import Hasura.Prelude
+import Hasura.RQL.Types.Webhook.Transform.Class (TransformCtx, TransformFn, UnescapedTemplate)
+import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx)
+import Network.HTTP.Client.Transformable qualified as HTTP
+
+-- | The actual query params we are transforming.
+--
+-- This newtype is necessary because otherwise we end up with an
+-- orphan instance.
+newtype QueryParams = QueryParams {unQueryParams :: HTTP.Query}
+
+-- | The defunctionalized transformation 'QueryParams'
+data QueryParamsTransformFn
+  = AddOrReplace [(UnescapedTemplate, Maybe UnescapedTemplate)]
+  | ParamTemplate UnescapedTemplate
+  deriving (NFData)
+  deriving stock (Eq, Generic, Show)
+
+instance HasCodec QueryParamsTransformFn where
+  codec = dimapCodec dec enc $ disjointEitherCodec addOrReplaceCodec templateCodec
+    where
+      addOrReplaceCodec = hashMapCodec (codec @(Maybe UnescapedTemplate))
+      templateCodec = codec @UnescapedTemplate
+
+      dec (Left qps) = AddOrReplace $ HashMap.toList qps
+      dec (Right template) = ParamTemplate template
+
+      enc (AddOrReplace addOrReplace) = Left $ HashMap.fromList addOrReplace
+      enc (ParamTemplate template) = Right template
+
+instance J.ToJSON QueryParamsTransformFn where
+  toJSON (AddOrReplace addOrReplace) = J.toJSON $ HashMap.fromList addOrReplace
+  toJSON (ParamTemplate template) = J.toJSON template
+
+instance J.FromJSON QueryParamsTransformFn where
+  parseJSON xs@(J.Object _) = AddOrReplace . HashMap.toList <$> J.parseJSON xs
+  parseJSON xs@(J.String _) = ParamTemplate <$> J.parseJSON xs
+  parseJSON _ = fail "Invalid query parameter"
+
+-- NOTE: GHC does not let us attach Haddock documentation to data family
+-- instances, so 'QueryParamsTransformFn' is defined separately from this
+-- wrapper.
+newtype instance TransformFn QueryParams
+  = QueryParamsTransformFn_ QueryParamsTransformFn
+  deriving stock (Show, Eq, Generic)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+newtype instance TransformCtx QueryParams = TransformCtx RequestTransformCtx

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

@@ -0,0 +1,56 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Hasura.RQL.Types.Webhook.Transform.Request
+  ( RequestTransformCtx (..),
+    Version (..),
+  )
+where
+
+import Data.Aeson (FromJSON, ToJSON, (.=))
+import Data.Aeson qualified as J
+import Hasura.Prelude
+import Hasura.RQL.Types.Webhook.Transform.Class (TemplatingEngine (..))
+import Hasura.Session (SessionVariables)
+
+-- | Common context that is made available to all request transformations.
+data RequestTransformCtx = RequestTransformCtx
+  { rtcBaseUrl :: Maybe J.Value,
+    rtcBody :: J.Value,
+    rtcSessionVariables :: Maybe SessionVariables,
+    rtcQueryParams :: Maybe J.Value,
+    rtcEngine :: TemplatingEngine
+  }
+
+instance ToJSON RequestTransformCtx where
+  toJSON RequestTransformCtx {..} =
+    let required =
+          [ "body" .= rtcBody,
+            "session_variables" .= rtcSessionVariables
+          ]
+        optional =
+          [ ("base_url" .=) <$> rtcBaseUrl,
+            ("query_params" .=) <$> rtcQueryParams
+          ]
+     in J.object (required <> catMaybes optional)
+
+-------------------------------------------------------------------------------
+
+-- | 'RequestTransform' Versioning
+data Version
+  = V1
+  | V2
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass (Hashable, NFData)
+
+instance 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 ToJSON Version where
+  toJSON = \case
+    V1 -> J.toJSON @Int 1
+    V2 -> J.toJSON @Int 2

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

@@ -0,0 +1,38 @@
+module Hasura.RQL.Types.Webhook.Transform.Url
+  ( Url (..),
+    UrlTransformFn (..),
+    TransformCtx (..),
+    TransformFn (..),
+  )
+where
+
+import Autodocodec (HasCodec, codec, dimapCodec)
+import Data.Aeson (FromJSON, ToJSON)
+import Hasura.Prelude
+import Hasura.RQL.Types.Webhook.Transform.Class (TransformCtx, TransformFn, UnescapedTemplate (..))
+import Hasura.RQL.Types.Webhook.Transform.Request (RequestTransformCtx (..))
+
+-- | The actual URL string we are transforming.
+--
+-- This newtype is necessary because otherwise we end up with an
+-- orphan instance.
+newtype Url = Url {unUrl :: Text}
+  deriving stock (Eq, Show)
+
+-- | The defunctionalized transformation function on 'Url'
+newtype UrlTransformFn
+  = Modify UnescapedTemplate
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+instance HasCodec UrlTransformFn where
+  codec = dimapCodec Modify coerce codec
+
+-- NOTE: GHC does not let us attach Haddock documentation to data family
+-- instances, so 'UrlTransformFn' is defined separately from this
+-- wrapper.
+newtype instance TransformFn Url = UrlTransformFn_ UrlTransformFn
+  deriving stock (Eq, Generic, Show)
+  deriving newtype (NFData, FromJSON, ToJSON)
+
+newtype instance TransformCtx Url = TransformCtx RequestTransformCtx

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

@@ -1,5 +1,4 @@
--- | The 'WithOptional' Functor and associated operations.
-module Hasura.RQL.DDL.Webhook.Transform.WithOptional
+module Hasura.RQL.Types.Webhook.Transform.WithOptional
   ( WithOptional (..),
     withOptional,
     withOptionalField',
@@ -7,15 +6,11 @@ module Hasura.RQL.DDL.Webhook.Transform.WithOptional
   )
 where
 
--------------------------------------------------------------------------------
-
 import Autodocodec (HasCodec (codec), ObjectCodec, ValueCodec, dimapCodec, optionalFieldWith')
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Coerce (Coercible)
 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.
@@ -31,6 +26,8 @@ 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.
 --