{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The 'Transform' typeclass with various types and helper functions
-- for evaluating transformations.
module Hasura.RQL.DDL.Webhook.Transform.Class
  ( -- * Transformation Interface and Utilities
    Transform (..),

    -- ** Error Context
    TransformErrorBundle (..),
    throwErrorBundle,

    -- ** Request Transformation Context
    RequestTransformCtx (..),
    ResponseTransformCtx (..),
    mkReqTransformCtx,

    -- * Templating
    TemplatingEngine (..),
    Template (..),
    Version (..),
    runRequestTemplateTransform,
    validateRequestTemplateTransform,
    validateRequestTemplateTransform',

    -- * Unescaped
    UnescapedTemplate (..),
    wrapUnescapedTemplate,
    runUnescapedRequestTemplateTransform,
    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.Binary.Builder (toLazyByteString)
import Data.ByteString (ByteString)
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, 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

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

-- | 'Transform' describes how to reify a defunctionalized transformation for
-- a particular request field.
type Transform :: Type -> Constraint
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

  -- | 'transform' is a function which takes 'TransformFn' of @a@ and reifies
  -- it into a function of the form:
  --
  -- @
  --   ReqTransformCtx -> a -> m a
  -- @
  transform ::
    MonadError TransformErrorBundle m =>
    TransformFn a ->
    RequestTransformCtx ->
    a ->
    m a

  -- | Validate a 'TransformFn' of @a@.
  validate ::
    TemplatingEngine ->
    TransformFn a ->
    Validation TransformErrorBundle ()

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

-- | We use collect all transformation failures as a '[J.Value]'.
newtype TransformErrorBundle = TransformErrorBundle
  { TransformErrorBundle -> [Value]
tebMessages :: [J.Value]
  }
  deriving stock (TransformErrorBundle -> TransformErrorBundle -> Bool
(TransformErrorBundle -> TransformErrorBundle -> Bool)
-> (TransformErrorBundle -> TransformErrorBundle -> Bool)
-> Eq TransformErrorBundle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransformErrorBundle -> TransformErrorBundle -> Bool
$c/= :: TransformErrorBundle -> TransformErrorBundle -> Bool
== :: TransformErrorBundle -> TransformErrorBundle -> Bool
$c== :: TransformErrorBundle -> TransformErrorBundle -> Bool
Eq, (forall x. TransformErrorBundle -> Rep TransformErrorBundle x)
-> (forall x. Rep TransformErrorBundle x -> TransformErrorBundle)
-> Generic TransformErrorBundle
forall x. Rep TransformErrorBundle x -> TransformErrorBundle
forall x. TransformErrorBundle -> Rep TransformErrorBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransformErrorBundle x -> TransformErrorBundle
$cfrom :: forall x. TransformErrorBundle -> Rep TransformErrorBundle x
Generic, Int -> TransformErrorBundle -> ShowS
[TransformErrorBundle] -> ShowS
TransformErrorBundle -> String
(Int -> TransformErrorBundle -> ShowS)
-> (TransformErrorBundle -> String)
-> ([TransformErrorBundle] -> ShowS)
-> Show TransformErrorBundle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransformErrorBundle] -> ShowS
$cshowList :: [TransformErrorBundle] -> ShowS
show :: TransformErrorBundle -> String
$cshow :: TransformErrorBundle -> String
showsPrec :: Int -> TransformErrorBundle -> ShowS
$cshowsPrec :: Int -> TransformErrorBundle -> ShowS
Show)
  deriving newtype (Semigroup TransformErrorBundle
TransformErrorBundle
Semigroup TransformErrorBundle
-> TransformErrorBundle
-> (TransformErrorBundle
    -> TransformErrorBundle -> TransformErrorBundle)
-> ([TransformErrorBundle] -> TransformErrorBundle)
-> Monoid TransformErrorBundle
[TransformErrorBundle] -> TransformErrorBundle
TransformErrorBundle
-> TransformErrorBundle -> TransformErrorBundle
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [TransformErrorBundle] -> TransformErrorBundle
$cmconcat :: [TransformErrorBundle] -> TransformErrorBundle
mappend :: TransformErrorBundle
-> TransformErrorBundle -> TransformErrorBundle
$cmappend :: TransformErrorBundle
-> TransformErrorBundle -> TransformErrorBundle
mempty :: TransformErrorBundle
$cmempty :: TransformErrorBundle
$cp1Monoid :: Semigroup TransformErrorBundle
Monoid, b -> TransformErrorBundle -> TransformErrorBundle
NonEmpty TransformErrorBundle -> TransformErrorBundle
TransformErrorBundle
-> TransformErrorBundle -> TransformErrorBundle
(TransformErrorBundle
 -> TransformErrorBundle -> TransformErrorBundle)
-> (NonEmpty TransformErrorBundle -> TransformErrorBundle)
-> (forall b.
    Integral b =>
    b -> TransformErrorBundle -> TransformErrorBundle)
-> Semigroup TransformErrorBundle
forall b.
Integral b =>
b -> TransformErrorBundle -> TransformErrorBundle
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> TransformErrorBundle -> TransformErrorBundle
$cstimes :: forall b.
Integral b =>
b -> TransformErrorBundle -> TransformErrorBundle
sconcat :: NonEmpty TransformErrorBundle -> TransformErrorBundle
$csconcat :: NonEmpty TransformErrorBundle -> TransformErrorBundle
<> :: TransformErrorBundle
-> TransformErrorBundle -> TransformErrorBundle
$c<> :: TransformErrorBundle
-> TransformErrorBundle -> TransformErrorBundle
Semigroup, Value -> Parser [TransformErrorBundle]
Value -> Parser TransformErrorBundle
(Value -> Parser TransformErrorBundle)
-> (Value -> Parser [TransformErrorBundle])
-> FromJSON TransformErrorBundle
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TransformErrorBundle]
$cparseJSONList :: Value -> Parser [TransformErrorBundle]
parseJSON :: Value -> Parser TransformErrorBundle
$cparseJSON :: Value -> Parser TransformErrorBundle
FromJSON, [TransformErrorBundle] -> Value
[TransformErrorBundle] -> Encoding
TransformErrorBundle -> Value
TransformErrorBundle -> Encoding
(TransformErrorBundle -> Value)
-> (TransformErrorBundle -> Encoding)
-> ([TransformErrorBundle] -> Value)
-> ([TransformErrorBundle] -> Encoding)
-> ToJSON TransformErrorBundle
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TransformErrorBundle] -> Encoding
$ctoEncodingList :: [TransformErrorBundle] -> Encoding
toJSONList :: [TransformErrorBundle] -> Value
$ctoJSONList :: [TransformErrorBundle] -> Value
toEncoding :: TransformErrorBundle -> Encoding
$ctoEncoding :: TransformErrorBundle -> Encoding
toJSON :: TransformErrorBundle -> Value
$ctoJSON :: TransformErrorBundle -> Value
ToJSON)
  deriving anyclass (Eq TransformErrorBundle
Eq TransformErrorBundle
-> (Accesses
    -> TransformErrorBundle -> TransformErrorBundle -> Bool)
-> Cacheable TransformErrorBundle
Accesses -> TransformErrorBundle -> TransformErrorBundle -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> TransformErrorBundle -> TransformErrorBundle -> Bool
$cunchanged :: Accesses -> TransformErrorBundle -> TransformErrorBundle -> Bool
$cp1Cacheable :: Eq TransformErrorBundle
Cacheable, TransformErrorBundle -> ()
(TransformErrorBundle -> ()) -> NFData TransformErrorBundle
forall a. (a -> ()) -> NFData a
rnf :: TransformErrorBundle -> ()
$crnf :: TransformErrorBundle -> ()
NFData)

