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

-- | Webhook Transformations are data transformations used to modify
-- HTTP Requests/Responses before requests are executed and after
-- responses are received.
--
-- Transformations are supplied by users as part of the Metadata for a
-- particular Action or EventTrigger as a 'RequestTransform'
-- record. Per-field Transformations are stored as data
-- (defunctionalized), often in the form of a Kriti template, and then
-- converted into actual functions (reified) at runtime by the
-- 'Transform' typeclass.
--
-- We take a Higher Kinded Data (HKD) approach to representing the
-- transformations. 'RequestFields' is an HKD which can represent the
-- actual request data as 'RequestFields Identity' or the
-- defunctionalized transforms as 'RequestFields (WithOptional
-- TransformFn)'.
--
-- We can then traverse over the entire 'RequestFields' HKD to reify
-- all the fields at once and apply them to our actual request
-- data.
--
-- NOTE: We don't literally use 'traverse' or the HKD equivalent
-- 'btraverse', but you can think of this operation morally as a
-- traversal. See 'applyRequestTransform' for implementation details.
module Hasura.RQL.DDL.Webhook.Transform
  ( -- * Request Transformation
    RequestFields (..),
    RequestTransform (..),
    RequestTransformFns,
    applyRequestTransform,

    -- * Request Transformation Context
    RequestTransformCtx (..),
    TransformErrorBundle (..),

    -- * Optional Functor
    WithOptional (..),
    withOptional,

    -- * Old Style Response Transforms
    MetadataResponseTransform (..),
    ResponseTransform (..),
    ResponseTransformCtx (..),
    applyResponseTransform,
    buildRespTransformCtx,
    mkResponseTransform,
  )
where

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

import Control.Lens (Lens', lens, set, traverseOf, view)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Extended qualified as J
import Data.Aeson.Kriti.Functions qualified as KFunc
import Data.Bifunctor (first)
import Data.ByteString.Lazy qualified as BL
import Data.CaseInsensitive qualified as CI
import Data.Coerce (Coercible)
import Data.Functor.Barbie (AllBF, ApplicativeB, ConstraintsB, FunctorB, TraversableB)
import Data.Functor.Barbie qualified as B
import Data.Text.Encoding qualified as TE
import Data.Validation qualified as V
import Hasura.Incremental (Cacheable)
import Hasura.Prelude hiding (first)
import Hasura.RQL.DDL.Webhook.Transform.Body (Body (..), BodyTransformFn, TransformFn (BodyTransformFn_))
import Hasura.RQL.DDL.Webhook.Transform.Body qualified as Body
import Hasura.RQL.DDL.Webhook.Transform.Class
import Hasura.RQL.DDL.Webhook.Transform.Headers (Headers (..), HeadersTransformFn (..), TransformFn (HeadersTransformFn_))
import Hasura.RQL.DDL.Webhook.Transform.Method
import Hasura.RQL.DDL.Webhook.Transform.QueryParams
import Hasura.RQL.DDL.Webhook.Transform.Url
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
  { RequestTransform -> Version
version :: Version,
    RequestTransform -> RequestFields (WithOptional TransformFn)
requestFields :: RequestFields (WithOptional TransformFn),
    RequestTransform -> TemplatingEngine
templateEngine :: TemplatingEngine
  }
  deriving stock (Int -> RequestTransform -> ShowS
[RequestTransform] -> ShowS
RequestTransform -> String
(Int -> RequestTransform -> ShowS)
-> (RequestTransform -> String)
-> ([RequestTransform] -> ShowS)
-> Show RequestTransform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestTransform] -> ShowS
$cshowList :: [RequestTransform] -> ShowS
show :: RequestTransform -> String
$cshow :: RequestTransform -> String
showsPrec :: Int -> RequestTransform -> ShowS
$cshowsPrec :: Int -> RequestTransform -> ShowS
Show, RequestTransform -> RequestTransform -> Bool
(RequestTransform -> RequestTransform -> Bool)
-> (RequestTransform -> RequestTransform -> Bool)
-> Eq RequestTransform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestTransform -> RequestTransform -> Bool
$c/= :: RequestTransform -> RequestTransform -> Bool
== :: RequestTransform -> RequestTransform -> Bool
$c== :: RequestTransform -> RequestTransform -> Bool
Eq, (forall x. RequestTransform -> Rep RequestTransform x)
-> (forall x. Rep RequestTransform x -> RequestTransform)
-> Generic RequestTransform
forall x. Rep RequestTransform x -> RequestTransform
forall x. RequestTransform -> Rep RequestTransform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestTransform x -> RequestTransform
$cfrom :: forall x. RequestTransform -> Rep RequestTransform x
Generic)
  deriving anyclass (RequestTransform -> ()
(RequestTransform -> ()) -> NFData RequestTransform
forall a. (a -> ()) -> NFData a
rnf :: RequestTransform -> ()
$crnf :: RequestTransform -> ()
NFData, Eq RequestTransform
Eq RequestTransform
-> (Accesses -> RequestTransform -> RequestTransform -> Bool)
-> Cacheable RequestTransform
Accesses -> RequestTransform -> RequestTransform -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> RequestTransform -> RequestTransform -> Bool
$cunchanged :: Accesses -> RequestTransform -> RequestTransform -> Bool
$cp1Cacheable :: Eq RequestTransform
Cacheable)

instance FromJSON RequestTransform where
  parseJSON :: Value -> Parser RequestTransform
parseJSON = String
-> (Object -> Parser RequestTransform)
-> Value
-> Parser RequestTransform
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"RequestTransform" \Object
o -> do
    Version
version <- Object
o Object -> Key -> Parser (Maybe Version)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"version" Parser (Maybe Version) -> Version -> Parser Version
forall a. Parser (Maybe a) -> a -> Parser a
J..!= Version
V1
    Maybe MethodTransformFn
