mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
ca85acbfe3
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3782 Co-authored-by: Abhijeet Khangarot <26903230+abhi40308@users.noreply.github.com> GitOrigin-RevId: 404197e766efa94a1814e8a0287cd55d9175f2a7
83 lines
2.5 KiB
Haskell
83 lines
2.5 KiB
Haskell
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Hasura.RQL.DDL.Webhook.Transform.Url
|
|
( -- * Url Transformations
|
|
Url (..),
|
|
TransformFn (..),
|
|
|
|
-- ** Url Transformation Action
|
|
UrlTransformAction (..),
|
|
)
|
|
where
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
import Data.Aeson (FromJSON, ToJSON)
|
|
import Data.Aeson qualified as J
|
|
import Data.Text qualified as T
|
|
import Data.Validation
|
|
import Hasura.Incremental (Cacheable)
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.Webhook.Transform.Class
|
|
( RequestTransformCtx (..),
|
|
TemplatingEngine,
|
|
Transform (..),
|
|
TransformErrorBundle (..),
|
|
UnescapedTemplate (..),
|
|
runRequestTemplateTransform,
|
|
throwErrorBundle,
|
|
validateRequestUnescapedTemplateTransform',
|
|
wrapUnescapedTemplate,
|
|
)
|
|
import Network.URI (parseURI)
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- | The actual URL string we are transforming
|
|
newtype Url = Url
|
|
{ unUrl :: Text
|
|
}
|
|
deriving stock (Eq, Show)
|
|
|
|
instance Transform Url where
|
|
-- TODO(jkachmar): Document.
|
|
newtype TransformFn Url
|
|
= UrlTransform UrlTransformAction
|
|
deriving stock (Generic)
|
|
deriving newtype (Eq, Show, FromJSON, ToJSON)
|
|
deriving anyclass (Cacheable, NFData)
|
|
|
|
transform ::
|
|
MonadError TransformErrorBundle m =>
|
|
TransformFn Url ->
|
|
RequestTransformCtx ->
|
|
Url ->
|
|
m Url
|
|
transform (UrlTransform transformation) context _originalUrl = do
|
|
case transformation of
|
|
ModifyUrl unescapedTemplate -> do
|
|
let template = wrapUnescapedTemplate unescapedTemplate
|
|
resultJson <- liftEither $ runRequestTemplateTransform template context
|
|
templatedUrlTxt <- case resultJson of
|
|
J.String templatedUrlTxt -> pure templatedUrlTxt
|
|
val -> do
|
|
let errTxt = "URL Transforms must produce a JSON String: " <> tshow val
|
|
throwErrorBundle errTxt Nothing
|
|
case parseURI (T.unpack templatedUrlTxt) of
|
|
Nothing -> throwErrorBundle ("Invalid URL: " <> templatedUrlTxt) Nothing
|
|
Just _validatedUrl -> pure $ Url templatedUrlTxt
|
|
|
|
validate ::
|
|
TemplatingEngine ->
|
|
TransformFn Url ->
|
|
Validation TransformErrorBundle ()
|
|
validate engine (UrlTransform (ModifyUrl template)) =
|
|
validateRequestUnescapedTemplateTransform' engine template
|
|
|
|
-- | The defunctionalized transformation function on 'Url'
|
|
newtype UrlTransformAction
|
|
= ModifyUrl UnescapedTemplate
|
|
deriving newtype (Eq, Generic, Show, FromJSON, ToJSON)
|
|
deriving anyclass (Cacheable, NFData)
|