-- | A helper function for serializing transformation errors to JSON.
throwErrorBundle ::
  MonadError TransformErrorBundle m =>
  Text ->
  Maybe J.Value ->
  m a
throwErrorBundle :: Text -> Maybe Value -> m a
throwErrorBundle Text
msg Maybe Value
val = do
  let requiredCtx :: [Pair]
requiredCtx =
        [ Key
"error_code" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= (Text
"TransformationError" :: Text),
          Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text
msg
        ]
      optionalCtx :: [Maybe Pair]
optionalCtx =
        [ (Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..=) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
val
        ]
      err :: Value
err = [Pair] -> Value
J.object ([Pair]
requiredCtx [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe Pair]
optionalCtx)
  TransformErrorBundle -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TransformErrorBundle -> m a) -> TransformErrorBundle -> m a
forall a b. (a -> b) -> a -> b
$ [Value] -> TransformErrorBundle
TransformErrorBundle [Value
err]

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

-- | Common context that is made available to all request transformations.
data RequestTransformCtx = RequestTransformCtx
  { RequestTransformCtx -> Maybe Value
rtcBaseUrl :: Maybe J.Value,
    RequestTransformCtx -> Value
rtcBody :: J.Value,
    RequestTransformCtx -> Value
rtcSessionVariables :: J.Value,
    RequestTransformCtx -> Maybe Value
rtcQueryParams :: Maybe J.Value,
    RequestTransformCtx -> TemplatingEngine
rtcEngine :: TemplatingEngine,
    RequestTransformCtx
-> HashMap Text (Value -> Either CustomFunctionError Value)
rtcFunctions :: M.HashMap Text (J.Value -> Either Kriti.CustomFunctionError J.Value)
  }

instance ToJSON RequestTransformCtx where
  toJSON :: RequestTransformCtx -> Value
toJSON RequestTransformCtx {Maybe Value
Value
HashMap Text (Value -> Either CustomFunctionError Value)
TemplatingEngine
rtcFunctions :: HashMap Text (Value -> Either CustomFunctionError Value)
rtcEngine :: TemplatingEngine
rtcQueryParams :: Maybe Value
rtcSessionVariables :: Value
rtcBody :: Value
rtcBaseUrl :: Maybe Value
rtcFunctions :: RequestTransformCtx
-> HashMap Text (Value -> Either CustomFunctionError Value)
rtcEngine :: RequestTransformCtx -> TemplatingEngine
rtcQueryParams :: RequestTransformCtx -> Maybe Value
rtcSessionVariables :: RequestTransformCtx -> Value
rtcBody :: RequestTransformCtx -> Value
rtcBaseUrl :: RequestTransformCtx -> Maybe Value
..} =
    let required :: [Pair]
required =
          [ Key
"body" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Value
rtcBody,
            Key
"session_variables" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Value
rtcSessionVariables
          ]
        optional :: [Maybe Pair]
optional =
          [ (Key
"base_url" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..=) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
rtcBaseUrl,
            (Key
"query_params" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..=) (Value -> Pair) -> Maybe Value -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
rtcQueryParams
          ]
     in [Pair] -> Value
J.object ([Pair]
required [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Maybe Pair] -> [Pair]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe Pair]
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 :: Text
-> Maybe SessionVariables
-> TemplatingEngine
-> Request
-> RequestTransformCtx
mkReqTransformCtx Text
url Maybe SessionVariables
sessionVars TemplatingEngine
rtcEngine Request
reqData =
  let rtcBaseUrl :: Maybe Value
rtcBaseUrl = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
url
      rtcBody :: Value