method <- Object
o Object -> Key -> Parser (Maybe MethodTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"method"
    Maybe UrlTransformFn
url <- Object
o Object -> Key -> Parser (Maybe UrlTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"url"
    Maybe BodyTransformFn
body <- case Version
version of
      Version
V1 -> do
        Maybe Template
template :: Maybe Template <- Object
o Object -> Key -> Parser (Maybe Template)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"body"
        Maybe BodyTransformFn -> Parser (Maybe BodyTransformFn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe BodyTransformFn -> Parser (Maybe BodyTransformFn))
-> Maybe BodyTransformFn -> Parser (Maybe BodyTransformFn)
forall a b. (a -> b) -> a -> b
$ (Template -> BodyTransformFn)
-> Maybe Template -> Maybe BodyTransformFn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Template -> BodyTransformFn
Body.ModifyAsJSON Maybe Template
template
      Version
V2 -> Object
o Object -> Key -> Parser (Maybe BodyTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"body"
    Maybe QueryParamsTransformFn
queryParams <- Object
o Object -> Key -> Parser (Maybe QueryParamsTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"query_params"
    Maybe HeadersTransformFn
headers <- Object
o Object -> Key -> Parser (Maybe HeadersTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"request_headers"
    let requestFields :: RequestFields (WithOptional TransformFn)
requestFields =
          RequestFields :: forall (f :: * -> *).
f Method
-> f Url -> f Body -> f QueryParams -> f Headers -> RequestFields f
RequestFields
            { method :: WithOptional TransformFn Method
method = Maybe MethodTransformFn -> WithOptional TransformFn Method
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @MethodTransformFn Maybe MethodTransformFn
method,
              url :: WithOptional TransformFn Url
url = Maybe UrlTransformFn -> WithOptional TransformFn Url
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @UrlTransformFn Maybe UrlTransformFn
url,
              body :: WithOptional TransformFn Body
body = Maybe BodyTransformFn -> WithOptional TransformFn Body
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @BodyTransformFn Maybe BodyTransformFn
body,
              queryParams :: WithOptional TransformFn QueryParams
queryParams = Maybe QueryParamsTransformFn
-> WithOptional TransformFn QueryParams
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @QueryParamsTransformFn Maybe QueryParamsTransformFn
queryParams,
              requestHeaders :: WithOptional TransformFn Headers
requestHeaders = Maybe HeadersTransformFn -> WithOptional TransformFn Headers
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @HeadersTransformFn Maybe HeadersTransformFn
headers
            }
    TemplatingEngine
templateEngine <- Object
o Object -> Key -> Parser (Maybe TemplatingEngine)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"template_engine" Parser (Maybe TemplatingEngine)
-> TemplatingEngine -> Parser TemplatingEngine
forall a. Parser (Maybe a) -> a -> Parser a
J..!= TemplatingEngine
Kriti
    RequestTransform -> Parser RequestTransform
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestTransform -> Parser RequestTransform)
-> RequestTransform -> Parser RequestTransform
forall a b. (a -> b) -> a -> b
$ RequestTransform :: Version
-> RequestFields (WithOptional TransformFn)
-> TemplatingEngine
-> RequestTransform
RequestTransform {Version
TemplatingEngine
RequestFields (WithOptional TransformFn)
templateEngine :: TemplatingEngine
requestFields :: RequestFields (WithOptional TransformFn)
version :: Version
templateEngine :: TemplatingEngine
requestFields :: RequestFields (WithOptional TransformFn)
version :: Version
..}

instance ToJSON RequestTransform where
  toJSON :: RequestTransform -> Value
toJSON RequestTransform {Version
TemplatingEngine
RequestFields (WithOptional TransformFn)
templateEngine :: TemplatingEngine
requestFields :: RequestFields (WithOptional TransformFn)
version :: Version
templateEngine :: RequestTransform -> TemplatingEngine
requestFields :: RequestTransform -> RequestFields (WithOptional TransformFn)
version :: RequestTransform -> Version
..} =
    let RequestFields {WithOptional TransformFn Url
WithOptional TransformFn QueryParams
WithOptional TransformFn Method
WithOptional TransformFn Headers
WithOptional TransformFn Body
requestHeaders :: WithOptional TransformFn Headers
queryParams :: WithOptional TransformFn QueryParams
body :: WithOptional TransformFn Body
url :: WithOptional TransformFn Url
method :: WithOptional TransformFn Method
requestHeaders :: forall (f :: * -> *). RequestFields f -> f Headers
queryParams :: forall (f :: * -> *). RequestFields f -> f QueryParams
body :: forall (f :: * -> *). RequestFields f -> f Body
url :: forall (f :: * -> *). RequestFields f -> f Url
method :: forall (f :: * -> *). RequestFields f -> f Method
..} = RequestFields (WithOptional TransformFn)
requestFields
        body' :: Maybe (Key, Value)
body' = case Version
version of
          Version
V1 -> case (WithOptional TransformFn Body -> Maybe (TransformFn Body)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Body
body) of
            Just (BodyTransformFn_ (Body.ModifyAsJSON template)) ->
              (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just (Key
"body", Template -> Value
forall a. ToJSON a => a -> Value
J.toJSON Template
template)
            Maybe (TransformFn Body)
_ -> Maybe (Key, Value)
forall a. Maybe a
Nothing
          Version
V2 -> Key
"body" Key -> Maybe (TransformFn Body) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Body -> Maybe (TransformFn Body)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Body
body
     in [(Key, Value)] -> Value
J.object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Key
"version" Key -> Version -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Version
version,
            Key
"template_engine" Key -> TemplatingEngine -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= TemplatingEngine
templateEngine
          ]
            [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Key, Value)] -> [(Key, Value)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
              [ Key
"method" Key -> Maybe (TransformFn Method) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Method -> Maybe (TransformFn Method)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Method
method,
                Key
"url" Key -> Maybe (TransformFn Url) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Url -> Maybe (TransformFn Url)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Url
url,
                Key
"query_params" Key -> Maybe (TransformFn QueryParams) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn QueryParams
-> Maybe (TransformFn QueryParams)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn QueryParams
queryParams,
                Key
"request_headers" Key -> Maybe (TransformFn Headers) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Headers -> Maybe (TransformFn Headers)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Headers
requestHeaders,
                Maybe (Key, Value)
body'
              ]

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

-- | Defunctionalized Webhook 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
  { RequestFields f -> f Method
method :: f Method,
    RequestFields f -> f Url
url :: f Url,
    RequestFields f -> f Body
body :: f Body,
    RequestFields f -> f QueryParams
queryParams :: f QueryParams,
    RequestFields f -> f Headers
requestHeaders :: f Headers
  }
  deriving stock ((forall x. RequestFields f -> Rep (RequestFields f) x)
-> (forall x. Rep (RequestFields f) x -> RequestFields f)
-> Generic (RequestFields f)
forall x. Rep (RequestFields f) x -> RequestFields f
forall x. RequestFields f -> Rep (RequestFields f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (RequestFields f) x -> RequestFields f
forall (f :: * -> *) x. RequestFields f -> Rep (RequestFields f) x
$cto :: forall (f :: * -> *) x. Rep (RequestFields f) x -> RequestFields f
$cfrom :: forall (f :: * -> *) x. RequestFields f -> Rep (RequestFields f) x
Generic)
  deriving anyclass ((forall (f :: * -> *) (g :: * -> *).
 (forall a. f a -> g a) -> RequestFields f -> RequestFields g)
-> FunctorB RequestFields
forall k (b :: (k -> *) -> *).
(forall (f :: k -> *) (g :: k -> *).
 (forall (a :: k). f a -> g a) -> b f -> b g)
-> FunctorB b
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> RequestFields f -> RequestFields g
bmap :: (forall a. f a -> g a) -> RequestFields f -> RequestFields g
$cbmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> RequestFields f -> RequestFields g
FunctorB, FunctorB RequestFields
FunctorB RequestFields
-> (forall (f :: * -> *). (forall a. f a) -> RequestFields f)
-> (forall (f :: * -> *) (g :: * -> *).
    RequestFields f -> RequestFields g -> RequestFields (Product f g))
-> ApplicativeB RequestFields
forall k (b :: (k -> *) -> *).
FunctorB b
-> (forall (f :: k -> *). (forall (a :: k). f a) -> b f)
-> (forall (f :: k -> *) (g :: k -> *).
    b f -> b g -> b (Product f g))
-> ApplicativeB b
forall (f :: * -> *). (forall a. f a) -> RequestFields f
forall (f :: * -> *) (g :: * -> *).
RequestFields f -> RequestFields g -> RequestFields (Product f g)
bprod :: RequestFields f -> RequestFields g -> RequestFields (Product f g)
$cbprod :: forall (f :: * -> *) (g :: * -> *).
RequestFields f -> RequestFields g -> RequestFields (Product f g)
bpure :: (forall a. f a) -> RequestFields f
$cbpure :: forall (f :: * -> *). (forall a. f a) -> RequestFields f
$cp1ApplicativeB :: FunctorB RequestFields
ApplicativeB, FunctorB RequestFields
FunctorB RequestFields
-> (forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
    Applicative e =>
    (forall a. f a -> e (g a))
    -> RequestFields f -> e (RequestFields g))
-> TraversableB RequestFields
forall k (b :: (k -> *) -> *).
FunctorB b
-> (forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
    Applicative e =>
    (forall (a :: k). f a -> e (g a)) -> b f -> e (b g))
-> TraversableB b
forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a))
-> RequestFields f -> e (RequestFields g)
btraverse :: (forall a. f a -> e (g a))
-> RequestFields f -> e (RequestFields g)
$cbtraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a))
-> RequestFields f -> e (RequestFields g)
$cp1TraversableB :: FunctorB RequestFields
TraversableB, FunctorB RequestFields
FunctorB RequestFields
-> (forall (c :: * -> Constraint) (f :: * -> *).
    AllB c RequestFields =>
    RequestFields f -> RequestFields (Product (Dict c) f))
-> ConstraintsB RequestFields
forall k (b :: (k -> *) -> *).
FunctorB b
-> (forall (c :: k -> Constraint) (f :: k -> *).
    AllB c b =>
    b f -> b (Product (Dict c) f))
-> ConstraintsB b
forall (c :: * -> Constraint) (f :: * -> *).
AllB c RequestFields =>
RequestFields f -> RequestFields (Product (Dict c) f)
baddDicts :: RequestFields f -> RequestFields (Product (Dict c) f)
$cbaddDicts :: forall (c :: * -> Constraint) (f :: * -> *).
AllB c RequestFields =>
RequestFields f -> RequestFields (Product (Dict c) f)
$cp1ConstraintsB :: FunctorB RequestFields
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)

deriving anyclass instance
  AllBF Cacheable f RequestFields =>
  Cacheable (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 :: Value -> Parser (RequestFields (WithOptional TransformFn))
parseJSON = String
-> (Object -> Parser (RequestFields (WithOptional TransformFn)))
-> Value
-> Parser (RequestFields (WithOptional TransformFn))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"RequestTransformFns" ((Object -> Parser (RequestFields (WithOptional TransformFn)))
 -> Value -> Parser (RequestFields (WithOptional TransformFn)))
-> (Object -> Parser (RequestFields (WithOptional TransformFn)))
-> Value
-> Parser (RequestFields (WithOptional TransformFn))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe MethodTransformFn
method <- Object
o Object -> Key -> Parser (Maybe MethodTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"method"
    Maybe UrlTransformFn
url <- Object
o Object -> Key -> Parser (Maybe UrlTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"url"
    Maybe BodyTransformFn
body <- Object
o Object -> Key -> Parser (Maybe BodyTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"body"
    Maybe QueryParamsTransformFn
queryParams <- Object
o Object -> Key -> Parser (Maybe QueryParamsTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"query_params"
    Maybe HeadersTransformFn
headers <- Object
o Object -> Key -> Parser (Maybe HeadersTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"request_headers"
    RequestFields (WithOptional TransformFn)
-> Parser (RequestFields (WithOptional TransformFn))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestFields (WithOptional TransformFn)
 -> Parser (RequestFields (WithOptional TransformFn)))
-> RequestFields (WithOptional TransformFn)
-> Parser (RequestFields (WithOptional TransformFn))
forall a b. (a -> b) -> a -> b
$
      RequestFields :: forall (f :: * -> *).
f Method
-> f Url -> f Body -> f QueryParams -> f Headers -> RequestFields f
RequestFields
        { method :: WithOptional TransformFn Method
method = Maybe MethodTransformFn -> WithOptional TransformFn Method
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @MethodTransformFn Maybe MethodTransformFn
method,
          url :: WithOptional TransformFn Url
url = Maybe UrlTransformFn -> WithOptional TransformFn Url
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @UrlTransformFn Maybe UrlTransformFn
url,
          body :: WithOptional TransformFn Body
body = Maybe BodyTransformFn -> WithOptional TransformFn Body
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @BodyTransformFn Maybe BodyTransformFn
body,
          queryParams :: WithOptional TransformFn QueryParams
queryParams = Maybe QueryParamsTransformFn
-> WithOptional TransformFn QueryParams
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @QueryParamsTransformFn Maybe QueryParamsTransformFn
queryParams,
          requestHeaders :: WithOptional TransformFn Headers
requestHeaders = Maybe HeadersTransformFn -> WithOptional TransformFn Headers
forall a b (f :: * -> *).
Coercible a (f b) =>
Maybe a -> WithOptional f b
withOptional @HeadersTransformFn Maybe HeadersTransformFn
headers
        }

instance ToJSON RequestTransformFns where
  toJSON :: RequestFields (WithOptional TransformFn) -> Value
toJSON RequestFields {WithOptional TransformFn Url
WithOptional TransformFn QueryParams
WithOptional TransformFn Method
WithOptional TransformFn Headers
WithOptional TransformFn Body
requestHeaders :: WithOptional TransformFn Headers
queryParams :: WithOptional TransformFn QueryParams
body :: WithOptional TransformFn Body
url :: WithOptional TransformFn Url
method :: WithOptional TransformFn Method
requestHeaders :: forall (f :: * -> *). RequestFields f -> f Headers
queryParams :: forall (f :: * -> *). RequestFields f -> f QueryParams
body :: forall (f :: * -> *). RequestFields f -> f Body
url :: forall (f :: * -> *). RequestFields f -> f Url
method :: forall (f :: * -> *). RequestFields f -> f Method
..} =
    [(Key, Value)] -> Value
J.object ([(Key, Value)] -> Value)
-> ([Maybe (Key, Value)] -> [(Key, Value)])
-> [Maybe (Key, Value)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Key, Value)] -> [(Key, Value)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (Key, Value)] -> Value) -> [Maybe (Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"method" Key -> Maybe (TransformFn Method) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Method -> Maybe (TransformFn Method)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Method
method,
        Key
"url" Key -> Maybe (TransformFn Url) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Url -> Maybe (TransformFn Url)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Url
url,
        Key
"body" Key -> Maybe (TransformFn Body) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Body -> Maybe (TransformFn Body)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Body
body,
        Key
"query_params" Key -> Maybe (TransformFn QueryParams) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn QueryParams
-> Maybe (TransformFn QueryParams)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn QueryParams
queryParams,
        Key
"request_headers" Key -> Maybe (TransformFn Headers) -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? WithOptional TransformFn Headers -> Maybe (TransformFn Headers)
forall (f :: * -> *) result.
WithOptional f result -> Maybe (f result)
getOptional WithOptional TransformFn Headers
requestHeaders
      ]

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

-- TODO(SOLOMON): Add lens law unit tests

-- | A 'Lens\'' for viewing a 'HTTP.Request' as our 'RequestData' HKD; it does
-- so by wrapping each of the matching request fields in a corresponding
-- 'TransformFn'.
--
-- 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!
requestL :: Lens' HTTP.Request RequestData
requestL :: (RequestData -> f RequestData) -> Request -> f Request
requestL = (Request -> RequestData)
-> (Request -> RequestData -> Request)
-> Lens Request Request RequestData RequestData
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Request -> RequestData
getter Request -> RequestData -> Request
setter
  where
    getter :: HTTP.Request -> RequestData
    getter :: Request -> RequestData
getter Request
req =
      RequestFields :: forall (f :: * -> *).
f Method
-> f Url -> f Body -> f QueryParams -> f Headers -> RequestFields f
RequestFields
        { method :: Identity Method
method = CI Text -> Identity Method
coerce (CI Text -> Identity Method) -> CI Text -> Identity Method
forall a b. (a -> b) -> a -> b
$ Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> Text -> CI Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Getting ByteString Request ByteString -> Request -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Request ByteString
Lens' Request ByteString
HTTP.method Request
req,
          url :: Identity Url
url = Text -> Identity Url
coerce (Text -> Identity Url) -> Text -> Identity Url
forall a b. (a -> b) -> a -> b
$ Getting Text Request Text -> Request -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Request Text
Lens' Request Text
HTTP.url Request
req,
          body :: Identity Body
body = Body -> Identity Body
coerce (Body -> Identity Body) -> Body -> Identity Body
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Body
JSONBody (Maybe Value -> Body) -> Maybe Value -> Body
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decode (ByteString -> Maybe Value) -> Maybe ByteString -> Maybe Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
req,
          queryParams :: Identity QueryParams
queryParams = Query -> Identity QueryParams
coerce (Query -> Identity QueryParams) -> Query -> Identity QueryParams
forall a b. (a -> b) -> a -> b
$ 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
req,
          requestHeaders :: Identity Headers
requestHeaders = [Header] -> Identity Headers
coerce ([Header] -> Identity Headers) -> [Header] -> Identity Headers
forall a b. (a -> b) -> a -> b
$ Getting [Header] Request [Header] -> Request -> [Header]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Header] Request [Header]
Lens' Request [Header]
HTTP.headers Request
req
        }

    serializeBody :: Body -> Maybe BL.ByteString
    serializeBody :: Body -> Maybe ByteString
serializeBody = \case
      JSONBody Maybe Value
body -> (Value -> ByteString) -> Maybe Value -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode Maybe Value
body
      RawBody ByteString
"" -> Maybe ByteString
forall a. Maybe a
Nothing
      RawBody ByteString
bs -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs

    setter :: HTTP.Request -> RequestData -> HTTP.Request
    setter :: Request -> RequestData -> Request
setter Request
req RequestFields {Identity Url
Identity QueryParams
Identity Method
Identity Headers
Identity Body
requestHeaders :: Identity Headers
queryParams :: Identity QueryParams
body :: Identity Body
url :: Identity Url
method :: Identity Method
requestHeaders :: forall (f :: * -> *). RequestFields f -> f Headers
queryParams :: forall (f :: * -> *). RequestFields f -> f QueryParams
body :: forall (f :: * -> *). RequestFields f -> f Body
url :: forall (f :: * -> *). RequestFields f -> f Url
method :: forall (f :: * -> *). RequestFields f -> f Method
..} =
      Request
req Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request ByteString ByteString
-> ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request ByteString ByteString
Lens' Request ByteString
HTTP.method (Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> Text) -> CI Text -> Text
forall a b. (a -> b) -> a -> b
$ Identity Method -> CI Text
coerce Identity Method
method)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request (Maybe ByteString) (Maybe ByteString)
Lens' Request (Maybe ByteString)
HTTP.body (Body -> Maybe ByteString
serializeBody (Body -> Maybe ByteString) -> Body -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Identity Body -> Body
coerce Identity Body
body)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request Text Text -> Text -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request Text Text
Lens' Request Text
HTTP.url (Identity Url -> Text
coerce Identity Url
url)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request Query Query -> Query -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request Query Query
Lens' Request Query
HTTP.queryParams (QueryParams -> Query
unQueryParams (QueryParams -> Query) -> QueryParams -> Query
forall a b. (a -> b) -> a -> b
$ Identity QueryParams -> QueryParams
coerce Identity QueryParams
queryParams)
        Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request [Header] [Header]
-> [Header] -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request [Header] [Header]
Lens' Request [Header]
HTTP.headers (Identity Headers -> [Header]
coerce Identity Headers
requestHeaders)

-- | Transform an 'HTTP.Request' with a 'RequestTransform'.
--
-- Note: we pass in the request url explicitly for use in the
-- 'ReqTransformCtx'. We do this so that we can ensure that the url
-- is syntactically identical to what the use submits. If we use the
-- parsed request from the 'HTTP.Request' term then it is possible
-- that the url is semantically equivalent but syntactically
-- different. An example of this is the presence or lack of a trailing
-- slash on the URL path. This important when performing string
-- interpolation on the request url.
applyRequestTransform ::
  forall m.
  MonadError TransformErrorBundle m =>
  (HTTP.Request -> RequestTransformCtx) ->
  RequestTransformFns ->
  HTTP.Request ->
  m HTTP.Request
applyRequestTransform :: (Request -> RequestTransformCtx)
-> RequestFields (WithOptional TransformFn) -> Request -> m Request
applyRequestTransform Request -> RequestTransformCtx
mkCtx RequestFields (WithOptional TransformFn)
transformations Request
request =
  LensLike m Request Request RequestData RequestData
-> LensLike m Request Request RequestData RequestData
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf
    LensLike m Request Request RequestData RequestData
Lens Request Request RequestData RequestData
requestL
    (RequestTransformCtx -> RequestData -> m RequestData
transformReqData (Request -> RequestTransformCtx
mkCtx Request
request))
    Request
request
  where
    -- Apply all of the provided request transformation functions to the
    -- request data extracted from the given 'HTTP.Request'.
    transformReqData :: RequestTransformCtx -> RequestData -> m RequestData
transformReqData RequestTransformCtx
ctx RequestData
reqData =
      RequestFields m -> m RequestData
forall (e :: * -> *) (b :: (* -> *) -> *).
(Applicative e, TraversableB b) =>
b e -> e (b Identity)
B.bsequence' (RequestFields m -> m RequestData)
-> RequestFields m -> m RequestData
forall a b. (a -> b) -> a -> b
$
        (forall a.
 Transform a =>
 WithOptional TransformFn a -> Identity a -> m a)
-> RequestFields (WithOptional TransformFn)
-> RequestData
-> RequestFields m
forall k (c :: k -> Constraint) (b :: (k -> *) -> *) (f :: k -> *)
       (g :: k -> *) (h :: k -> *).
(AllB c b, ConstraintsB b, ApplicativeB b) =>
(forall (a :: k). c a => f a -> g a -> h a) -> b f -> b g -> b h
B.bzipWithC @Transform
          (RequestTransformCtx
-> WithOptional TransformFn a -> Identity a -> m a
forall (f :: * -> *) a.
(Transform a, MonadError TransformErrorBundle f) =>
RequestTransformCtx
-> WithOptional TransformFn a -> Identity a -> f a
transformField RequestTransformCtx
ctx)
          RequestFields (WithOptional TransformFn)
transformations
          RequestData
reqData
    -- Apply a transformation to some request data, if it exists; otherwise
    -- return the original request data.
    transformField :: RequestTransformCtx
-> WithOptional TransformFn a -> Identity a -> f a
transformField RequestTransformCtx
ctx (WithOptional Maybe (TransformFn a)
maybeFn) (Identity a
a) =
      case Maybe (TransformFn a)
maybeFn of
        Maybe (TransformFn a)
Nothing -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        Just TransformFn a
fn -> TransformFn a -> RequestTransformCtx -> a -> f a
forall a (m :: * -> *).
(Transform a, MonadError TransformErrorBundle m) =>
TransformFn a -> RequestTransformCtx -> a -> m a
transform TransformFn a
fn RequestTransformCtx
ctx a
a

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

-- | Enrich a 'Functor' @f@ with optionality; this is primarily useful when
-- one wants to annotate fields as optional when using the Higher-Kinded Data
-- pattern.
--
-- 'WithOptional'@ f@ is equivalent to @Compose Maybe f@.
newtype WithOptional f result = WithOptional
  { WithOptional f result -> Maybe (f result)
getOptional :: Maybe (f result)
  }
  deriving stock (WithOptional f result -> WithOptional f result -> Bool
(WithOptional f result -> WithOptional f result -> Bool)
-> (WithOptional f result -> WithOptional f result -> Bool)
-> Eq (WithOptional f result)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) result.
Eq (f result) =>
WithOptional f result -> WithOptional f result -> Bool
/= :: WithOptional f result -> WithOptional f result -> Bool
$c/= :: forall (f :: * -> *) result.
Eq (f result) =>
WithOptional f result -> WithOptional f result -> Bool
== :: WithOptional f result -> WithOptional f result -> Bool
$c== :: forall (f :: * -> *) result.
Eq (f result) =>
WithOptional f result -> WithOptional f result -> Bool
Eq, a -> WithOptional f b -> WithOptional f a
(a -> b) -> WithOptional f a -> WithOptional f b
(forall a b. (a -> b) -> WithOptional f a -> WithOptional f b)
-> (forall a b. a -> WithOptional f b -> WithOptional f a)
-> Functor (WithOptional f)
forall a b. a -> WithOptional f b -> WithOptional f a
forall a b. (a -> b) -> WithOptional f a -> WithOptional f b
forall (f :: * -> *) a b.
Functor f =>
a -> WithOptional f b -> WithOptional f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WithOptional f a -> WithOptional f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithOptional f b -> WithOptional f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> WithOptional f b -> WithOptional f a
fmap :: (a -> b) -> WithOptional f a -> WithOptional f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> WithOptional f a -> WithOptional f b
Functor, WithOptional f a -> Bool
(a -> m) -> WithOptional f a -> m
(a -> b -> b) -> b -> WithOptional f a -> b
(forall m. Monoid m => WithOptional f m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithOptional f a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithOptional f a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithOptional f a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithOptional f a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithOptional f a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithOptional f a -> b)
-> (forall a. (a -> a -> a) -> WithOptional f a -> a)
-> (forall a. (a -> a -> a) -> WithOptional f a -> a)
-> (forall a. WithOptional f a -> [a])
-> (forall a. WithOptional f a -> Bool)
-> (forall a. WithOptional f a -> Int)
-> (forall a. Eq a => a -> WithOptional f a -> Bool)
-> (forall a. Ord a => WithOptional f a -> a)
-> (forall a. Ord a => WithOptional f a -> a)
-> (forall a. Num a => WithOptional f a -> a)
-> (forall a. Num a => WithOptional f a -> a)
-> Foldable (WithOptional f)
forall a. Eq a => a -> WithOptional f a -> Bool
forall a. Num a => WithOptional f a -> a
forall a. Ord a => WithOptional f a -> a
forall m. Monoid m => WithOptional f m -> m
forall a. WithOptional f a -> Bool
forall a. WithOptional f a -> Int
forall a. WithOptional f a -> [a]
forall a. (a -> a -> a) -> WithOptional f a -> a
forall m a. Monoid m => (a -> m) -> WithOptional f a -> m
forall b a. (b -> a -> b) -> b -> WithOptional f a -> b
forall a b. (a -> b -> b) -> b -> WithOptional f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> WithOptional f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
WithOptional f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WithOptional f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
WithOptional f m -> m
forall (f :: * -> *) a. Foldable f => WithOptional f a -> Bool
forall (f :: * -> *) a. Foldable f => WithOptional f a -> Int
forall (f :: * -> *) a. Foldable f => WithOptional f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WithOptional f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WithOptional f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WithOptional f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WithOptional f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: WithOptional f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
WithOptional f a -> a
sum :: WithOptional f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
WithOptional f a -> a
minimum :: WithOptional f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WithOptional f a -> a
maximum :: WithOptional f a -> a
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
WithOptional f a -> a
elem :: a -> WithOptional f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> WithOptional f a -> Bool
length :: WithOptional f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => WithOptional f a -> Int
null :: WithOptional f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => WithOptional f a -> Bool
toList :: WithOptional f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => WithOptional f a -> [a]
foldl1 :: (a -> a -> a) -> WithOptional f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WithOptional f a -> a
foldr1 :: (a -> a -> a) -> WithOptional f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> WithOptional f a -> a
foldl' :: (b -> a -> b) -> b -> WithOptional f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WithOptional f a -> b
foldl :: (b -> a -> b) -> b -> WithOptional f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> WithOptional f a -> b
foldr' :: (a -> b -> b) -> b -> WithOptional f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WithOptional f a -> b
foldr :: (a -> b -> b) -> b -> WithOptional f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> WithOptional f a -> b
foldMap' :: (a -> m) -> WithOptional f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WithOptional f a -> m
foldMap :: (a -> m) -> WithOptional f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> WithOptional f a -> m
fold :: WithOptional f m -> m
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
WithOptional f m -> m
Foldable, (forall x. WithOptional f result -> Rep (WithOptional f result) x)
-> (forall x.
    Rep (WithOptional f result) x -> WithOptional f result)
-> Generic (WithOptional f result)
forall x. Rep (WithOptional f result) x -> WithOptional f result
forall x. WithOptional f result -> Rep (WithOptional f result) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) result x.
Rep (WithOptional f result) x -> WithOptional f result
forall (f :: * -> *) result x.
WithOptional f result -> Rep (WithOptional f result) x
$cto :: forall (f :: * -> *) result x.
Rep (WithOptional f result) x -> WithOptional f result
$cfrom :: forall (f :: * -> *) result x.
WithOptional f result -> Rep (WithOptional f result) x
Generic, Int -> WithOptional f result -> ShowS
[WithOptional f result] -> ShowS
WithOptional f result -> String
(Int -> WithOptional f result -> ShowS)
-> (WithOptional f result -> String)
-> ([WithOptional f result] -> ShowS)
-> Show (WithOptional f result)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) result.
Show (f result) =>
Int -> WithOptional f result -> ShowS
forall (f :: * -> *) result.
Show (f result) =>
[WithOptional f result] -> ShowS
forall (f :: * -> *) result.
Show (f result) =>
WithOptional f result -> String
showList :: [WithOptional f result] -> ShowS
$cshowList :: forall (f :: * -> *) result.
Show (f result) =>
[WithOptional f result] -> ShowS
show :: WithOptional f result -> String
$cshow :: forall (f :: * -> *) result.
Show (f result) =>
WithOptional f result -> String
showsPrec :: Int -> WithOptional f result -> ShowS
$cshowsPrec :: forall (f :: * -> *) result.
Show (f result) =>
Int -> WithOptional f result -> ShowS
Show)
  deriving newtype (Value -> Parser [WithOptional f result]
Value -> Parser (WithOptional f result)
(Value -> Parser (WithOptional f result))
-> (Value -> Parser [WithOptional f result])
-> FromJSON (WithOptional f result)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (f :: * -> *) result.
FromJSON (f result) =>
Value -> Parser [WithOptional f result]
forall (f :: * -> *) result.
FromJSON (f result) =>
Value -> Parser (WithOptional f result)
parseJSONList :: Value -> Parser [WithOptional f result]
$cparseJSONList :: forall (f :: * -> *) result.
FromJSON (f result) =>
Value -> Parser [WithOptional f result]
parseJSON :: Value -> Parser (WithOptional f result)
$cparseJSON :: forall (f :: * -> *) result.
FromJSON (f result) =>
Value -> Parser (WithOptional f result)
FromJSON, [WithOptional f result] -> Value
[WithOptional f result] -> Encoding
WithOptional f result -> Value
WithOptional f result -> Encoding
(WithOptional f result -> Value)
-> (WithOptional f result -> Encoding)
-> ([WithOptional f result] -> Value)
-> ([WithOptional f result] -> Encoding)
-> ToJSON (WithOptional f result)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (f :: * -> *) result.
ToJSON (f result) =>
[WithOptional f result] -> Value
forall (f :: * -> *) result.
ToJSON (f result) =>
[WithOptional f result] -> Encoding
forall (f :: * -> *) result.
ToJSON (f result) =>
WithOptional f result -> Value
forall (f :: * -> *) result.
ToJSON (f result) =>
WithOptional f result -> Encoding
toEncodingList :: [WithOptional f result] -> Encoding
$ctoEncodingList :: forall (f :: * -> *) result.
ToJSON (f result) =>
[WithOptional f result] -> Encoding
toJSONList :: [WithOptional f result] -> Value
$ctoJSONList :: forall (f :: * -> *) result.
ToJSON (f result) =>
[WithOptional f result] -> Value
toEncoding :: WithOptional f result -> Encoding
$ctoEncoding :: forall (f :: * -> *) result.
ToJSON (f result) =>
WithOptional f result -> Encoding
toJSON :: WithOptional f result -> Value
$ctoJSON :: forall (f :: * -> *) result.
ToJSON (f result) =>
WithOptional f result -> Value
ToJSON)

