{-# LANGUAGE OverloadedLists #-}
{-# 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,

    -- * Templating
    TemplatingEngine (..),
    Template (..),

    -- * Unescaped
    UnescapedTemplate (..),
    wrapUnescapedTemplate,
    encodeScalar,
  )
where

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

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.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
  -- | '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 ->
    TransformCtx a ->
    a ->
    m a

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

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

-- | A helper function for serializing transformation errors to JSON.
throwErrorBundle ::
  (MonadError TransformErrorBundle m) =>
  Text ->
  Maybe J.Value ->
  m a
throwErrorBundle :: forall (m :: * -> *) a.
MonadError TransformErrorBundle m =>
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
forall v. ToJSON v => Key -> v -> Pair
J..= (Text
"TransformationError" :: Text),
          Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
msg
        ]
      optionalCtx :: [Maybe Pair]
optionalCtx =
        [ (Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
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 a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe Pair]
optionalCtx)
  TransformErrorBundle -> m a
forall a. 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
Item [Value]
err]

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

-- | 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
"\""

-------------------------------------------------------------------------------
-- 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 :: forall (m :: * -> *).
MonadError TransformErrorBundle m =>
Value -> m ByteString
encodeScalar = \case
  J.String Text
str -> ByteString -> m ByteString
forall a. a -> m a
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 ->
    -- like toLazyByteString, but tuned for output and for common small size:
    ByteString -> m ByteString
forall a. a -> m a
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
. AllocationStrategy -> ByteString -> Builder -> ByteString
toLazyByteStringWith (Int -> Int -> AllocationStrategy
untrimmedStrategy Int
24 Int
1024) ByteString
"" (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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"true"
  J.Bool Bool
False -> ByteString -> m ByteString
forall a. a -> m a
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)