rtcBody =
        let mBody :: Maybe Value
mBody = Getting (Maybe ByteString) Request (Maybe ByteString)
-> Request -> Maybe ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ByteString) Request (Maybe ByteString)
Lens' Request (Maybe ByteString)
HTTP.body Request
reqData Maybe ByteString -> (ByteString -> Maybe Value) -> Maybe Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FromJSON Value => ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decode @J.Value
         in Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
J.Null Maybe Value
mBody
      rtcSessionVariables :: Value
rtcSessionVariables = Maybe SessionVariables -> Value
forall a. ToJSON a => a -> Value
J.toJSON Maybe SessionVariables
sessionVars
      rtcQueryParams :: Maybe Value
rtcQueryParams =
        let queryParams :: [(Text, Maybe Text)]
queryParams =
              Getting Query Request Query -> Request -> Query
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Query Request Query
Lens' Request Query
HTTP.queryParams Request
reqData Query -> (Query -> [(Text, Maybe Text)]) -> [(Text, Maybe Text)]
forall a b. a -> (a -> b) -> b
& ((ByteString, Maybe ByteString) -> (Text, Maybe Text))
-> Query -> [(Text, Maybe Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(ByteString
key, Maybe ByteString
val) ->
                (ByteString -> Text
TE.decodeUtf8 ByteString
key, (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
TE.decodeUtf8 Maybe ByteString
val)
         in Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe Text)] -> Value
forall a. ToJSON a => a -> Value
J.toJSON [(Text, Maybe Text)]
queryParams
   in RequestTransformCtx :: Maybe Value
-> Value
-> Value
-> Maybe Value
-> TemplatingEngine
-> HashMap Text (Value -> Either CustomFunctionError Value)
-> RequestTransformCtx
RequestTransformCtx
        { Maybe Value
rtcBaseUrl :: Maybe Value
rtcBaseUrl :: Maybe Value
rtcBaseUrl,
          Value
rtcBody :: Value
rtcBody :: Value
rtcBody,
          Value
rtcSessionVariables :: Value
rtcSessionVariables :: Value
rtcSessionVariables,
          Maybe Value
rtcQueryParams :: Maybe Value
rtcQueryParams :: Maybe Value
rtcQueryParams,
          TemplatingEngine
rtcEngine :: TemplatingEngine
rtcEngine :: TemplatingEngine
rtcEngine,
          rtcFunctions :: HashMap Text (Value -> Either CustomFunctionError Value)
rtcFunctions = Maybe SessionVariables
-> HashMap Text (Value -> Either CustomFunctionError Value)
KFunc.sessionFunctions Maybe SessionVariables
sessionVars
        }

-- | Common context that is made available to all response transformations.
data ResponseTransformCtx = ResponseTransformCtx
  { ResponseTransformCtx -> Value
responseTransformBody :: J.Value,
    ResponseTransformCtx -> Value
responseTransformReqCtx :: J.Value,
    ResponseTransformCtx
-> HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformFunctions :: M.HashMap Text (J.Value -> Either Kriti.CustomFunctionError J.Value),
    ResponseTransformCtx -> TemplatingEngine
responseTransformEngine :: TemplatingEngine
  }

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

-- | Available templating engines.
data TemplatingEngine
  = Kriti
  deriving stock (TemplatingEngine
TemplatingEngine -> TemplatingEngine -> Bounded TemplatingEngine
forall a. a -> a -> Bounded a
maxBound :: TemplatingEngine
$cmaxBound :: TemplatingEngine
minBound :: TemplatingEngine
$cminBound :: TemplatingEngine
Bounded, Int -> TemplatingEngine
TemplatingEngine -> Int
TemplatingEngine -> [TemplatingEngine]
TemplatingEngine -> TemplatingEngine
TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
TemplatingEngine
-> TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
(TemplatingEngine -> TemplatingEngine)
-> (TemplatingEngine -> TemplatingEngine)
-> (Int -> TemplatingEngine)
-> (TemplatingEngine -> Int)
-> (TemplatingEngine -> [TemplatingEngine])
-> (TemplatingEngine -> TemplatingEngine -> [TemplatingEngine])
-> (TemplatingEngine -> TemplatingEngine -> [TemplatingEngine])
-> (TemplatingEngine
    -> TemplatingEngine -> TemplatingEngine -> [TemplatingEngine])
-> Enum TemplatingEngine
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TemplatingEngine
-> TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
$cenumFromThenTo :: TemplatingEngine
-> TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
enumFromTo :: TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
$cenumFromTo :: TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
enumFromThen :: TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
$cenumFromThen :: TemplatingEngine -> TemplatingEngine -> [TemplatingEngine]
enumFrom :: TemplatingEngine -> [TemplatingEngine]
$cenumFrom :: TemplatingEngine -> [TemplatingEngine]
fromEnum :: TemplatingEngine -> Int
$cfromEnum :: TemplatingEngine -> Int
toEnum :: Int -> TemplatingEngine
$ctoEnum :: Int -> TemplatingEngine
pred :: TemplatingEngine -> TemplatingEngine
$cpred :: TemplatingEngine -> TemplatingEngine
succ :: TemplatingEngine -> TemplatingEngine
$csucc :: TemplatingEngine -> TemplatingEngine
Enum, TemplatingEngine -> TemplatingEngine -> Bool
(TemplatingEngine -> TemplatingEngine -> Bool)
-> (TemplatingEngine -> TemplatingEngine -> Bool)
-> Eq TemplatingEngine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplatingEngine -> TemplatingEngine -> Bool
$c/= :: TemplatingEngine -> TemplatingEngine -> Bool
== :: TemplatingEngine -> TemplatingEngine -> Bool
$c== :: TemplatingEngine -> TemplatingEngine -> Bool
Eq, (forall x. TemplatingEngine -> Rep TemplatingEngine x)
-> (forall x. Rep TemplatingEngine x -> TemplatingEngine)
-> Generic TemplatingEngine
forall x. Rep TemplatingEngine x -> TemplatingEngine
forall x. TemplatingEngine -> Rep TemplatingEngine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplatingEngine x -> TemplatingEngine
$cfrom :: forall x. TemplatingEngine -> Rep TemplatingEngine x
Generic, Int -> TemplatingEngine -> ShowS
[TemplatingEngine] -> ShowS
TemplatingEngine -> String
(Int -> TemplatingEngine -> ShowS)
-> (TemplatingEngine -> String)
-> ([TemplatingEngine] -> ShowS)
-> Show TemplatingEngine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplatingEngine] -> ShowS
$cshowList :: [TemplatingEngine] -> ShowS
show :: TemplatingEngine -> String
$cshow :: TemplatingEngine -> String
showsPrec :: Int -> TemplatingEngine -> ShowS
$cshowsPrec :: Int -> TemplatingEngine -> ShowS
Show)
  deriving anyclass (Eq TemplatingEngine
Eq TemplatingEngine
-> (Accesses -> TemplatingEngine -> TemplatingEngine -> Bool)
-> Cacheable TemplatingEngine
Accesses -> TemplatingEngine -> TemplatingEngine -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> TemplatingEngine -> TemplatingEngine -> Bool
$cunchanged :: Accesses -> TemplatingEngine -> TemplatingEngine -> Bool
$cp1Cacheable :: Eq TemplatingEngine
Cacheable, TemplatingEngine -> ()
(TemplatingEngine -> ()) -> NFData TemplatingEngine
forall a. (a -> ()) -> NFData a
rnf :: TemplatingEngine -> ()
$crnf :: TemplatingEngine -> ()
NFData)