deriving newtype instance
  (Cacheable (f result)) =>
  Cacheable (WithOptional f result)

deriving newtype instance
  (NFData (f result)) =>
  NFData (WithOptional f result)

-- | 'WithOptional' smart constructor for the special case of optional values
-- that are representationally equivalent to some "wrapper" type.
--
-- For example:
-- @
-- withOptional \@HeaderTransformsAction headers == WithOptional $ fmap HeadersTransform headers
-- @
--
-- In other words: this function observes the isomorphism between @'Maybe' a@
-- and  @'WithOptional' f b@ if an isomorphism exists between @a@ and @f b@.
withOptional ::
  forall a b f.
  Coercible a (f b) =>
  Maybe a ->
  WithOptional f b
withOptional :: Maybe a -> WithOptional f b
withOptional = Maybe a -> WithOptional f b
coerce

-------------------------------------------------------------------------------
-- TODO(SOLOMON): Rewrite with HKD

-- | A set of data transformation functions generated from a
-- 'MetadataResponseTransform'. 'Nothing' means use the original
-- response value.
data ResponseTransform = ResponseTransform
  { ResponseTransform
-> Maybe
     (ResponseTransformCtx -> Either TransformErrorBundle Value)
respTransformBody :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle J.Value),
    ResponseTransform -> TemplatingEngine
respTransformTemplateEngine :: TemplatingEngine
  }

data MetadataResponseTransform = MetadataResponseTransform
  { MetadataResponseTransform -> Version
mrtVersion :: Version,
    MetadataResponseTransform -> Maybe BodyTransformFn
mrtBodyTransform :: Maybe BodyTransformFn,
    MetadataResponseTransform -> TemplatingEngine
mrtTemplatingEngine :: TemplatingEngine
  }
  deriving stock (Int -> MetadataResponseTransform -> ShowS
[MetadataResponseTransform] -> ShowS
MetadataResponseTransform -> String
(Int -> MetadataResponseTransform -> ShowS)
-> (MetadataResponseTransform -> String)
-> ([MetadataResponseTransform] -> ShowS)
-> Show MetadataResponseTransform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetadataResponseTransform] -> ShowS
$cshowList :: [MetadataResponseTransform] -> ShowS
show :: MetadataResponseTransform -> String
$cshow :: MetadataResponseTransform -> String
showsPrec :: Int -> MetadataResponseTransform -> ShowS
$cshowsPrec :: Int -> MetadataResponseTransform -> ShowS
Show, MetadataResponseTransform -> MetadataResponseTransform -> Bool
(MetadataResponseTransform -> MetadataResponseTransform -> Bool)
-> (MetadataResponseTransform -> MetadataResponseTransform -> Bool)
-> Eq MetadataResponseTransform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetadataResponseTransform -> MetadataResponseTransform -> Bool
$c/= :: MetadataResponseTransform -> MetadataResponseTransform -> Bool
== :: MetadataResponseTransform -> MetadataResponseTransform -> Bool
$c== :: MetadataResponseTransform -> MetadataResponseTransform -> Bool
Eq, (forall x.
 MetadataResponseTransform -> Rep MetadataResponseTransform x)