-- XXX(jkachmar): We need roundtrip tests for these instances.
instance FromJSON TemplatingEngine where
  parseJSON :: Value -> Parser TemplatingEngine
parseJSON =
    Options -> Value -> Parser TemplatingEngine
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON
      Options
J.defaultOptions
        { tagSingleConstructors :: Bool
J.tagSingleConstructors = Bool
True
        }

-- XXX(jkachmar): We need roundtrip tests for these instances.
instance ToJSON TemplatingEngine where
  toJSON :: TemplatingEngine -> Value
toJSON =
    Options -> TemplatingEngine -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON
      Options
J.defaultOptions
        { tagSingleConstructors :: Bool
J.tagSingleConstructors = Bool
True
        }

  toEncoding :: TemplatingEngine -> Encoding
toEncoding =
    Options -> TemplatingEngine -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding
      Options
J.defaultOptions
        { tagSingleConstructors :: Bool
J.tagSingleConstructors = Bool
True
        }

-- | Textual transformation template.
newtype Template = Template
  { Template -> Text
unTemplate :: Text
  }
  deriving stock (Template -> Template -> Bool
(Template -> Template -> Bool)
-> (Template -> Template -> Bool) -> Eq Template
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c== :: Template -> Template -> Bool
Eq, (forall x. Template -> Rep Template x)
-> (forall x. Rep Template x -> Template) -> Generic Template
forall x. Rep Template x -> Template
forall x. Template -> Rep Template x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Template x -> Template
$cfrom :: forall x. Template -> Rep Template x
Generic, Eq Template
Eq Template
-> (Template -> Template -> Ordering)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Bool)
-> (Template -> Template -> Template)
-> (Template -> Template -> Template)
-> Ord Template
Template -> Template -> Bool
Template -> Template -> Ordering
Template -> Template -> Template
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Template -> Template -> Template
$cmin :: Template -> Template -> Template
max :: Template -> Template -> Template
$cmax :: Template -> Template -> Template
>= :: Template -> Template -> Bool
$c>= :: Template -> Template -> Bool
> :: Template -> Template -> Bool
$c> :: Template -> Template -> Bool
<= :: Template -> Template -> Bool
$c<= :: Template -> Template -> Bool
< :: Template -> Template -> Bool
$c< :: Template -> Template -> Bool
compare :: Template -> Template -> Ordering
$ccompare :: Template -> Template -> Ordering
$cp1Ord :: Eq Template
Ord, Int -> Template -> ShowS
[Template] -> ShowS
Template -> String
(Int -> Template -> ShowS)
-> (Template -> String) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Template] -> ShowS
$cshowList :: [Template] -> ShowS
show :: Template -> String
$cshow :: Template -> String
showsPrec :: Int -> Template -> ShowS
$cshowsPrec :: Int -> Template -> ShowS
Show)
  deriving newtype (Int -> Template -> Int
Template -> Int
(Int -> Template -> Int) -> (Template -> Int) -> Hashable Template
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Template -> Int
$chash :: Template -> Int
hashWithSalt :: Int -> Template -> Int
$chashWithSalt :: Int -> Template -> Int
Hashable, FromJSONKeyFunction [Template]
FromJSONKeyFunction Template
FromJSONKeyFunction Template
-> FromJSONKeyFunction [Template] -> FromJSONKey Template
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Template]
$cfromJSONKeyList :: FromJSONKeyFunction [Template]
fromJSONKey :: FromJSONKeyFunction Template
$cfromJSONKey :: FromJSONKeyFunction Template
FromJSONKey, ToJSONKeyFunction [Template]
ToJSONKeyFunction Template
ToJSONKeyFunction Template
-> ToJSONKeyFunction [Template] -> ToJSONKey Template
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Template]
$ctoJSONKeyList :: ToJSONKeyFunction [Template]
toJSONKey :: ToJSONKeyFunction Template
$ctoJSONKey :: ToJSONKeyFunction Template
ToJSONKey)
  deriving anyclass (Eq Template
Eq Template
-> (Accesses -> Template -> Template -> Bool) -> Cacheable Template
Accesses -> Template -> Template -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> Template -> Template -> Bool
$cunchanged :: Accesses -> Template -> Template -> Bool
$cp1Cacheable :: Eq Template
Cacheable, Template -> ()
(Template -> ()) -> NFData Template
forall a. (a -> ()) -> NFData a
rnf :: Template -> ()
$crnf :: Template -> ()
NFData)