-> (forall x.
    Rep MetadataResponseTransform x -> MetadataResponseTransform)
-> Generic MetadataResponseTransform
forall x.
Rep MetadataResponseTransform x -> MetadataResponseTransform
forall x.
MetadataResponseTransform -> Rep MetadataResponseTransform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep MetadataResponseTransform x -> MetadataResponseTransform
$cfrom :: forall x.
MetadataResponseTransform -> Rep MetadataResponseTransform x
Generic)
  deriving anyclass (MetadataResponseTransform -> ()
(MetadataResponseTransform -> ())
-> NFData MetadataResponseTransform
forall a. (a -> ()) -> NFData a
rnf :: MetadataResponseTransform -> ()
$crnf :: MetadataResponseTransform -> ()
NFData, Eq MetadataResponseTransform
Eq MetadataResponseTransform
-> (Accesses
    -> MetadataResponseTransform -> MetadataResponseTransform -> Bool)
-> Cacheable MetadataResponseTransform
Accesses
-> MetadataResponseTransform -> MetadataResponseTransform -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses
-> MetadataResponseTransform -> MetadataResponseTransform -> Bool
$cunchanged :: Accesses
-> MetadataResponseTransform -> MetadataResponseTransform -> Bool
$cp1Cacheable :: Eq MetadataResponseTransform
Cacheable)