instance J.FromJSON Template where
  parseJSON :: Value -> Parser Template
parseJSON = String -> (Text -> Parser Template) -> Value -> Parser Template
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"Template" (Template -> Parser Template
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Template -> Parser Template)
-> (Text -> Template) -> Text -> Parser Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Template
Template)

instance J.ToJSON Template where
  toJSON :: Template -> Value
toJSON = Text -> Value
J.String (Text -> Value) -> (Template -> Text) -> Template -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> Text
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 -> Either TransformErrorBundle Value
runRequestTemplateTransform Template
template RequestTransformCtx {rtcEngine :: RequestTransformCtx -> TemplatingEngine
rtcEngine = TemplatingEngine
Kriti, Maybe Value
Value
HashMap Text (Value -> Either CustomFunctionError Value)
rtcFunctions :: HashMap Text (Value -> Either CustomFunctionError Value)
rtcQueryParams :: Maybe Value
rtcSessionVariables :: Value
rtcBody :: Value
rtcBaseUrl :: Maybe Value
rtcFunctions :: RequestTransformCtx
-> HashMap Text (Value -> Either CustomFunctionError Value)
rtcQueryParams :: RequestTransformCtx -> Maybe Value
rtcSessionVariables :: RequestTransformCtx -> Value
rtcBody :: RequestTransformCtx -> Value
rtcBaseUrl :: RequestTransformCtx -> Maybe Value
..} =
  let context :: [(Text, Value)]
context =
        [ (Text
"$body", Value
rtcBody),
          (Text
"$session_variables", Value
rtcSessionVariables)
        ]
          [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Text, Value)] -> [(Text, Value)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
            [ (Text
"$query_params",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
rtcQueryParams,
              (Text
"$base_url",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
rtcBaseUrl
            ]
      eResult :: Either SerializedError Value
eResult = Text
-> [(Text, Value)]
-> HashMap Text (Value -> Either CustomFunctionError Value)
-> Either SerializedError Value
KFunc.runKritiWith (Template -> Text
unTemplate (Template -> Text) -> Template -> Text
forall a b. (a -> b) -> a -> b
$ Template
template) [(Text, Value)]
context HashMap Text (Value -> Either CustomFunctionError Value)
rtcFunctions
   in Either SerializedError Value
eResult Either SerializedError Value
-> (Either SerializedError Value
    -> Either TransformErrorBundle Value)
-> Either TransformErrorBundle Value
forall a b. a -> (a -> b) -> b
& (SerializedError -> TransformErrorBundle)
-> Either SerializedError Value
-> Either TransformErrorBundle Value
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left \SerializedError
kritiErr ->
        let renderedErr :: Value
renderedErr = SerializedError -> Value
forall a. ToJSON a => a -> Value
J.toJSON SerializedError
kritiErr
         in [Value] -> TransformErrorBundle
TransformErrorBundle [Value
renderedErr]

-- TODO: Should this live in 'Hasura.RQL.DDL.Webhook.Transform.Validation'?
validateRequestTemplateTransform ::
  TemplatingEngine ->
  Template ->
  Either TransformErrorBundle ()
validateRequestTemplateTransform :: TemplatingEngine -> Template -> Either TransformErrorBundle ()
validateRequestTemplateTransform TemplatingEngine
Kriti (Template Text
template) =
  (ParseError -> TransformErrorBundle)
-> (ValueExt -> ())
-> Either ParseError ValueExt
-> Either TransformErrorBundle ()
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ParseError -> TransformErrorBundle
packBundle (() -> ValueExt -> ()
forall a b. a -> b -> a
const ()) (Either ParseError ValueExt -> Either TransformErrorBundle ())
-> Either ParseError ValueExt -> Either TransformErrorBundle ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseError ValueExt
Kriti.parser (ByteString -> Either ParseError ValueExt)
-> ByteString -> Either ParseError ValueExt
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
template
  where
    packBundle :: ParseError -> TransformErrorBundle
packBundle = [Value] -> TransformErrorBundle
TransformErrorBundle ([Value] -> TransformErrorBundle)
-> (ParseError -> [Value]) -> ParseError -> TransformErrorBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> [Value])
-> (ParseError -> Value) -> ParseError -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializedError -> Value
forall a. ToJSON a => a -> Value
J.toJSON (SerializedError -> Value)
-> (ParseError -> SerializedError) -> ParseError -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> SerializedError
forall e. SerializeError e => e -> SerializedError
Kriti.serialize

validateRequestTemplateTransform' ::
  TemplatingEngine ->
  Template ->
  Validation TransformErrorBundle ()
validateRequestTemplateTransform' :: TemplatingEngine -> Template -> Validation TransformErrorBundle ()
validateRequestTemplateTransform' TemplatingEngine
engine =
  Either TransformErrorBundle ()
-> Validation TransformErrorBundle ()
forall e a. Either e a -> Validation e a
fromEither (Either TransformErrorBundle ()
 -> Validation TransformErrorBundle ())
-> (Template -> Either TransformErrorBundle ())
-> Template
-> Validation TransformErrorBundle ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplatingEngine -> Template -> Either TransformErrorBundle ()
validateRequestTemplateTransform TemplatingEngine
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 -> Either TransformErrorBundle Value
runResponseTemplateTransform Template
template ResponseTransformCtx {responseTransformEngine :: ResponseTransformCtx -> TemplatingEngine
responseTransformEngine = TemplatingEngine
Kriti, Value
HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformFunctions :: HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformReqCtx :: Value
responseTransformBody :: Value
responseTransformFunctions :: ResponseTransformCtx
-> HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformReqCtx :: ResponseTransformCtx -> Value
responseTransformBody :: ResponseTransformCtx -> Value
..} =
  let context :: [(Text, Value)]
context = [(Text
"$body", Value
responseTransformBody), (Text
"$request", Value
responseTransformReqCtx)]
      eResult :: Either SerializedError Value
eResult = Text
-> [(Text, Value)]
-> HashMap Text (Value -> Either CustomFunctionError Value)
-> Either SerializedError Value
KFunc.runKritiWith (Template -> Text
unTemplate (Template -> Text) -> Template -> Text
forall a b. (a -> b) -> a -> b
$ Template
template) [(Text, Value)]
context HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformFunctions
   in Either SerializedError Value
eResult Either SerializedError Value
-> (Either SerializedError Value
    -> Either TransformErrorBundle Value)
-> Either TransformErrorBundle Value
forall a b. a -> (a -> b) -> b
& (SerializedError -> TransformErrorBundle)
-> Either SerializedError Value
-> Either TransformErrorBundle Value
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left \SerializedError
kritiErr ->
        let renderedErr :: Value
renderedErr = SerializedError -> Value
forall a. ToJSON a => a -> Value
J.toJSON SerializedError
kritiErr
         in [Value] -> TransformErrorBundle
TransformErrorBundle [Value
renderedErr]

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

-- | 'RequestTransform' Versioning
data Version
  = V1
  | V2
  deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)
  deriving anyclass (Eq Version
Eq Version
-> (Accesses -> Version -> Version -> Bool) -> Cacheable Version
Accesses -> Version -> Version -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> Version -> Version -> Bool
$cunchanged :: Accesses -> Version -> Version -> Bool
$cp1Cacheable :: Eq Version
Cacheable, Int -> Version -> Int
Version -> Int
(Int -> Version -> Int) -> (Version -> Int) -> Hashable Version
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Version -> Int
$chash :: Version -> Int
hashWithSalt :: Int -> Version -> Int
$chashWithSalt :: Int -> Version -> Int
Hashable, Version -> ()
(Version -> ()) -> NFData Version
forall a. (a -> ()) -> NFData a
rnf :: Version -> ()
$crnf :: Version -> ()
NFData)

instance J.FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON Value
v = do
    Int
version :: Int <- Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v
    case Int
version of
      Int
1 -> Version -> Parser Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
V1
      Int
2 -> Version -> Parser Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
V2
      Int
i -> String -> Parser Version
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Version) -> String -> Parser Version
forall a b. (a -> b) -> a -> b
$ String
"expected 1 or 2, encountered " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

instance J.ToJSON Version where
  toJSON :: Version -> Value
toJSON = \case
    Version
V1 -> Int -> Value
forall a. ToJSON a => a -> Value
J.toJSON @Int Int
1
    Version
V2 -> Int -> Value
forall a. ToJSON a => a -> Value
J.toJSON @Int Int
2

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

-- | 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
  { UnescapedTemplate -> Text
getUnescapedTemplate :: Text
  }
  deriving stock (UnescapedTemplate -> UnescapedTemplate -> Bool
(UnescapedTemplate -> UnescapedTemplate -> Bool)
-> (UnescapedTemplate -> UnescapedTemplate -> Bool)
-> Eq UnescapedTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnescapedTemplate -> UnescapedTemplate -> Bool
$c/= :: UnescapedTemplate -> UnescapedTemplate -> Bool
== :: UnescapedTemplate -> UnescapedTemplate -> Bool
$c== :: UnescapedTemplate -> UnescapedTemplate -> Bool
Eq, (forall x. UnescapedTemplate -> Rep UnescapedTemplate x)
-> (forall x. Rep UnescapedTemplate x -> UnescapedTemplate)
-> Generic UnescapedTemplate
forall x. Rep UnescapedTemplate x -> UnescapedTemplate
forall x. UnescapedTemplate -> Rep UnescapedTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnescapedTemplate x -> UnescapedTemplate
$cfrom :: forall x. UnescapedTemplate -> Rep UnescapedTemplate x
Generic, Eq UnescapedTemplate
Eq UnescapedTemplate
-> (UnescapedTemplate -> UnescapedTemplate -> Ordering)
-> (UnescapedTemplate -> UnescapedTemplate -> Bool)
-> (UnescapedTemplate -> UnescapedTemplate -> Bool)
-> (UnescapedTemplate -> UnescapedTemplate -> Bool)
-> (UnescapedTemplate -> UnescapedTemplate -> Bool)
-> (UnescapedTemplate -> UnescapedTemplate -> UnescapedTemplate)
-> (UnescapedTemplate -> UnescapedTemplate -> UnescapedTemplate)
-> Ord UnescapedTemplate
UnescapedTemplate -> UnescapedTemplate -> Bool
UnescapedTemplate -> UnescapedTemplate -> Ordering
UnescapedTemplate -> UnescapedTemplate -> UnescapedTemplate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UnescapedTemplate -> UnescapedTemplate -> UnescapedTemplate
$cmin :: UnescapedTemplate -> UnescapedTemplate -> UnescapedTemplate
max :: UnescapedTemplate -> UnescapedTemplate -> UnescapedTemplate
$cmax :: UnescapedTemplate -> UnescapedTemplate -> UnescapedTemplate
>= :: UnescapedTemplate -> UnescapedTemplate -> Bool
$c>= :: UnescapedTemplate -> UnescapedTemplate -> Bool
> :: UnescapedTemplate -> UnescapedTemplate -> Bool
$c> :: UnescapedTemplate -> UnescapedTemplate -> Bool
<= :: UnescapedTemplate -> UnescapedTemplate -> Bool
$c<= :: UnescapedTemplate -> UnescapedTemplate -> Bool
< :: UnescapedTemplate -> UnescapedTemplate -> Bool
$c< :: UnescapedTemplate -> UnescapedTemplate -> Bool
compare :: UnescapedTemplate -> UnescapedTemplate -> Ordering
$ccompare :: UnescapedTemplate -> UnescapedTemplate -> Ordering
$cp1Ord :: Eq UnescapedTemplate
Ord, Int -> UnescapedTemplate -> ShowS
[UnescapedTemplate] -> ShowS
UnescapedTemplate -> String
(Int -> UnescapedTemplate -> ShowS)
-> (UnescapedTemplate -> String)
-> ([UnescapedTemplate] -> ShowS)
-> Show UnescapedTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnescapedTemplate] -> ShowS
$cshowList :: [UnescapedTemplate] -> ShowS
show :: UnescapedTemplate -> String
$cshow :: UnescapedTemplate -> String
showsPrec :: Int -> UnescapedTemplate -> ShowS
$cshowsPrec :: Int -> UnescapedTemplate -> ShowS
Show)
  deriving newtype (Int -> UnescapedTemplate -> Int
UnescapedTemplate -> Int
(Int -> UnescapedTemplate -> Int)
-> (UnescapedTemplate -> Int) -> Hashable UnescapedTemplate
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: UnescapedTemplate -> Int
$chash :: UnescapedTemplate -> Int
hashWithSalt :: Int -> UnescapedTemplate -> Int
$chashWithSalt :: Int -> UnescapedTemplate -> Int
Hashable, FromJSONKeyFunction [UnescapedTemplate]
FromJSONKeyFunction UnescapedTemplate
FromJSONKeyFunction UnescapedTemplate
-> FromJSONKeyFunction [UnescapedTemplate]
-> FromJSONKey UnescapedTemplate
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [UnescapedTemplate]
$cfromJSONKeyList :: FromJSONKeyFunction [UnescapedTemplate]
fromJSONKey :: FromJSONKeyFunction UnescapedTemplate
$cfromJSONKey :: FromJSONKeyFunction UnescapedTemplate
FromJSONKey, ToJSONKeyFunction [UnescapedTemplate]
ToJSONKeyFunction UnescapedTemplate
ToJSONKeyFunction UnescapedTemplate
-> ToJSONKeyFunction [UnescapedTemplate]
-> ToJSONKey UnescapedTemplate
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [UnescapedTemplate]
$ctoJSONKeyList :: ToJSONKeyFunction [UnescapedTemplate]
toJSONKey :: ToJSONKeyFunction UnescapedTemplate
$ctoJSONKey :: ToJSONKeyFunction UnescapedTemplate
ToJSONKey)
  deriving anyclass (Eq UnescapedTemplate
Eq UnescapedTemplate
-> (Accesses -> UnescapedTemplate -> UnescapedTemplate -> Bool)
-> Cacheable UnescapedTemplate
Accesses -> UnescapedTemplate -> UnescapedTemplate -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> UnescapedTemplate -> UnescapedTemplate -> Bool
$cunchanged :: Accesses -> UnescapedTemplate -> UnescapedTemplate -> Bool
$cp1Cacheable :: Eq UnescapedTemplate
Cacheable, UnescapedTemplate -> ()
(UnescapedTemplate -> ()) -> NFData UnescapedTemplate
forall a. (a -> ()) -> NFData a
rnf :: UnescapedTemplate -> ()
$crnf :: UnescapedTemplate -> ()
NFData)