instance J.FromJSON MetadataResponseTransform where
  parseJSON :: Value -> Parser MetadataResponseTransform
parseJSON = String
-> (Object -> Parser MetadataResponseTransform)
-> Value
-> Parser MetadataResponseTransform
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"MetadataResponseTransform" ((Object -> Parser MetadataResponseTransform)
 -> Value -> Parser MetadataResponseTransform)
-> (Object -> Parser MetadataResponseTransform)
-> Value
-> Parser MetadataResponseTransform
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Version
mrtVersion <- Object
o Object -> Key -> Parser (Maybe Version)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"version" Parser (Maybe Version) -> Version -> Parser Version
forall a. Parser (Maybe a) -> a -> Parser a
J..!= Version
V1
    Maybe BodyTransformFn
mrtBodyTransform <- case Version
mrtVersion of
      Version
V1 -> do
        Maybe Template
template :: (Maybe Template) <- Object
o Object -> Key -> Parser (Maybe Template)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"body"
        Maybe BodyTransformFn -> Parser (Maybe BodyTransformFn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe BodyTransformFn -> Parser (Maybe BodyTransformFn))
-> Maybe BodyTransformFn -> Parser (Maybe BodyTransformFn)
forall a b. (a -> b) -> a -> b
$ (Template -> BodyTransformFn)
-> Maybe Template -> Maybe BodyTransformFn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Template -> BodyTransformFn
Body.ModifyAsJSON Maybe Template
template
      Version