instance J.FromJSON UnescapedTemplate where
  parseJSON :: Value -> Parser UnescapedTemplate
parseJSON = String
-> (Text -> Parser UnescapedTemplate)
-> Value
-> Parser UnescapedTemplate
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"Template" (UnescapedTemplate -> Parser UnescapedTemplate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnescapedTemplate -> Parser UnescapedTemplate)
-> (Text -> UnescapedTemplate) -> Text -> Parser UnescapedTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UnescapedTemplate
UnescapedTemplate)

instance J.ToJSON UnescapedTemplate where
  toJSON :: UnescapedTemplate -> Value
toJSON = Text -> Value
J.String (Text -> Value)
-> (UnescapedTemplate -> Text) -> UnescapedTemplate -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnescapedTemplate -> Text
coerce

-- | Wrap an 'UnescapedTemplate' with escaped double quotes.
wrapUnescapedTemplate :: UnescapedTemplate -> Template
wrapUnescapedTemplate :: UnescapedTemplate -> Template
wrapUnescapedTemplate (UnescapedTemplate Text
txt) = Text -> Template
Template (Text -> Template) -> Text -> Template
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

-- | 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 :: RequestTransformCtx
-> UnescapedTemplate -> Either TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform RequestTransformCtx
context UnescapedTemplate
unescapedTemplate = do
  Value
result <-
    Template
-> RequestTransformCtx -> Either TransformErrorBundle Value
runRequestTemplateTransform
      (UnescapedTemplate -> Template
wrapUnescapedTemplate UnescapedTemplate
unescapedTemplate)
      RequestTransformCtx
context
  Value -> Either TransformErrorBundle ByteString
forall (m :: * -> *).
MonadError TransformErrorBundle m =>
Value -> m ByteString
encodeScalar Value
result

-- | Run a Kriti transformation with an unescaped template in
-- 'Validation' instead of 'Either'.
runUnescapedRequestTemplateTransform' ::
  RequestTransformCtx ->
  UnescapedTemplate ->
  Validation TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform' :: RequestTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform' RequestTransformCtx
context UnescapedTemplate
unescapedTemplate =
  Either TransformErrorBundle ByteString
-> Validation TransformErrorBundle ByteString
forall e a. Either e a -> Validation e a
fromEither (Either TransformErrorBundle ByteString
 -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle ByteString
-> Validation TransformErrorBundle ByteString
forall a b. (a -> b) -> a -> b
$
    RequestTransformCtx
-> UnescapedTemplate -> Either TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform RequestTransformCtx
context UnescapedTemplate
unescapedTemplate

-- TODO: Should this live in 'Hasura.RQL.DDL.Webhook.Transform.Validation'?
validateRequestUnescapedTemplateTransform ::
  TemplatingEngine ->
  UnescapedTemplate ->
  Either TransformErrorBundle ()
validateRequestUnescapedTemplateTransform :: TemplatingEngine
-> UnescapedTemplate -> Either TransformErrorBundle ()
validateRequestUnescapedTemplateTransform TemplatingEngine
engine =
  TemplatingEngine -> Template -> Either TransformErrorBundle ()
validateRequestTemplateTransform TemplatingEngine
engine (Template -> Either TransformErrorBundle ())
-> (UnescapedTemplate -> Template)
-> UnescapedTemplate
-> Either TransformErrorBundle ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnescapedTemplate -> Template
wrapUnescapedTemplate

validateRequestUnescapedTemplateTransform' ::
  TemplatingEngine ->
  UnescapedTemplate ->
  Validation TransformErrorBundle ()
validateRequestUnescapedTemplateTransform' :: TemplatingEngine
-> UnescapedTemplate -> Validation TransformErrorBundle ()
validateRequestUnescapedTemplateTransform' TemplatingEngine
engine =
  Either TransformErrorBundle ()
-> Validation TransformErrorBundle ()
forall e a. Either e a -> Validation e a
fromEither (Either TransformErrorBundle ()
 -> Validation TransformErrorBundle ())
-> (UnescapedTemplate -> Either TransformErrorBundle ())
-> UnescapedTemplate
-> Validation TransformErrorBundle ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplatingEngine
-> UnescapedTemplate -> Either TransformErrorBundle ()
validateRequestUnescapedTemplateTransform TemplatingEngine
engine

-- | Run an 'UnescapedTemplate' with a 'ResponseTransformCtx'.
runUnescapedResponseTemplateTransform ::
  ResponseTransformCtx ->
  UnescapedTemplate ->
  Either TransformErrorBundle ByteString
runUnescapedResponseTemplateTransform :: ResponseTransformCtx
-> UnescapedTemplate -> Either TransformErrorBundle ByteString
runUnescapedResponseTemplateTransform ResponseTransformCtx
context UnescapedTemplate
unescapedTemplate = do
  Value
result <- Template
-> ResponseTransformCtx -> Either TransformErrorBundle Value
runResponseTemplateTransform (UnescapedTemplate -> Template
wrapUnescapedTemplate UnescapedTemplate
unescapedTemplate) ResponseTransformCtx
context
  Value -> Either TransformErrorBundle ByteString
forall (m :: * -> *).
MonadError TransformErrorBundle m =>
Value -> m ByteString
encodeScalar Value
result

-- | Run an 'UnescapedTemplate' with a 'ResponseTransformCtx' in 'Validation'.
runUnescapedResponseTemplateTransform' ::
  ResponseTransformCtx ->
  UnescapedTemplate ->
  Validation TransformErrorBundle ByteString
runUnescapedResponseTemplateTransform' :: ResponseTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedResponseTemplateTransform' ResponseTransformCtx
context UnescapedTemplate
unescapedTemplate =
  Either TransformErrorBundle ByteString
-> Validation TransformErrorBundle ByteString
forall e a. Either e a -> Validation e a
fromEither (Either TransformErrorBundle ByteString
 -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle ByteString
-> Validation TransformErrorBundle ByteString
forall a b. (a -> b) -> a -> b
$
    ResponseTransformCtx
-> UnescapedTemplate -> Either TransformErrorBundle ByteString
runUnescapedResponseTemplateTransform ResponseTransformCtx
context UnescapedTemplate
unescapedTemplate

-------------------------------------------------------------------------------
-- Utility functions.

-- | Encode a JSON Scalar Value as a 'ByteString'.
-- If a non-Scalar value is provided, will return a 'TrnasformErrorBundle'
encodeScalar ::
  MonadError TransformErrorBundle m =>
  J.Value ->
  m ByteString
encodeScalar :: Value -> m ByteString
encodeScalar = \case
  J.String Text
str -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
str
  J.Number Scientific
num ->
    ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Builder -> ByteString) -> Builder -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> m ByteString) -> Builder -> m ByteString
forall a b. (a -> b) -> a -> b
$ Scientific -> Builder
scientificBuilder Scientific
num
  J.Bool Bool
True -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"true"
  J.Bool Bool
False -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"false"
  Value
val ->
    Text -> Maybe Value -> m ByteString
forall (m :: * -> *) a.
MonadError TransformErrorBundle m =>
Text -> Maybe Value -> m a
throwErrorBundle Text
"Template must produce a String, Number, or Boolean value" (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
val)