V2 -> Object
o Object -> Key -> Parser (Maybe BodyTransformFn)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"body"
    Maybe TemplatingEngine
templateEngine <- Object
o Object -> Key -> Parser (Maybe TemplatingEngine)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"template_engine"
    let mrtTemplatingEngine :: TemplatingEngine
mrtTemplatingEngine = TemplatingEngine -> Maybe TemplatingEngine -> TemplatingEngine
forall a. a -> Maybe a -> a
fromMaybe TemplatingEngine
Kriti Maybe TemplatingEngine
templateEngine
    MetadataResponseTransform -> Parser MetadataResponseTransform
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataResponseTransform -> Parser MetadataResponseTransform)
-> MetadataResponseTransform -> Parser MetadataResponseTransform
forall a b. (a -> b) -> a -> b
$ MetadataResponseTransform :: Version
-> Maybe BodyTransformFn
-> TemplatingEngine
-> MetadataResponseTransform
MetadataResponseTransform {Maybe BodyTransformFn
Version
TemplatingEngine
mrtTemplatingEngine :: TemplatingEngine
mrtBodyTransform :: Maybe BodyTransformFn
mrtVersion :: Version
mrtTemplatingEngine :: TemplatingEngine
mrtBodyTransform :: Maybe BodyTransformFn
mrtVersion :: Version
..}

instance J.ToJSON MetadataResponseTransform where
  toJSON :: MetadataResponseTransform -> Value
toJSON MetadataResponseTransform {Maybe BodyTransformFn
Version
TemplatingEngine
mrtTemplatingEngine :: TemplatingEngine
mrtBodyTransform :: Maybe BodyTransformFn
mrtVersion :: Version
mrtTemplatingEngine :: MetadataResponseTransform -> TemplatingEngine
mrtBodyTransform :: MetadataResponseTransform -> Maybe BodyTransformFn
mrtVersion :: MetadataResponseTransform -> Version
..} =
    let body :: Maybe (Key, Value)
body = case Version
mrtVersion of
          Version
V1 -> case Maybe BodyTransformFn
mrtBodyTransform of
            Just (Body.ModifyAsJSON Template
template) -> (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just (Key
"body", Template -> Value
forall a. ToJSON a => a -> Value
J.toJSON Template
template)
            Maybe BodyTransformFn
_ -> Maybe (Key, Value)
forall a. Maybe a
Nothing
          Version
V2 -> Key
"body" Key -> Maybe BodyTransformFn -> Maybe (Key, Value)
forall v kv. (ToJSON v, KeyValue kv) => Key -> Maybe v -> Maybe kv
J..=? Maybe BodyTransformFn
mrtBodyTransform
     in [(Key, Value)] -> Value
J.object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Key
"template_engine" Key -> TemplatingEngine -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= TemplatingEngine
mrtTemplatingEngine,
            Key
"version" Key -> Version -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Version
mrtVersion
          ]
            [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Key, Value)] -> [(Key, Value)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (Key, Value)
body]

-- | A helper function for constructing the 'RespTransformCtx'
buildRespTransformCtx :: Maybe RequestTransformCtx -> Maybe SessionVariables -> TemplatingEngine -> BL.ByteString -> ResponseTransformCtx
buildRespTransformCtx :: Maybe RequestTransformCtx
-> Maybe SessionVariables
-> TemplatingEngine
-> ByteString
-> ResponseTransformCtx
buildRespTransformCtx Maybe RequestTransformCtx
reqCtx Maybe SessionVariables
sessionVars TemplatingEngine
engine ByteString
respBody =
  ResponseTransformCtx :: Value
-> Value
-> HashMap Text (Value -> Either CustomFunctionError Value)
-> TemplatingEngine
-> ResponseTransformCtx
ResponseTransformCtx
    { responseTransformBody :: Value
responseTransformBody = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
J.Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decode @J.Value ByteString
respBody,
      responseTransformReqCtx :: Value
responseTransformReqCtx = Maybe RequestTransformCtx -> Value
forall a. ToJSON a => a -> Value
J.toJSON Maybe RequestTransformCtx
reqCtx,
      responseTransformEngine :: TemplatingEngine
responseTransformEngine = TemplatingEngine
engine,
      responseTransformFunctions :: HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformFunctions = Maybe SessionVariables
-> HashMap Text (Value -> Either CustomFunctionError Value)
KFunc.sessionFunctions Maybe SessionVariables
sessionVars
    }

-- | Construct a Template Transformation function for Responses
--
-- 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!
mkRespTemplateTransform ::
  TemplatingEngine ->
  BodyTransformFn ->
  ResponseTransformCtx ->
  Either TransformErrorBundle J.Value
mkRespTemplateTransform :: TemplatingEngine
-> BodyTransformFn
-> ResponseTransformCtx
-> Either TransformErrorBundle Value
mkRespTemplateTransform TemplatingEngine
_ BodyTransformFn
Body.Remove ResponseTransformCtx
_ = Value -> Either TransformErrorBundle Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
J.Null
mkRespTemplateTransform TemplatingEngine
engine (Body.ModifyAsJSON (Template Text
template)) ResponseTransformCtx {Value
HashMap Text (Value -> Either CustomFunctionError Value)
TemplatingEngine
responseTransformEngine :: TemplatingEngine
responseTransformFunctions :: HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformReqCtx :: Value
responseTransformBody :: Value
responseTransformFunctions :: ResponseTransformCtx
-> HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformEngine :: ResponseTransformCtx -> TemplatingEngine
responseTransformReqCtx :: ResponseTransformCtx -> Value
responseTransformBody :: ResponseTransformCtx -> Value
..} =
  let context :: [(Text, Value)]
context = [(Text
"$body", Value
responseTransformBody), (Text
"$request", Value
responseTransformReqCtx)]
   in case TemplatingEngine
engine of
        TemplatingEngine
Kriti -> (SerializedError -> TransformErrorBundle)
-> Either SerializedError Value
-> Either TransformErrorBundle Value
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Value] -> TransformErrorBundle
TransformErrorBundle ([Value] -> TransformErrorBundle)
-> (SerializedError -> [Value])
-> SerializedError
-> TransformErrorBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> [Value])
-> (SerializedError -> Value) -> SerializedError -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializedError -> Value
forall a. ToJSON a => a -> Value
J.toJSON) (Either SerializedError Value -> Either TransformErrorBundle Value)
-> Either SerializedError Value
-> Either TransformErrorBundle Value
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Value)] -> Either SerializedError Value
KFunc.runKriti Text
template [(Text, Value)]
context
mkRespTemplateTransform TemplatingEngine
engine (Body.ModifyAsFormURLEncoded HashMap Text UnescapedTemplate
formTemplates) ResponseTransformCtx
context =
  case TemplatingEngine
engine of
    TemplatingEngine
Kriti -> do
      HashMap Text ByteString
result <-
        Either TransformErrorBundle (HashMap Text ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either TransformErrorBundle (HashMap Text ByteString)
 -> Either TransformErrorBundle (HashMap Text ByteString))
-> ((UnescapedTemplate
     -> Validation TransformErrorBundle ByteString)
    -> Either TransformErrorBundle (HashMap Text ByteString))
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation TransformErrorBundle (HashMap Text ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall e a. Validation e a -> Either e a
V.toEither (Validation TransformErrorBundle (HashMap Text ByteString)
 -> Either TransformErrorBundle (HashMap Text ByteString))
-> ((UnescapedTemplate
     -> Validation TransformErrorBundle ByteString)
    -> Validation TransformErrorBundle (HashMap Text ByteString))
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text UnescapedTemplate
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Validation TransformErrorBundle (HashMap Text ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashMap Text UnescapedTemplate
formTemplates ((UnescapedTemplate -> Validation TransformErrorBundle ByteString)
 -> Either TransformErrorBundle (HashMap Text ByteString))
-> (UnescapedTemplate
    -> Validation TransformErrorBundle ByteString)
-> Either TransformErrorBundle (HashMap Text ByteString)
forall a b. (a -> b) -> a -> b
$
          ResponseTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedResponseTemplateTransform' ResponseTransformCtx
context
      Value -> Either TransformErrorBundle Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either TransformErrorBundle Value)
-> (ByteString -> Value)
-> ByteString
-> Either TransformErrorBundle Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
J.String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> Either TransformErrorBundle Value)
-> ByteString -> Either TransformErrorBundle Value
forall a b. (a -> b) -> a -> b
$ HashMap Text ByteString -> ByteString
Body.foldFormEncoded HashMap Text ByteString
result

mkResponseTransform :: MetadataResponseTransform -> ResponseTransform
mkResponseTransform :: MetadataResponseTransform -> ResponseTransform
mkResponseTransform MetadataResponseTransform {Maybe BodyTransformFn
Version
TemplatingEngine
mrtTemplatingEngine :: TemplatingEngine
mrtBodyTransform :: Maybe BodyTransformFn
mrtVersion :: Version
mrtTemplatingEngine :: MetadataResponseTransform -> TemplatingEngine
mrtBodyTransform :: MetadataResponseTransform -> Maybe BodyTransformFn
mrtVersion :: MetadataResponseTransform -> Version
..} =
  let bodyTransform :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
bodyTransform = TemplatingEngine
-> BodyTransformFn
-> ResponseTransformCtx
-> Either TransformErrorBundle Value
mkRespTemplateTransform TemplatingEngine
mrtTemplatingEngine (BodyTransformFn
 -> ResponseTransformCtx -> Either TransformErrorBundle Value)
-> Maybe BodyTransformFn
-> Maybe
     (ResponseTransformCtx -> Either TransformErrorBundle Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BodyTransformFn
mrtBodyTransform
   in Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
-> TemplatingEngine -> ResponseTransform
ResponseTransform Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
bodyTransform TemplatingEngine
mrtTemplatingEngine

-- | At the moment we only transform the body of
-- Responses. 'http-client' does not export the constructors for
-- 'Response'. If we want to transform then we will need additional
-- 'apply' functions.
applyResponseTransform ::
  ResponseTransform ->
  ResponseTransformCtx ->
  Either TransformErrorBundle BL.ByteString
applyResponseTransform :: ResponseTransform
-> ResponseTransformCtx -> Either TransformErrorBundle ByteString
applyResponseTransform ResponseTransform {Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
TemplatingEngine
respTransformTemplateEngine :: TemplatingEngine
respTransformBody :: Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
respTransformTemplateEngine :: ResponseTransform -> TemplatingEngine
respTransformBody :: ResponseTransform
-> Maybe
     (ResponseTransformCtx -> Either TransformErrorBundle Value)
..} ctx :: ResponseTransformCtx
ctx@ResponseTransformCtx {Value
HashMap Text (Value -> Either CustomFunctionError Value)
TemplatingEngine
responseTransformEngine :: TemplatingEngine
responseTransformFunctions :: HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformReqCtx :: Value
responseTransformBody :: Value
responseTransformFunctions :: ResponseTransformCtx
-> HashMap Text (Value -> Either CustomFunctionError Value)
responseTransformEngine :: ResponseTransformCtx -> TemplatingEngine
responseTransformReqCtx :: ResponseTransformCtx -> Value
responseTransformBody :: ResponseTransformCtx -> Value
..} =
  let bodyFunc :: BL.ByteString -> Either TransformErrorBundle BL.ByteString
      bodyFunc :: ByteString -> Either TransformErrorBundle ByteString
bodyFunc ByteString
body =
        case Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
respTransformBody of
          Maybe (ResponseTransformCtx -> Either TransformErrorBundle Value)
Nothing -> ByteString -> Either TransformErrorBundle ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
body
          Just ResponseTransformCtx -> Either TransformErrorBundle Value
f -> Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode (Value -> ByteString)
-> Either TransformErrorBundle Value
-> Either TransformErrorBundle ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponseTransformCtx -> Either TransformErrorBundle Value
f ResponseTransformCtx
ctx
   in ByteString -> Either TransformErrorBundle ByteString
bodyFunc (Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode Value
responseTransformBody)